diff options
| -rw-r--r-- | src/synth/elab-vhdl_values.adb | 37 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_values.ads | 2 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_stmts.adb | 25 |
3 files changed, 38 insertions, 26 deletions
diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb index 58f407da5..25ce08b77 100644 --- a/src/synth/elab-vhdl_values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -136,36 +136,33 @@ package body Elab.Vhdl_Values is Init => Init))); end Create_Value_Signal; - function Create_Value_Memory (Vtype : Type_Acc; Pool : Areapool_Acc) - return Valtyp + function Create_Value_Memory_Pool (Mt : Memtyp; Pool : Areapool_Acc) + return Valtyp is subtype Value_Type_Memory is Value_Type (Value_Memory); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Memory); - function To_Memory_Ptr is new Ada.Unchecked_Conversion - (System.Address, Memory_Ptr); V : Value_Acc; - M : System.Address; begin - Areapools.Allocate (Pool.all, M, - Vtype.Sz, Size_Type (2 ** Natural (Vtype.Al))); - V := To_Value_Acc - (Alloc (Pool, Value_Type_Memory'(Kind => Value_Memory, - Mem => To_Memory_Ptr (M)))); + V := To_Value_Acc (Alloc (Pool, Value_Type_Memory'(Kind => Value_Memory, + Mem => Mt.Mem))); + return (Mt.Typ, V); + end Create_Value_Memory_Pool; - return (Vtype, V); + function Create_Value_Memory (Mt : Memtyp) return Valtyp is + begin + return Create_Value_Memory_Pool (Mt, Current_Pool); end Create_Value_Memory; - function Create_Value_Memory (Mt : Memtyp) return Valtyp + function Create_Value_Memory (Vtype : Type_Acc; Pool : Areapool_Acc) + return Valtyp is - subtype Value_Type_Memory is Value_Type (Value_Memory); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Memory); - V : Value_Acc; + function To_Memory_Ptr is new Ada.Unchecked_Conversion + (System.Address, Memory_Ptr); + M : System.Address; begin - V := To_Value_Acc - (Alloc (Current_Pool, Value_Type_Memory'(Kind => Value_Memory, - Mem => Mt.Mem))); - - return (Mt.Typ, V); + Areapools.Allocate (Pool.all, M, + Vtype.Sz, Size_Type (2 ** Natural (Vtype.Al))); + return Create_Value_Memory_Pool ((Vtype, To_Memory_Ptr (M)), Pool); end Create_Value_Memory; function Create_Value_File (File : File_Index) return Value_Acc diff --git a/src/synth/elab-vhdl_values.ads b/src/synth/elab-vhdl_values.ads index 28323ba1b..5c56cb548 100644 --- a/src/synth/elab-vhdl_values.ads +++ b/src/synth/elab-vhdl_values.ads @@ -147,6 +147,8 @@ package Elab.Vhdl_Values is function Create_Value_Memory (Vtype : Type_Acc; Pool : Areapool_Acc) return Valtyp; + function Create_Value_Memory_Pool (Mt : Memtyp; Pool : Areapool_Acc) + return Valtyp; function Create_Value_Memory (Mt : Memtyp) return Valtyp; function Create_Value_Uns (Val : Uns64; Vtype : Type_Acc) return Valtyp; diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 23da44f73..f2bf8db0d 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -1834,12 +1834,25 @@ package body Synth.Vhdl_Stmts is begin case Info.Kind is when Target_Simple => - if Info.Off = No_Value_Offsets then - return Info.Obj; - else - return Create_Value_Alias - (Info.Obj, Info.Off, Info.Targ_Type, Instance_Pool); - end if; + declare + Obj : Valtyp; + begin + -- Unshare the value. + if Info.Obj.Val.Kind = Value_Memory then + -- But for memory value, do not copy the content, as it is + -- a reference. + Obj := Create_Value_Memory_Pool + (Get_Memtyp (Info.Obj), Instance_Pool); + else + Obj := Unshare (Info.Obj, Instance_Pool); + end if; + if Info.Off = No_Value_Offsets then + return Obj; + else + return Create_Value_Alias + (Obj, Info.Off, Info.Targ_Type, Instance_Pool); + end if; + end; when Target_Aggregate => raise Internal_Error; when Target_Memory => |