From 9525af450ca384c9a081297f7ce63a30af944b09 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 29 Jan 2023 20:27:45 +0100 Subject: synth: represent access types as pointers in memory --- src/synth/elab-memtype.adb | 7 ++++ src/synth/elab-memtype.ads | 1 + src/synth/elab-vhdl_debug.adb | 16 +++++--- src/synth/elab-vhdl_heap.adb | 80 +++++++++++++++++++++++++----------- src/synth/elab-vhdl_heap.ads | 15 +++++-- src/synth/elab-vhdl_objtypes.adb | 4 +- src/synth/elab-vhdl_objtypes.ads | 10 +++++ src/synth/elab-vhdl_values-debug.adb | 3 +- src/synth/elab-vhdl_values.adb | 16 ++++---- src/synth/elab-vhdl_values.ads | 11 ++--- src/synth/synth-vhdl_expr.adb | 10 ++--- src/synth/synth-vhdl_static_proc.adb | 8 ++-- src/synth/synth-vhdl_stmts.adb | 4 +- 13 files changed, 125 insertions(+), 60 deletions(-) diff --git a/src/synth/elab-memtype.adb b/src/synth/elab-memtype.adb index 91e38a900..ed09f5c57 100644 --- a/src/synth/elab-memtype.adb +++ b/src/synth/elab-memtype.adb @@ -28,6 +28,13 @@ package body Elab.Memtype is return To_Memory_Ptr (To_Address (Base) + Storage_Offset (Off)); end "+"; + function "-" (Base : Memory_Ptr; Off : Size_Type) return Memory_Ptr + is + use System.Storage_Elements; + begin + return To_Memory_Ptr (To_Address (Base) - Storage_Offset (Off)); + end "-"; + type Ghdl_U8_Ptr is access all Ghdl_U8; function To_U8_Ptr is new Ada.Unchecked_Conversion (Address, Ghdl_U8_Ptr); diff --git a/src/synth/elab-memtype.ads b/src/synth/elab-memtype.ads index 2b4cb14e7..adda31158 100644 --- a/src/synth/elab-memtype.ads +++ b/src/synth/elab-memtype.ads @@ -42,6 +42,7 @@ package Elab.Memtype is -- Low-level functions. function "+" (Base : Memory_Ptr; Off : Size_Type) return Memory_Ptr; + function "-" (Base : Memory_Ptr; Off : Size_Type) return Memory_Ptr; procedure Write_U8 (Mem : Memory_Ptr; Val : Ghdl_U8); function Read_U8 (Mem : Memory_Ptr) return Ghdl_U8; diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb index 1f0eb40d9..90751e8f6 100644 --- a/src/synth/elab-vhdl_debug.adb +++ b/src/synth/elab-vhdl_debug.adb @@ -243,13 +243,13 @@ package body Elab.Vhdl_Debug is Disp_Value_Record (M, Vtype); when Type_Access => declare - Idx : constant Heap_Index := Read_Access (M); + Ptr : constant Heap_Ptr := Read_Access (M); begin - if Idx = Null_Heap_Index then + if Ptr = Null_Heap_Ptr then Put ("null"); else Put ("@"); - Put_Uns32 (Uns32 (Idx)); + Put_Uns32 (Uns32 (Elab.Vhdl_Heap.Get_Index (Ptr))); end if; end; when Type_Protected => @@ -1430,6 +1430,7 @@ package body Elab.Vhdl_Debug is F : Natural; Idx : Uns32; Valid : Boolean; + Ptr : Heap_Ptr; Mt : Memtyp; begin F := Skip_Blanks (Line, Line'First); @@ -1438,8 +1439,13 @@ package body Elab.Vhdl_Debug is Put_Line ("invalid heap index"); return; end if; - Mt := Elab.Vhdl_Heap.Synth_Dereference (Heap_Index (Idx)); - Debug_Memtyp (Mt); + Ptr := Elab.Vhdl_Heap.Get_Pointer (Elab.Vhdl_Heap.Heap_Slot (Idx)); + if Ptr = Null_Heap_Ptr then + Put_Line ("invalid heap index"); + else + Mt := Elab.Vhdl_Heap.Synth_Dereference (Ptr); + Debug_Memtyp (Mt); + end if; end Print_Heap_Proc; procedure Info_Lib_Proc (Line : String) diff --git a/src/synth/elab-vhdl_heap.adb b/src/synth/elab-vhdl_heap.adb index ed026a64e..8b125c589 100644 --- a/src/synth/elab-vhdl_heap.adb +++ b/src/synth/elab-vhdl_heap.adb @@ -18,21 +18,39 @@ with Ada.Unchecked_Conversion; -with Types; use Types; with Tables; with Elab.Memtype; use Elab.Memtype; package body Elab.Vhdl_Heap is + -- Each object on the heap is prefixed by this prefix (to easily convert + -- to an index). + type Slot_Prefix is record + Slot : Heap_Slot; + Pad : Uns32; + end record; + + -- Size of the prefix. + Prefix_Size : constant Size_Type := Size_Type (Slot_Prefix'Size / 8); + + type Slot_Prefix_Acc is access all Slot_Prefix; + + function To_Slot_Prefix_Acc is new Ada.Unchecked_Conversion + (Source => Memory_Ptr, Target => Slot_Prefix_Acc); + + -- Each allocated object on the heap is referenced in the heap table. + -- This is the entry in the table. type Heap_Entry is record - Obj : Memory_Ptr; + -- Pointer to the prefix. + Ptr : Memory_Ptr; + -- Type of the object. Typ : Memory_Ptr; end record; package Heap_Table is new Tables (Table_Component_Type => Heap_Entry, - Table_Index_Type => Heap_Index, + Table_Index_Type => Heap_Slot, Table_Low_Bound => 1, Table_Initial => 16); @@ -43,16 +61,18 @@ package body Elab.Vhdl_Heap is -- OBJ_TYP is the object type. procedure Allocate (Acc_Typ : Type_Acc; Obj_Typ : Type_Acc; - Res : out Memory_Ptr; - Idx : out Heap_Index) + Res : out Memory_Ptr) is Typ_Sz : constant Size_Type := Acc_Typ.Acc_Bnd_Sz; E : Heap_Entry; begin pragma Assert (Acc_Typ.Kind = Type_Access); - E.Obj := Alloc_Mem (Obj_Typ.Sz); + -- Allocate memory for the object and the prefix. + E.Ptr := Alloc_Mem (Prefix_Size + Obj_Typ.Sz); + Res := E.Ptr + Prefix_Size; + -- Allocate the memory for the type. if Typ_Sz > 0 then declare T : Type_Acc; @@ -70,42 +90,54 @@ package body Elab.Vhdl_Heap is end; end if; - Res := E.Obj; - Heap_Table.Append (E); - Idx := Heap_Table.Last; + To_Slot_Prefix_Acc (E.Ptr).Slot := Heap_Table.Last; end Allocate; function Allocate_By_Type (Acc_Typ : Type_Acc; T : Type_Acc) - return Heap_Index + return Heap_Ptr is Res : Memory_Ptr; - Idx : Heap_Index; begin - Allocate (Acc_Typ, T, Res, Idx); + Allocate (Acc_Typ, T, Res); Write_Value_Default (Res, T); - return Idx; + return Heap_Ptr (Res); end Allocate_By_Type; function Allocate_By_Value (Acc_Typ : Type_Acc; V : Valtyp) - return Heap_Index + return Heap_Ptr is Mem : Memory_Ptr; - Idx : Heap_Index; begin - Allocate (Acc_Typ, V.Typ, Mem, Idx); + Allocate (Acc_Typ, V.Typ, Mem); Write_Value (Mem, V); - return Idx; + return Heap_Ptr (Mem); end Allocate_By_Value; - function Synth_Dereference (Idx : Heap_Index) return Memtyp + function Get_Index (Ptr : Heap_Ptr) return Heap_Slot + is + Pfx : constant Memory_Ptr := Memory_Ptr (Ptr) - Prefix_Size; + begin + return To_Slot_Prefix_Acc (Pfx).Slot; + end Get_Index; + + function Get_Pointer (Idx : Heap_Slot) return Heap_Ptr + is + Pfx : constant Memory_Ptr := Heap_Table.Table (Idx).Ptr; + begin + return Heap_Ptr (Pfx + Prefix_Size); + end Get_Pointer; + + function Synth_Dereference (Ptr : Heap_Ptr) return Memtyp is function To_Type_Acc is new Ada.Unchecked_Conversion (Memory_Ptr, Type_Acc); - E : Heap_Entry renames Heap_Table.Table (Idx); + Slot : constant Heap_Slot := Get_Index (Ptr); + + E : Heap_Entry renames Heap_Table.Table (Slot); begin - return (To_Type_Acc (E.Typ), E.Obj); + return (To_Type_Acc (E.Typ), E.Ptr + Prefix_Size); end Synth_Dereference; procedure Free (Obj : in out Heap_Entry) is @@ -114,12 +146,14 @@ package body Elab.Vhdl_Heap is Obj := (null, null); end Free; - procedure Synth_Deallocate (Idx : Heap_Index) is + procedure Synth_Deallocate (Ptr : Heap_Ptr) + is + Slot : constant Heap_Slot := Get_Index (Ptr); begin - if Heap_Table.Table (Idx).Obj = null then + if Heap_Table.Table (Slot).Ptr = null then return; end if; - Free (Heap_Table.Table (Idx)); + Free (Heap_Table.Table (Slot)); end Synth_Deallocate; end Elab.Vhdl_Heap; diff --git a/src/synth/elab-vhdl_heap.ads b/src/synth/elab-vhdl_heap.ads index 7c2846a31..668ec0df8 100644 --- a/src/synth/elab-vhdl_heap.ads +++ b/src/synth/elab-vhdl_heap.ads @@ -16,6 +16,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . +with Types; use Types; + with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; with Elab.Vhdl_Values; use Elab.Vhdl_Values; @@ -23,11 +25,16 @@ package Elab.Vhdl_Heap is -- Allocate a value. function Allocate_By_Type (Acc_Typ : Type_Acc; T : Type_Acc) - return Heap_Index; + return Heap_Ptr; function Allocate_By_Value (Acc_Typ : Type_Acc; V : Valtyp) - return Heap_Index; + return Heap_Ptr; + + function Synth_Dereference (Ptr : Heap_Ptr) return Memtyp; + + procedure Synth_Deallocate (Ptr : Heap_Ptr); - function Synth_Dereference (Idx : Heap_Index) return Memtyp; + type Heap_Slot is new Uns32; - procedure Synth_Deallocate (Idx : Heap_Index); + function Get_Index (Ptr : Heap_Ptr) return Heap_Slot; + function Get_Pointer (Idx : Heap_Slot) return Heap_Ptr; end Elab.Vhdl_Heap; diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb index 38d7376a4..f59380091 100644 --- a/src/synth/elab-vhdl_objtypes.adb +++ b/src/synth/elab-vhdl_objtypes.adb @@ -689,9 +689,9 @@ package body Elab.Vhdl_Objtypes is end if; return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Access, Wkind => Wkind_Sim, - Al => 2, + Al => Heap_Ptr_Al, Is_Global => False, - Sz => 4, + Sz => Heap_Ptr_Sz, W => 1, Acc_Acc => Acc_Type, Acc_Bnd_Sz => Bnd_Sz))); diff --git a/src/synth/elab-vhdl_objtypes.ads b/src/synth/elab-vhdl_objtypes.ads index c46095a3d..dcd29a6cf 100644 --- a/src/synth/elab-vhdl_objtypes.ads +++ b/src/synth/elab-vhdl_objtypes.ads @@ -217,6 +217,16 @@ package Elab.Vhdl_Objtypes is Null_Memtyp : constant Memtyp := (null, null); + -- Representation of an access: a pointer inside the heap. + type Heap_Ptr is new Memory_Ptr; + Null_Heap_Ptr : constant Heap_Ptr := null; + + Heap_Ptr_Sz : constant Size_Type := Size_Type (Heap_Ptr'Size / 8); + + Heap_Ptr_Al : constant Palign_Type := + 2 * Boolean'Pos (Heap_Ptr_Sz = 4) + + 3 * Boolean'Pos (Heap_Ptr_Sz = 8); + -- Memory pools, which defines where the memory is allocated for data, -- types, values... diff --git a/src/synth/elab-vhdl_values-debug.adb b/src/synth/elab-vhdl_values-debug.adb index 63718b55d..de640eae8 100644 --- a/src/synth/elab-vhdl_values-debug.adb +++ b/src/synth/elab-vhdl_values-debug.adb @@ -20,6 +20,7 @@ with Simple_IO; use Simple_IO; with Utils_IO; use Utils_IO; with Vhdl.Nodes; use Vhdl.Nodes; +with Elab.Vhdl_Heap; package body Elab.Vhdl_Values.Debug is procedure Put_Dir (Dir : Direction_Type) is @@ -273,7 +274,7 @@ package body Elab.Vhdl_Values.Debug is Put_Int64 (Read_Discrete (M)); when Type_Access => Put ("access: "); - Put_Uns32 (Uns32 (Read_Access (M))); + Put_Uns32 (Uns32 (Elab.Vhdl_Heap.Get_Index (Read_Access (M)))); when Type_File => Put ("file"); when Type_Float => diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb index d1bdf15be..0a1a4b982 100644 --- a/src/synth/elab-vhdl_values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -357,25 +357,25 @@ package body Elab.Vhdl_Values is return Res; end Unshare; - procedure Write_Access (Mem : Memory_Ptr; Val : Heap_Index) + procedure Write_Access (Mem : Memory_Ptr; Val : Heap_Ptr) is - V : Heap_Index; + V : Heap_Ptr; for V'Address use Mem.all'Address; pragma Import (Ada, V); begin V := Val; end Write_Access; - function Read_Access (Mem : Memory_Ptr) return Heap_Index + function Read_Access (Mem : Memory_Ptr) return Heap_Ptr is - V : Heap_Index; + V : Heap_Ptr; for V'Address use Mem.all'Address; pragma Import (Ada, V); begin return V; end Read_Access; - function Read_Access (Mt : Memtyp) return Heap_Index is + function Read_Access (Mt : Memtyp) return Heap_Ptr is begin return Read_Access (Mt.Mem); end Read_Access; @@ -430,7 +430,7 @@ package body Elab.Vhdl_Values is return Read_Fp64 (Vt.Val.Mem); end Read_Fp64; - function Read_Access (Vt : Valtyp) return Heap_Index is + function Read_Access (Vt : Valtyp) return Heap_Ptr is begin pragma Assert (Vt.Typ.Kind = Type_Access); return Read_Access (Get_Memory (Vt)); @@ -526,7 +526,7 @@ package body Elab.Vhdl_Values is Typ.Rec.E (I).Typ); end loop; when Type_Access => - Write_Access (M, Null_Heap_Index); + Write_Access (M, Null_Heap_Ptr); when Type_File | Type_Protected => raise Internal_Error; @@ -542,7 +542,7 @@ package body Elab.Vhdl_Values is return Res; end Create_Value_Default; - function Create_Value_Access (Val : Heap_Index; Acc_Typ : Type_Acc) + function Create_Value_Access (Val : Heap_Ptr; Acc_Typ : Type_Acc) return Valtyp is Res : Valtyp; diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads index adf11ae8e..21ea4a35b 100644 --- a/src/synth/elab-vhdl_values.ads +++ b/src/synth/elab-vhdl_values.ads @@ -70,9 +70,6 @@ package Elab.Vhdl_Values is type Value_Acc is access Value_Type; - type Heap_Index is new Uns32; - Null_Heap_Index : constant Heap_Index := 0; - type Protected_Index is new Uns32; No_Protected_Index : constant Protected_Index := 0; @@ -164,7 +161,7 @@ package Elab.Vhdl_Values is function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) return Valtyp; - function Create_Value_Access (Val : Heap_Index; Acc_Typ : Type_Acc) + function Create_Value_Access (Val : Heap_Ptr; Acc_Typ : Type_Acc) return Valtyp; function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp; @@ -228,9 +225,9 @@ package Elab.Vhdl_Values is procedure Write_Discrete (Vt : Valtyp; Val : Int64); function Read_Discrete (Vt : Valtyp) return Int64; - procedure Write_Access (Mem : Memory_Ptr; Val : Heap_Index); - function Read_Access (Mt : Memtyp) return Heap_Index; - function Read_Access (Vt : Valtyp) return Heap_Index; + procedure Write_Access (Mem : Memory_Ptr; Val : Heap_Ptr); + function Read_Access (Mt : Memtyp) return Heap_Ptr; + function Read_Access (Vt : Valtyp) return Heap_Ptr; procedure Write_Protected (Mem : Memory_Ptr; Idx : Protected_Index); function Read_Protected (Mem : Memory_Ptr) return Protected_Index; diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index d194c4dcd..d1d705592 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -800,12 +800,12 @@ package body Synth.Vhdl_Expr is | Iir_Kind_Dereference => declare Val : Valtyp; - Acc : Heap_Index; + Acc : Heap_Ptr; Obj : Memtyp; begin Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); Acc := Read_Access (Val); - if Acc = Null_Heap_Index then + if Acc = Null_Heap_Ptr then Error_Msg_Synth (Syn_Inst, Name, "NULL access dereferenced"); return No_Valtyp; end if; @@ -2531,13 +2531,13 @@ package body Synth.Vhdl_Expr is return Create_Value_Memtyp (Mt); end; when Iir_Kind_Null_Literal => - return Create_Value_Access (Null_Heap_Index, Expr_Type); + return Create_Value_Access (Null_Heap_Ptr, Expr_Type); when Iir_Kind_Allocator_By_Subtype => declare Acc_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); T : Type_Acc; - Acc : Heap_Index; + Acc : Heap_Ptr; begin T := Synth_Subtype_Indication (Syn_Inst, Get_Subtype_Indication (Expr)); @@ -2549,7 +2549,7 @@ package body Synth.Vhdl_Expr is Acc_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); V : Valtyp; - Acc : Heap_Index; + Acc : Heap_Ptr; begin V := Synth_Expression_With_Type (Syn_Inst, Get_Expression (Expr), Expr_Type.Acc_Acc); diff --git a/src/synth/synth-vhdl_static_proc.adb b/src/synth/synth-vhdl_static_proc.adb index fdc33b121..80bb91513 100644 --- a/src/synth/synth-vhdl_static_proc.adb +++ b/src/synth/synth-vhdl_static_proc.adb @@ -24,6 +24,7 @@ with Vhdl.Errors; use Vhdl.Errors; with Elab.Memtype; with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Objtypes; with Elab.Vhdl_Heap; with Elab.Vhdl_Files; use Elab.Vhdl_Files; with Elab.Debugger; @@ -36,18 +37,19 @@ package body Synth.Vhdl_Static_Proc is procedure Synth_Deallocate (Syn_Inst : Synth_Instance_Acc; Imp : Node) is + use Elab.Vhdl_Objtypes; Inter : constant Node := Get_Interface_Declaration_Chain (Imp); Param : constant Valtyp := Get_Value (Syn_Inst, Inter); - Val : Heap_Index; + Val : Heap_Ptr; begin if not Is_Static (Param.Val) then -- Certainly an error (and certainly already reported). return; end if; Val := Read_Access (Param); - if Val /= Null_Heap_Index then + if Val /= Null_Heap_Ptr then Elab.Vhdl_Heap.Synth_Deallocate (Val); - Write_Access (Param.Val.Mem, Null_Heap_Index); + Write_Access (Param.Val.Mem, Null_Heap_Ptr); end if; end Synth_Deallocate; diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 52f08ce86..78a177359 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -298,13 +298,13 @@ package body Synth.Vhdl_Stmts is | Iir_Kind_Dereference => declare Acc : Memtyp; - Idx : Heap_Index; + Idx : Heap_Ptr; begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); Acc := (Dest_Typ, Dest_Base.Val.Mem + Dest_Off.Mem_Off); Idx := Read_Access (Acc); - if Idx = Null_Heap_Index then + if Idx = Null_Heap_Ptr then Error_Msg_Synth (Syn_Inst, Pfx, "NULL access dereferenced"); Dest_Base := No_Valtyp; Dest_Typ := Dest_Typ.Acc_Acc; -- cgit v1.2.3