synth-vhdl_stmts: fix handling of copyback parameters

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 =>