ortho/mcode: pack all sections for huge programs on x86-64.

For #698

5 files changed, 105 insertions, 34 deletions

diff --git a/src/ortho/mcode/binary_file-memory.adb b/src/ortho/mcode/binary_file-memory.adb
index 99789c602..0a41803f7 100644
--- a/src/ortho/mcode/binary_file-memory.adb
+++ b/src/ortho/mcode/binary_file-memory.adb
@@ -77,30 +77,96 @@ package body Binary_File.Memory is
       end if;
    end Write_Memory_Init;
 
+   type Segment_Kind is (Seg_Text, Seg_Ro, Seg_Data, Seg_None);
+
+   function Get_Segment (Sect : Section_Acc) return Segment_Kind is
+   begin
+      if Sect = Sect_Abs then
+         return Seg_None;
+      end if;
+      if (Sect.Flags and Section_Exec) /= 0 then
+         return Seg_Text;
+      elsif (Sect.Flags and Section_Write) /= 0 then
+         return Seg_Data;
+      elsif (Sect.Flags and Section_Read) /= 0 then
+         return Seg_Ro;
+      else
+         return Seg_None;
+      end if;
+   end Get_Segment;
+
    procedure Write_Memory_Relocate (Error : out Boolean)
    is
+      Log_Pagesize : constant := 12;
+      type Seg_Size_Array is array (Segment_Kind) of Pc_Type;
+      Seg_Size : Seg_Size_Array;
+      Seg_Offs : Seg_Size_Array;
+      Size : Pc_Type;
+      Program_Seg : Memsegs.Memseg_Type;
+      Program : Byte_Array_Acc;
       Sect : Section_Acc;
       Rel : Reloc_Acc;
       N_Rel : Reloc_Acc;
    begin
-      --  Relocate section in memory.
+      --  Compute sizes.
+      Seg_Size := (others => 0);
       Sect := Section_Chain;
       while Sect /= null loop
-         --  Allocate memory if needed (eg: .bss)
-         if Sect.Data = null then
-            if Sect.Pc > 0 then
-               Resize (Sect, Sect.Pc);
-               Sect.Data (0 .. Sect.Pc - 1) := (others => 0);
-            end if;
-         end if;
+         declare
+            Seg : constant Segment_Kind := Get_Segment (Sect);
+         begin
+            Seg_Size (Seg) :=
+              Pow_Align (Seg_Size (Seg), Sect.Align) + Sect.Pc;
+         end;
+         Sect := Sect.Next;
+      end loop;
 
-         --  Set virtual address.
-         if Sect.Pc > 0
-           and (Sect /= Sect_Abs and Sect.Flags /= Section_Debug)
-         then
-            Sect.Vaddr := To_Pc_Type (Sect.Data (0)'Address);
-         end if;
+      --  Align.
+      for I in Seg_Text .. Seg_Data loop
+         Seg_Size (I) := Pow_Align (Seg_Size (I), Log_Pagesize);
+      end loop;
 
+      --  Whole size.
+      Size := 0;
+      for I in Seg_Text .. Seg_Data loop
+         Size := Size + Seg_Size (I);
+      end loop;
+
+      --  Allocate and copy.
+      Program_Seg := Memsegs.Create;
+      Memsegs.Resize (Program_Seg, Natural (Size));
+      Program := To_Byte_Array_Acc (Memsegs.Get_Address (Program_Seg));
+      Seg_Offs (Seg_Text) := 0;
+      Seg_Offs (Seg_Ro) := Seg_Size (Seg_Text);
+      Seg_Offs (Seg_Data) := Seg_Size (Seg_Text) + Seg_Size (Seg_Ro);
+
+      Sect := Section_Chain;
+      while Sect /= null loop
+         declare
+            Seg : constant Segment_Kind := Get_Segment (Sect);
+            Off : Pc_Type renames Seg_Offs (Seg);
+         begin
+            if Seg /= Seg_None then
+               if Sect.Pc > 0 then
+                  Off := Pow_Align (Off, Sect.Align);
+                  if Sect.Data = null then
+                     --  For bss.
+                     Program (Off .. Off + Sect.Pc - 1) := (others => 0);
+                  else
+                     Program (Off .. Off + Sect.Pc - 1) :=
+                       Sect.Data (0 .. Sect.Pc - 1);
+                     Memsegs.Delete (Sect.Seg);
+                  end if;
+
+                  Sect.Data := To_Byte_Array_Acc (Program (Off)'Address);
+
+                  --  Set virtual address.
+                  Sect.Vaddr := To_Pc_Type (Program (Off)'Address);
+
+                  Off := Off + Sect.Pc;
+               end if;
+            end if;
+         end;
          Sect := Sect.Next;
       end loop;
 
@@ -128,14 +194,12 @@ package body Binary_File.Memory is
          Sect.Last_Reloc := null;
          Sect.Nbr_Relocs := 0;
 
-         if (Sect.Flags and Section_Exec) /= 0
-           and (Sect.Flags and Section_Write) = 0
-         then
-            Memsegs.Set_Rx (Sect.Seg);
-         end if;
-
          Sect := Sect.Next;
       end loop;
+
+      if Seg_Size (Seg_Text) /= 0 then
+         Memsegs.Set_Rx (Program_Seg, 0, Natural (Seg_Size (Seg_Text)));
+      end if;
    end Write_Memory_Relocate;
 
    function Get_Section_Addr (Sect : Section_Acc) return System.Address is
diff --git a/src/ortho/mcode/binary_file.adb b/src/ortho/mcode/binary_file.adb
index 7d8b9348a..d666a6626 100644
--- a/src/ortho/mcode/binary_file.adb
+++ b/src/ortho/mcode/binary_file.adb
@@ -18,7 +18,6 @@
 with System.Storage_Elements;
 with Ada.Text_IO; use Ada.Text_IO;
 with Ada.Characters.Latin_1;
-with Ada.Unchecked_Conversion;
 with Hex_Images; use Hex_Images;
 with Disassemble;
 
@@ -27,9 +26,6 @@ package body Binary_File is
 
    HT : Character renames Ada.Characters.Latin_1.HT;
 
-   function To_Byte_Array_Acc is new Ada.Unchecked_Conversion
-     (Source => System.Address, Target => Byte_Array_Acc);
-
    --  Resize a section to SIZE bytes.
    procedure Resize (Sect : Section_Acc; Size : Pc_Type) is
    begin
@@ -182,7 +178,9 @@ package body Binary_File is
       Rel := Src.First_Reloc;
 
       if Rel /= null then
-         --  Move relocs.
+         --  Move internal relocs.
+         --  Note: external relocs are not modified, so they can still refer
+         --  to this SRC section.
          if Dest.Last_Reloc = null then
             Dest.First_Reloc := Rel;
             Dest.Last_Reloc := Rel;
@@ -192,7 +190,6 @@ package body Binary_File is
          end if;
          Dest.Nbr_Relocs := Dest.Nbr_Relocs + Src.Nbr_Relocs;
 
-
          --  Reloc reloc, since the pc has changed.
          while Rel /= null loop
             Rel.Addr := Rel.Addr + Dest.Pc;
@@ -201,6 +198,7 @@ package body Binary_File is
       end if;
 
       if Src.Pc > 0 then
+         --  Alignment is assumed to be compatible...
          Sect_Prealloc (Dest, Src.Pc);
          Dest.Data (Dest.Pc .. Dest.Pc + Src.Pc - 1) :=
            Src.Data (0 .. Src.Pc - 1);
@@ -618,10 +616,9 @@ package body Binary_File is
 
    function Pow_Align (V : Pc_Type; Align : Natural) return Pc_Type
    is
-      Tmp : Pc_Type;
+      Mask : constant Pc_Type := (2 ** Align) - 1;
    begin
-      Tmp := V + 2 ** Align - 1;
-      return Tmp - (Tmp mod Pc_Type (2 ** Align));
+      return (V + Mask) and not Mask;
    end Pow_Align;
 
    procedure Gen_Pow_Align (Align : Natural) is
diff --git a/src/ortho/mcode/binary_file.ads b/src/ortho/mcode/binary_file.ads
index d583f2d39..715ff8908 100644
--- a/src/ortho/mcode/binary_file.ads
+++ b/src/ortho/mcode/binary_file.ads
@@ -18,6 +18,7 @@
 with System;
 with Interfaces; use Interfaces;
 with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
 with Ortho_Ident; use Ortho_Ident;
 with Tables;
 with Memsegs;
@@ -160,6 +161,10 @@ private
    subtype Byte_Array is Byte_Array_Base (Pc_Type);
    type Byte_Array_Acc is access Byte_Array;
    pragma No_Strict_Aliasing (Byte_Array_Acc);
+
+   function To_Byte_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Byte_Array_Acc);
+
    type String_Acc is access String;
    --type Section_Flags is new Unsigned_32;
 
diff --git a/src/ortho/mcode/memsegs_mmap.adb b/src/ortho/mcode/memsegs_mmap.adb
index 1ee8e7bcf..d007aca63 100644
--- a/src/ortho/mcode/memsegs_mmap.adb
+++ b/src/ortho/mcode/memsegs_mmap.adb
@@ -15,6 +15,9 @@
 --  along with GCC; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
+
+with System.Storage_Elements;
+
 package body Memsegs_Mmap is
    function Mmap_Malloc (Size : Natural) return Address;
    pragma Import (C, Mmap_Malloc, "mmap_malloc");
@@ -56,9 +59,11 @@ package body Memsegs_Mmap is
       Seg.Size := 0;
    end Delete;
 
-   procedure Set_Rx (Seg : in out Memseg_Type) is
+   procedure Set_Rx (Seg : in out Memseg_Type;
+                     Offset : Natural; Size : Natural)
+   is
+      use System.Storage_Elements;
    begin
-      Mmap_Rx (Seg.Base, Seg.Size);
+      Mmap_Rx (Seg.Base + Storage_Offset (Offset), Size);
    end Set_Rx;
 end Memsegs_Mmap;
-
diff --git a/src/ortho/mcode/memsegs_mmap.ads b/src/ortho/mcode/memsegs_mmap.ads
index ba7d76618..76843193f 100644
--- a/src/ortho/mcode/memsegs_mmap.ads
+++ b/src/ortho/mcode/memsegs_mmap.ads
@@ -36,7 +36,8 @@ package Memsegs_Mmap is
    procedure Delete (Seg : in out Memseg_Type);
 
    --  Set the protection to read+execute.
-   procedure Set_Rx (Seg : in out Memseg_Type);
+   procedure Set_Rx (Seg : in out Memseg_Type;
+                     Offset : Natural; Size : Natural);
 
    pragma Inline (Create);
    pragma Inline (Get_Address);
@@ -46,4 +47,3 @@ private
       Size : Natural := 0;
    end record;
 end Memsegs_Mmap;
-