ortho/mcode: handle image relative relocation (for Win64)

3 files changed, 29 insertions, 4 deletions

diff --git a/src/ortho/mcode/binary_file-memory.adb b/src/ortho/mcode/binary_file-memory.adb
index 485325b8a..2442952c1 100644
--- a/src/ortho/mcode/binary_file-memory.adb
+++ b/src/ortho/mcode/binary_file-memory.adb
@@ -113,8 +113,9 @@ package body Binary_File.Memory is
          declare
             Seg : constant Segment_Kind := Get_Segment (Sect);
          begin
-            Seg_Size (Seg) :=
-              Pow_Align (Seg_Size (Seg), Sect.Align) + Sect.Pc;
+            --  Currently, offset in the segment.
+            Sect.Img_Off := Pow_Align (Seg_Size (Seg), Sect.Align);
+            Seg_Size (Seg) := Sect.Img_Off + Sect.Pc;
          end;
          Sect := Sect.Next;
       end loop;
@@ -145,6 +146,9 @@ package body Binary_File.Memory is
             Off : Pc_Type renames Seg_Offs (Seg);
          begin
             if Seg /= Seg_None then
+               --  From segment offset to image offset.
+               Sect.Img_Off := Sect.Img_Off + Seg_Offs (Seg);
+
                if Sect.Pc > 0 then
                   Off := Pow_Align (Off, Sect.Align);
                   if Sect.Data = null then
diff --git a/src/ortho/mcode/binary_file.adb b/src/ortho/mcode/binary_file.adb
index d061b4f2a..1a8291c64 100644
--- a/src/ortho/mcode/binary_file.adb
+++ b/src/ortho/mcode/binary_file.adb
@@ -132,7 +132,8 @@ package body Binary_File is
                                 Nbr_Relocs => 0,
                                 Number => 0,
                                 Seg => Memsegs.Create,
-                                Vaddr => 0);
+                                Vaddr => 0,
+                                Img_Off => 0);
       if (Flags and Section_Zero) = 0 then
          --  Allocate memory for the segment, unless BSS.
          Resize (Sect, 8192);
@@ -792,6 +793,15 @@ package body Binary_File is
       Gen_32 (Conv (Offset));
    end Gen_X86_32;
 
+   procedure Gen_X86_Img_32 (Sym : Symbol; Offset : Unsigned_32) is
+   begin
+      pragma Assert (Arch = Arch_X86_64 or Arch = Arch_X86);
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_Img_32);
+      end if;
+      Gen_32 (Offset);
+   end Gen_X86_Img_32;
+
    procedure Gen_Sparc_32 (Sym : Symbol; Offset : Integer_32) is
    begin
       if Sym /= Null_Symbol then
@@ -886,6 +896,11 @@ package body Binary_File is
                     To_Unsigned_32 (Get_Symbol_Vaddr (Sym)
                                       - (Sect.Vaddr + Addr)
                                         - Reloc.Neg_Addend));
+         when Reloc_Img_32 =>
+            Add_32 (Sect, Addr,
+                    To_Unsigned_32 (Get_Symbol_Value (Sym)
+                                      + Get_Section (Sym).Img_Off));
+
          when Reloc_Disp22 =>
             Set_Wdisp (Sect, Addr, Sym, 22);
          when Reloc_Disp30 =>
diff --git a/src/ortho/mcode/binary_file.ads b/src/ortho/mcode/binary_file.ads
index c3f829d70..675c4832c 100644
--- a/src/ortho/mcode/binary_file.ads
+++ b/src/ortho/mcode/binary_file.ads
@@ -116,6 +116,10 @@ package Binary_File is
    procedure Gen_X86_32 (Sym : Symbol; Offset : Integer_32);
    procedure Gen_Sparc_32 (Sym : Symbol; Offset : Integer_32);
 
+   --  Image based address (for Win64 unwind info)
+   --  The result is a 32b offset from the image base to SYM + OFFSET
+   procedure Gen_X86_Img_32 (Sym : Symbol; Offset : Unsigned_32);
+
    procedure Gen_Ppc_24 (V : Unsigned_32; Sym : Symbol);
 
    procedure Gen_Ua_Addr (Sym : Symbol; Offset : Integer_32);
@@ -172,7 +176,7 @@ private
 
    --  Relocations.
    type Reloc_Kind is (Reloc_32, Reloc_Pc32,
-                       Reloc_Abs,
+                       Reloc_Abs, Reloc_Img_32,
                        Reloc_Ua_32, Reloc_Ua_Addr,
                        Reloc_Disp22, Reloc_Disp30,
                        Reloc_Hi22, Reloc_Lo10,
@@ -226,6 +230,8 @@ private
       Number : Natural;
       --  Virtual address, if set.
       Vaddr : Pc_Type; -- SSE.Integer_Address;
+      --  Offset relative to the image start
+      Img_Off : Pc_Type;
       --  Memory for this segment.
       Seg : Memsegs.Memseg_Type;
    end record;