aboutsummaryrefslogtreecommitdiffstats
path: root/src/ortho/mcode
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2018-11-19 20:47:30 +0100
committerTristan Gingold <tgingold@free.fr>2018-11-19 20:47:30 +0100
commitfef22520072c40329a5e61559a723666748c7a0e (patch)
tree3e61bfbe69b8d77707fda2a712eedc7e0fe2afb8 /src/ortho/mcode
parent59a7cdd7433954e651b94576c3573317f695b4f5 (diff)
downloadghdl-fef22520072c40329a5e61559a723666748c7a0e.tar.gz
ghdl-fef22520072c40329a5e61559a723666748c7a0e.tar.bz2
ghdl-fef22520072c40329a5e61559a723666748c7a0e.zip
ortho/mcode: pack all sections for huge programs on x86-64.
For #698
Diffstat (limited to 'src/ortho/mcode')
-rw-r--r--src/ortho/mcode/binary_file-memory.adb104
-rw-r--r--src/ortho/mcode/binary_file.adb15
-rw-r--r--src/ortho/mcode/binary_file.ads5
-rw-r--r--src/ortho/mcode/memsegs_mmap.adb11
-rw-r--r--src/ortho/mcode/memsegs_mmap.ads4
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;
-