mcode: generate and register .eh_frame on linux x86/64

This is needed to generate backtraces.

14 files changed, 179 insertions, 11 deletions

diff --git a/src/ortho/mcode/binary_file.ads b/src/ortho/mcode/binary_file.ads
index 08770ae3b..423f6b153 100644
--- a/src/ortho/mcode/binary_file.ads
+++ b/src/ortho/mcode/binary_file.ads
@@ -128,6 +128,7 @@ package Binary_File is
    procedure Prealloc (L : Pc_Type);
 
    --  Add bits in the current section.
+   --  Space must be pre-allocated.
    procedure Gen_8 (B : Byte);
    procedure Gen_8 (B0, B1 : Byte);
 
@@ -136,6 +137,7 @@ package Binary_File is
    procedure Gen_64 (B : Unsigned_64);
 
    --  Add bits in the current section, but as stand-alone data.
+   --  Displayed if Dump_Asm.
    procedure Gen_Data_8 (B : Unsigned_8);
    procedure Gen_Data_16 (B : Unsigned_32);
    procedure Gen_Data_32 (Sym : Symbol; Offset : Integer_32);
diff --git a/src/ortho/mcode/ortho_code-dwarf.adb b/src/ortho/mcode/ortho_code-dwarf.adb
index cb0676891..66e527a16 100644
--- a/src/ortho/mcode/ortho_code-dwarf.adb
+++ b/src/ortho/mcode/ortho_code-dwarf.adb
@@ -13,11 +13,13 @@
 --
 --  You should have received a copy of the GNU General Public License
 --  along with this program.  If not, see <gnu.org/licenses>.
+
+with Ada.Text_IO;
 with GNAT.Directory_Operations;
+
 with Tables;
-with Interfaces; use Interfaces;
+
 with Dwarf; use Dwarf;
-with Ada.Text_IO;
 with Ortho_Code.Flags; use Ortho_Code.Flags;
 with Ortho_Code.Decls;
 with Ortho_Code.Types;
diff --git a/src/ortho/mcode/ortho_code-dwarf.ads b/src/ortho/mcode/ortho_code-dwarf.ads
index 41803be84..86d5689c4 100644
--- a/src/ortho/mcode/ortho_code-dwarf.ads
+++ b/src/ortho/mcode/ortho_code-dwarf.ads
@@ -13,6 +13,8 @@
 --
 --  You should have received a copy of the GNU General Public License
 --  along with this program.  If not, see <gnu.org/licenses>.
+with Interfaces; use Interfaces;
+
 with Binary_File; use Binary_File;
 
 package Ortho_Code.Dwarf is
@@ -29,6 +31,10 @@ package Ortho_Code.Dwarf is
    procedure Set_Line_Stmt (Line : Int32);
    procedure Set_Filename (Dir : String; File : String);
 
+   --  Low-level procedure (also used to generate .eh_frame)
+   procedure Gen_Uleb128 (V : Unsigned_32);
+   procedure Gen_Sleb128 (V : Int32);
+
    type Mark_Type is limited private;
    procedure Mark (M : out Mark_Type);
    procedure Release (M : Mark_Type);
diff --git a/src/ortho/mcode/ortho_code-x86-abi.adb b/src/ortho/mcode/ortho_code-x86-abi.adb
index ea9be4471..306335124 100644
--- a/src/ortho/mcode/ortho_code-x86-abi.adb
+++ b/src/ortho/mcode/ortho_code-x86-abi.adb
@@ -13,6 +13,9 @@
 --
 --  You should have received a copy of the GNU General Public License
 --  along with this program.  If not, see <gnu.org/licenses>.
+with System;
+
+with Ada.Text_IO;
 with Ortho_Code.Decls; use Ortho_Code.Decls;
 with Ortho_Code.Exprs; use Ortho_Code.Exprs;
 with Ortho_Code.Consts;
@@ -25,7 +28,6 @@ with Ortho_Code.X86.Insns;
 with Ortho_Code.X86.Emits;
 with Binary_File;
 with Binary_File.Memory;
-with Ada.Text_IO;
 
 package body Ortho_Code.X86.Abi is
    --  First argument is at %ebp + 8 / %rbp + 16
@@ -861,4 +863,62 @@ package body Ortho_Code.X86.Abi is
            (Ortho_Code.X86.Emits.Chkstk_Symbol, Chkstk'Address);
       end if;
    end Link_Intrinsics;
+
+   type Void is null record;
+   type Void_Ptr is access Void;
+
+   --  From GCC unwind-dw2-fde.h
+   type Frame_Info_Object is record
+      pc_begin : Void_Ptr;
+      tbase : Void_Ptr;
+      dbase : Void_Ptr;
+      U : Void_Ptr;
+      S : Void_Ptr;
+      fde_end : Void_Ptr; --  Maybe optional
+      next : Void_Ptr;
+   end record;
+   pragma Convention (C, Frame_Info_Object);
+
+   --  Object for the generated code.
+   This_Object : Frame_Info_Object;
+
+   procedure Register_Unwind
+   is
+      use Binary_File.Memory;
+      use System;
+
+      --  From GCC unwind-dw2-fde.h
+      procedure Register_Frame_Info_Bases
+        (Eh_Frame : Address;
+         Object : Address;
+         Tbase : Address;
+         Dbase : Address);
+      pragma Import (C, Register_Frame_Info_Bases,
+                     "__register_frame_info_bases");
+   begin
+      if X86.Flags.Eh_Frame then
+         Register_Frame_Info_Bases
+           (Get_Section_Addr (X86.Emits.Sect_Eh_Frame),
+            This_Object'Address,
+            Get_Section_Addr (X86.Emits.Sect_Text),
+            Get_Section_Addr (X86.Emits.Sect_Bss));
+      end if;
+   end Register_Unwind;
+
+   procedure Unregister_Unwind
+   is
+      use Binary_File.Memory;
+      use System;
+
+      --  From GCC unwind-dw2-fde.h
+      procedure Deregister_Frame_Info_Bases (Eh_Frame : Address);
+      pragma Import (C, Deregister_Frame_Info_Bases,
+                     "__deregister_frame_info_bases");
+   begin
+      if X86.Flags.Eh_Frame then
+         Deregister_Frame_Info_Bases
+           (Get_Section_Addr (X86.Emits.Sect_Eh_Frame));
+      end if;
+   end Unregister_Unwind;
+
 end Ortho_Code.X86.Abi;
diff --git a/src/ortho/mcode/ortho_code-x86-abi.ads b/src/ortho/mcode/ortho_code-x86-abi.ads
index cc6cf560b..6e720e1e1 100644
--- a/src/ortho/mcode/ortho_code-x86-abi.ads
+++ b/src/ortho/mcode/ortho_code-x86-abi.ads
@@ -79,6 +79,10 @@ package Ortho_Code.X86.Abi is
    --  Link in memory intrinsics symbols.
    procedure Link_Intrinsics;
 
+   --  Register unwinding info for JIT.
+   procedure Register_Unwind;
+   procedure Unregister_Unwind;
+
    --  Target specific data for subprograms.
    type Target_Subprg is record
       Fp_Slot : Uns32 := 0;
diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb
index 132f7287b..84336818c 100644
--- a/src/ortho/mcode/ortho_code-x86-emits.adb
+++ b/src/ortho/mcode/ortho_code-x86-emits.adb
@@ -46,11 +46,6 @@ package body Ortho_Code.X86.Emits is
       Mode_U32 | Mode_I32 => Sz_32,
       Mode_U64 | Mode_I64 => Sz_64);
 
-   --  Well known sections.
-   Sect_Text : Binary_File.Section_Acc;
-   Sect_Rodata : Binary_File.Section_Acc;
-   Sect_Bss : Binary_File.Section_Acc;
-
    --  For 64 bit to 32 bit conversion, we need an extra register.  Just before
    --  the conversion, there is an OE_Reg instruction containing the extra
    --  register.  Its value is saved here.
@@ -2936,7 +2931,7 @@ package body Ortho_Code.X86.Emits is
       --  Emit prolog.
       --  push %ebp / push %rbp
       Push_Reg (R_Bp);
-      --  movl %esp, %ebp / movl %rsp, %rbp
+      --  movl %esp, %ebp / movq %rsp, %rbp
       Start_Insn;
       Gen_Rex (16#48#);
       Gen_8 (Opc_Mov_Rm_Reg + 1);
@@ -2971,7 +2966,7 @@ package body Ortho_Code.X86.Emits is
          end;
       end if;
 
-      --  subl XXX, %esp / subl XXX, %rsp
+      --  subl XXX, %esp / subq XXX, %rsp
       if Frame_Size /= 0 then
          if not X86.Flags.Flag_Alloca_Call
             or else Frame_Size <= 4096
@@ -3090,6 +3085,24 @@ package body Ortho_Code.X86.Emits is
       end if;
    end Emit_Epilogue;
 
+   procedure Gen_FDE
+   is
+      Subprg_Size : Unsigned_32;
+   begin
+      Subprg_Size := Unsigned_32 (Get_Current_Pc - Subprg_Pc);
+
+      Set_Current_Section (Sect_Eh_Frame);
+      Prealloc (20);
+      Gen_32 (16);            --  Length
+      Gen_32 (Unsigned_32 (Get_Current_Pc));  --  CIE pointer
+      Gen_32 (Unsigned_32 (Subprg_Pc));       --  Initial location (.text rel)
+      Gen_32 (Subprg_Size);                   --  Function size
+      Gen_8 (0);                              --  Length
+      Gen_8 (0);
+      Gen_8 (0);
+      Gen_8 (0);
+   end Gen_FDE;
+
    procedure Emit_Subprg (Subprg : Subprogram_Data_Acc)
    is
       pragma Assert (Subprg = Cur_Subprg);
@@ -3114,6 +3127,10 @@ package body Ortho_Code.X86.Emits is
       end loop;
 
       Emit_Epilogue (Subprg);
+
+      if Flags.Eh_Frame then
+         Gen_FDE;
+      end if;
    end Emit_Subprg;
 
    procedure Emit_Var_Decl (Decl : O_Dnode)
@@ -3295,6 +3312,51 @@ package body Ortho_Code.X86.Emits is
          Debug_Hex := True;
       end if;
 
+      if Flags.Eh_Frame then
+         Create_Section (Sect_Eh_Frame, ".eh_frame", 0);
+         Set_Current_Section (Sect_Eh_Frame);
+         Prealloc (32);
+
+         --  Generate CIE
+         Gen_32 (28);  --  Length
+         Gen_32 (0);  --  CIE id = 0
+         Gen_8 (1);   --  Version = 1
+         Gen_8 (Character'Pos ('z'));  --  Augmentation
+         Gen_8 (Character'Pos ('R'));  --  Augmentation
+         Gen_8 (0);                    --  End of Augmentation
+         Gen_8 (1);   --  Code align factor
+         if Flags.M64 then
+            Dwarf.Gen_Sleb128 (-8); --  Data align factor
+            Dwarf.Gen_Uleb128 (16); --  Return address (16 = rip)
+         else
+            Dwarf.Gen_Sleb128 (-4);
+            Dwarf.Gen_Uleb128 (0);  --  TODO
+         end if;
+         Dwarf.Gen_Uleb128 (1); --  z: length of the remainder of augmentation
+         Gen_8 (16#23#);        --  R: pointer encoding: .text relative, udata4
+
+         --  CFIs (call frame instructions)
+         --  Initial state: cfa = rsp + 8, rip = -8@cfa
+         Gen_8 (16#0c#);  --  DW_CFA_def_cfa
+         Gen_8 (16#07#);  --    reg 7 (rsp)
+         Gen_8 (16#08#);  --    offset 8
+         Gen_8 (16#80# or 16#10#); --  DW_CFA_def_offset reg 16 (rip)
+         Gen_8 (16#01#);           --   offset 1 * (-8) = -8
+         --  push %rbp, cfa = rsp + 16
+         Gen_8 (16#40# or 16#01#); --  DW_CFA_advance_loc +1
+         Gen_8 (16#0e#);           --  DW_CFA_def_cfa_offset
+         Gen_8 (16#10#);           --   offset 16
+         Gen_8 (16#80# or 16#06#); --  DW_CFA_def_offset reg 6 (rbp)
+         Gen_8 (16#02#);           --   offset 2 * (-8) = -16
+         --  movq %rsp, %rbp, cfa = rbp + 16
+         Gen_8 (16#40# or 16#03#); --  DW_CFA_advance_loc +3
+         Gen_8 (16#0d#);           --  DW_CFA_def_cfa_register
+         Gen_8 (16#06#);           --   reg 6 (rbp)
+         Gen_8 (0);                --  nop
+         Gen_8 (0);                --  nop
+         Set_Current_Section (Sect_Text);
+      end if;
+
       if Flag_Debug /= Debug_None then
          Dwarf.Init;
          Set_Current_Section (Sect_Text);
@@ -3309,6 +3371,12 @@ package body Ortho_Code.X86.Emits is
          Set_Current_Section (Sect_Text);
          Dwarf.Finish;
       end if;
+
+      if Flags.Eh_Frame then
+         Set_Current_Section (Sect_Eh_Frame);
+         Prealloc (4);
+         Gen_32 (0);  --  Size = 0 -> end.
+      end if;
    end Finish;
 
 end Ortho_Code.X86.Emits;
diff --git a/src/ortho/mcode/ortho_code-x86-emits.ads b/src/ortho/mcode/ortho_code-x86-emits.ads
index 97802cd19..edd327884 100644
--- a/src/ortho/mcode/ortho_code-x86-emits.ads
+++ b/src/ortho/mcode/ortho_code-x86-emits.ads
@@ -31,6 +31,12 @@ package Ortho_Code.X86.Emits is
    type Intrinsic_Symbols_Map is array (Intrinsics_X86) of Symbol;
    Intrinsics_Symbol : Intrinsic_Symbols_Map;
 
+   --  Well known sections.
+   Sect_Text : Section_Acc;
+   Sect_Rodata : Section_Acc;
+   Sect_Bss : Section_Acc;
+   Sect_Eh_Frame : Section_Acc;
+
    Mcount_Symbol : Symbol;
    Chkstk_Symbol : Symbol;
 end Ortho_Code.X86.Emits;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_linux.ads b/src/ortho/mcode/ortho_code-x86-flags_linux.ads
index a6ef992b8..119158ee8 100644
--- a/src/ortho/mcode/ortho_code-x86-flags_linux.ads
+++ b/src/ortho/mcode/ortho_code-x86-flags_linux.ads
@@ -30,6 +30,9 @@ package Ortho_Code.X86.Flags_Linux is
    --  32 bits.
    M64 : constant Boolean := False;
 
+   --  Generate eh_frame for unwinding.
+   Eh_Frame : constant Boolean := False;
+
    --  Not Windows x64 calling convention.
    Win64 : constant Boolean := False;
 end Ortho_Code.X86.Flags_Linux;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_linux64.ads b/src/ortho/mcode/ortho_code-x86-flags_linux64.ads
index 6a34106fc..bb46a732d 100644
--- a/src/ortho/mcode/ortho_code-x86-flags_linux64.ads
+++ b/src/ortho/mcode/ortho_code-x86-flags_linux64.ads
@@ -27,9 +27,12 @@ package Ortho_Code.X86.Flags_Linux64 is
    --  Alignment for double (64 bit float).
    Mode_F64_Align : constant Natural := 3;
 
-   --  32 bits.
+   --  64 bits.
    M64 : constant Boolean := True;
 
+   --  Generate eh_frame for unwinding.
+   Eh_Frame : constant Boolean := True;
+
    --  Not Windows x64 calling convention.
    Win64 : constant Boolean := False;
 end Ortho_Code.X86.Flags_Linux64;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_macosx.ads b/src/ortho/mcode/ortho_code-x86-flags_macosx.ads
index 552cf00a9..a14b310a6 100644
--- a/src/ortho/mcode/ortho_code-x86-flags_macosx.ads
+++ b/src/ortho/mcode/ortho_code-x86-flags_macosx.ads
@@ -30,6 +30,9 @@ package Ortho_Code.X86.Flags_Macosx is
    --  32 bits.
    M64 : constant Boolean := False;
 
+   --  Generate eh_frame for unwinding.
+   Eh_Frame : constant Boolean := False;
+
    --  Not Windows x64 calling convention.
    Win64 : constant Boolean := False;
 end Ortho_Code.X86.Flags_Macosx;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_macosx64.ads b/src/ortho/mcode/ortho_code-x86-flags_macosx64.ads
index a32291766..6f133afa9 100644
--- a/src/ortho/mcode/ortho_code-x86-flags_macosx64.ads
+++ b/src/ortho/mcode/ortho_code-x86-flags_macosx64.ads
@@ -30,6 +30,9 @@ package Ortho_Code.X86.Flags_Macosx64 is
    --  64 bits.
    M64 : constant Boolean := True;
 
+   --  Generate eh_frame for unwinding.
+   Eh_Frame : constant Boolean := False;
+
    --  Not Windows x64 calling convention.
    Win64 : constant Boolean := False;
 end Ortho_Code.X86.Flags_Macosx64;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_windows.ads b/src/ortho/mcode/ortho_code-x86-flags_windows.ads
index fa74bca58..921868410 100644
--- a/src/ortho/mcode/ortho_code-x86-flags_windows.ads
+++ b/src/ortho/mcode/ortho_code-x86-flags_windows.ads
@@ -30,6 +30,9 @@ package Ortho_Code.X86.Flags_Windows is
    --  32 bits.
    M64 : constant Boolean := False;
 
+   --  Generate eh_frame for unwinding.
+   Eh_Frame : constant Boolean := False;
+
    --  Not Windows x64 calling convention.
    Win64 : constant Boolean := False;
 end Ortho_Code.X86.Flags_Windows;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_windows64.ads b/src/ortho/mcode/ortho_code-x86-flags_windows64.ads
index 8fd76f2ae..cf7320188 100644
--- a/src/ortho/mcode/ortho_code-x86-flags_windows64.ads
+++ b/src/ortho/mcode/ortho_code-x86-flags_windows64.ads
@@ -30,6 +30,9 @@ package Ortho_Code.X86.Flags_Windows64 is
    --  64 bits.
    M64 : constant Boolean := True;
 
+   --  Generate eh_frame for unwinding.
+   Eh_Frame : constant Boolean := False;
+
    --  Windows x64 calling convention.
    Win64 : constant Boolean := True;
 end Ortho_Code.X86.Flags_Windows64;
diff --git a/src/ortho/mcode/ortho_jit.adb b/src/ortho/mcode/ortho_jit.adb
index 9be0f054a..84145f747 100644
--- a/src/ortho/mcode/ortho_jit.adb
+++ b/src/ortho/mcode/ortho_jit.adb
@@ -66,6 +66,8 @@ package body Ortho_Jit is
          return;
       end if;
 
+      Ortho_Code.Abi.Register_Unwind;
+
       if Snap_Filename /= null then
          declare
             use Ada.Text_IO;