synth: improve handling of complex types

4 files changed, 30 insertions, 8 deletions

diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb
index b4e5b954a..3662758d6 100644
--- a/src/synth/elab-vhdl_objtypes.adb
+++ b/src/synth/elab-vhdl_objtypes.adb
@@ -270,8 +270,23 @@ package body Elab.Vhdl_Objtypes is
             Add_Array_Size_Type (Typ.Uarr_El, Sz, Align);
          when Type_Record
            | Type_Unbounded_Record =>
-            --  TODO
-            raise Internal_Error;
+            declare
+               subtype T is Type_Type (Type_Record);
+               subtype T_El is Rec_El_Array (Typ.Rec.Len);
+            begin
+               --  The type
+               Align := Size_Type'Max (Align, T'Alignment);
+               Realign (Sz, Align);
+               Sz := Sz + (T'Size / System.Storage_Unit);
+               --  The el array
+               Align := Size_Type'Max (Align, T_El'Alignment);
+               Realign (Sz, Align);
+               Sz := Sz + (T_El'Size / System.Storage_Unit);
+               --  The elements
+               for I in Typ.Rec.E'Range loop
+                  Add_Size_Type (Typ.Rec.E (I).Typ, Sz, Align);
+               end loop;
+            end;
          when Type_Slice =>
             raise Internal_Error;
       end case;
@@ -1143,11 +1158,14 @@ package body Elab.Vhdl_Objtypes is
          when Type_Record =>
             declare
                subtype Data_Type is Rec_El_Array (Typ.Rec.Len);
+               Rec_Sz : constant Size_Type := Data_Type'Size / Storage_Unit;
             begin
                Realign (Off, Data_Type'Alignment);
-               pragma Assert (Off + Sz <= Mem_Sz);
+               pragma Assert (Off + Rec_Sz <= Mem_Sz);
                Raw_Res := To_Address (Mem + Off);
-               Off := Off + Sz;
+               Off := Off + Rec_Sz;
+               Copy_Memory (To_Memory_Ptr (Raw_Res),
+                            To_Memory_Ptr (Typ.Rec.all'Address), Rec_Sz);
                Res.Rec := To_Rec_El_Array_Acc (Raw_Res);
                for I in Typ.Rec.E'Range loop
                   Res.Rec.E (I).Offs := Typ.Rec.E (I).Offs;
diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb
index 8aeb33d37..411b90519 100644
--- a/src/synth/elab-vhdl_types.adb
+++ b/src/synth/elab-vhdl_types.adb
@@ -572,7 +572,8 @@ package body Elab.Vhdl_Types is
             else
                raise Internal_Error;
             end if;
-         when Type_Vector =>
+         when Type_Vector
+           | Type_Array =>
             --  An alias with just a different resolver ?
             return Parent_Typ;
          when others =>
@@ -585,6 +586,8 @@ package body Elab.Vhdl_Types is
    begin
       --  TODO: handle aliases directly.
       case Get_Kind (Atype) is
+         when Iir_Kinds_Denoting_Name =>
+            return Get_Subtype_Object (Syn_Inst, Get_Type (Atype));
          when Iir_Kind_Array_Subtype_Definition =>
             return Synth_Array_Subtype_Indication (Syn_Inst, Atype);
          when Iir_Kind_Record_Subtype_Definition =>
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index a252390e2..3f3a62760 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -81,12 +81,13 @@ package body Synth.Vhdl_Expr is
       case V.Val.Kind is
          when Value_Memory =>
             return Read_Discrete (V);
-         when Value_Const =>
-            return Read_Discrete (Get_Memtyp (V));
          when Value_Wire =>
             return Read_Discrete
               (Synth.Vhdl_Environment.Env.Get_Static_Wire
                  (Get_Value_Wire (V.Val)));
+         when Value_Const
+           | Value_Alias =>
+            return Read_Discrete (Get_Memtyp (V));
          when others =>
             raise Internal_Error;
       end case;
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index 45de83118..b37cdcc77 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -1959,7 +1959,7 @@ package body Synth.Vhdl_Stmts is
                   Create_Object (Caller_Inst, Assoc, Info_To_Valtyp (Info));
                end if;
                if Info.Kind /= Target_Memory
-                 and then Is_Static (Info.Obj.Val)
+                 and then Info.Obj.Val.Kind = Value_Memory
                then
                   --  FIXME: the subtype conversion will copy the value, so
                   --   allocate here in current_pool ?