translate: WIP for unbounded records.

5 files changed, 110 insertions, 29 deletions

diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index b14a86acd..89cf2a9be 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -1013,6 +1013,32 @@ package body Trans.Chap3 is
       return Res;
    end Get_Innermost_Non_Array_Element;
 
+   --  Declare the bounds types for DEF.
+   procedure Translate_Record_Type_Bounds
+     (Def : Iir_Record_Type_Definition; Info : Type_Info_Acc)
+   is
+      List : constant Iir_List := Get_Elements_Declaration_List (Def);
+      El : Iir;
+      El_Tinfo : Type_Info_Acc;
+      El_Info : Field_Info_Acc;
+      Constr : O_Element_List;
+   begin
+      Start_Record_Type (Constr);
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         El_Tinfo := Get_Info (Get_Type (El));
+         if Is_Unbounded_Type (El_Tinfo) then
+            El_Info := Get_Info (El);
+            New_Record_Field (Constr, El_Info.Field_Bound,
+                              Create_Identifier_Without_Prefix (El),
+                              El_Tinfo.B.Bounds_Type);
+         end if;
+      end loop;
+      Finish_Record_Type (Constr, Info.B.Bounds_Type);
+      Finish_Unbounded_Type_Bounds (Info);
+   end Translate_Record_Type_Bounds;
+
    procedure Translate_Record_Type (Def : Iir_Record_Type_Definition)
    is
       Info       : constant Type_Info_Acc := Get_Info (Def);
@@ -1072,14 +1098,20 @@ package body Trans.Chap3 is
                               Create_Identifier_Without_Prefix (El),
                               El_Tnode);
          end loop;
-         Finish_Record_Type (El_List, Info.Ortho_Type (Kind));
+         Finish_Record_Type (El_List, Info.B.Base_Type (Kind));
       end loop;
       if Is_Unbounded then
          Info.Type_Mode := Type_Mode_Unbounded_Record;
+         Finish_Unbounded_Type_Base (Info);
+         Translate_Record_Type_Bounds (Def, Info);
+         Create_Unbounded_Type_Fat_Pointer (Info);
+         Finish_Type_Definition (Info);
       else
          Info.Type_Mode := Type_Mode_Record;
+         Info.Ortho_Type := Info.B.Base_Type;
+         Finish_Type_Definition (Info);
+         Info.B.Base_Ptr_Type := Info.Ortho_Ptr_Type;
       end if;
-      Finish_Type_Definition (Info);
 
       if Need_Size then
          Create_Size_Var (Def);
@@ -2039,8 +2071,8 @@ package body Trans.Chap3 is
             Translate_Array_Subtype_Element_Subtype (Def);
 
          when Iir_Kind_Record_Type_Definition =>
-            Translate_Record_Type (Def);
             Info.B := Ortho_Info_Basetype_Record_Init;
+            Translate_Record_Type (Def);
 
          when Iir_Kind_Record_Subtype_Definition
             | Iir_Kind_Access_Subtype_Definition =>
@@ -2059,8 +2091,8 @@ package body Trans.Chap3 is
             end;
 
          when Iir_Kind_File_Type_Definition =>
-            Translate_File_Type (Def);
             Info.B := Ortho_Info_Basetype_File_Init;
+            Translate_File_Type (Def);
             if With_Vars then
                Create_File_Type_Var (Def);
             end if;
@@ -2360,7 +2392,8 @@ package body Trans.Chap3 is
       Info : constant Type_Info_Acc := Get_Type_Info (Arr);
    begin
       case Info.Type_Mode is
-         when Type_Mode_Fat_Array =>
+         when Type_Mode_Unbounded_Array
+           | Type_Mode_Unbounded_Record =>
             declare
                Kind : constant Object_Kind_Type := Get_Object_Kind (Arr);
             begin
diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb
index caa3c025d..6d0ec5eea 100644
--- a/src/vhdl/translate/trans-chap6.adb
+++ b/src/vhdl/translate/trans-chap6.adb
@@ -821,28 +821,64 @@ package body Trans.Chap6 is
       El_Type       : constant Iir := Get_Type (Base_El);
       El_Tinfo      : constant Type_Info_Acc := Get_Info (El_Type);
       Kind          : constant Object_Kind_Type := Get_Object_Kind (Prefix);
-      Stable_Prefix : Mnode;
+      Stable_Prefix, Base, Res, Fat_Res : Mnode;
    begin
-      if Is_Complex_Type (El_Tinfo) then
-         --  The element is in fact an offset.
+      --  There are 3 cases:
+      --  a) the record is bounded (and so is the element).
+      --  b) the record is unbounded and the element is bounded
+      --  c) the record is unbounded and the element is unbounded.
+      --  If the record is unbounded, PREFIX is a fat pointer.
+      --  On top of that, the element may be complex.
+
+      if Is_Unbounded_Type (El_Tinfo) then
          Stable_Prefix := Stabilize (Prefix);
-         return E2M
+
+         --  Result is a fat pointer, create it and set bounds.
+         Fat_Res := Create_Temp (El_Tinfo, Kind);
+         New_Assign_Stmt
+           (New_Selected_Element (M2Lv (Fat_Res),
+                                  El_Tinfo.B.Bounds_Field (Kind)),
+            New_Address
+              (New_Selected_Element
+                 (M2Lv (Chap3.Get_Array_Bounds (Stable_Prefix)),
+                  El_Info.Field_Bound),
+               El_Tinfo.B.Bounds_Ptr_Type));
+      else
+         Stable_Prefix := Prefix;
+      end if;
+
+      Base := Chap3.Get_Composite_Base (Stable_Prefix);
+
+      if Is_Complex_Type (El_Tinfo) or Is_Unbounded_Type (El_Tinfo) then
+         --  The element is complex: it's an offset.
+         Stabilize (Base);
+         Res := E2M
            (New_Unchecked_Address
               (New_Slice
                    (New_Access_Element
-                        (New_Unchecked_Address
-                           (M2Lv (Stable_Prefix), Char_Ptr_Type)),
+                        (New_Unchecked_Address (M2Lv (Base), Char_Ptr_Type)),
                     Chararray_Type,
                     New_Value
-                      (New_Selected_Element (M2Lv (Stable_Prefix),
+                      (New_Selected_Element (M2Lv (Base),
                        El_Info.Field_Node (Kind)))),
-               El_Tinfo.Ortho_Ptr_Type (Kind)),
+               El_Tinfo.B.Base_Ptr_Type (Kind)),
             El_Tinfo, Kind);
       else
-         return Lv2M (New_Selected_Element (M2Lv (Prefix),
+         --  Normal element.
+         Res := Lv2M (New_Selected_Element (M2Lv (Base),
                       El_Info.Field_Node (Kind)),
                       El_Tinfo, Kind);
       end if;
+
+      if Is_Unbounded_Type (El_Tinfo) then
+         New_Assign_Stmt
+           (New_Selected_Element (M2Lv (Fat_Res),
+                                  El_Tinfo.B.Base_Field (Kind)),
+            M2Addr (Res));
+         return Fat_Res;
+      else
+         return Res;
+      end if;
    end Translate_Selected_Element;
 
    --       function Translate_Formal_Interface_Name (Scope_Type : O_Tnode;
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index cba7018aa..d9e14eadd 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -4506,23 +4506,25 @@ package body Trans.Chap7 is
             return New_Compare_Op (ON_Eq, M2E (L), M2E (R),
                                    Ghdl_Bool_Type);
 
-         when Type_Mode_Array =>
+         when Type_Mode_Array
+           | Type_Mode_Unbounded_Array =>
             declare
+               Base_Type : constant Iir_Array_Type_Definition
+                 := Get_Base_Type (Etype);
                Lc, Rc    : O_Enode;
-               Base_Type : Iir_Array_Type_Definition;
                Func      : Iir;
             begin
-               Base_Type := Get_Base_Type (Etype);
+               Func := Find_Predefined_Function
+                 (Base_Type, Iir_Predefined_Array_Equality);
                Lc := Translate_Implicit_Conv
                  (M2E (L), Etype, Base_Type, Mode_Value, Null_Iir);
                Rc := Translate_Implicit_Conv
                  (M2E (R), Etype, Base_Type, Mode_Value, Null_Iir);
-               Func := Find_Predefined_Function
-                 (Base_Type, Iir_Predefined_Array_Equality);
                return Translate_Predefined_Lib_Operator (Lc, Rc, Func);
             end;
 
-         when Type_Mode_Record =>
+         when Type_Mode_Record
+           | Type_Mode_Unbounded_Record =>
             declare
                Func : Iir;
             begin
@@ -4534,8 +4536,6 @@ package body Trans.Chap7 is
 
          when Type_Mode_Unknown
            | Type_Mode_File
-           | Type_Mode_Unbounded_Array
-           | Type_Mode_Unbounded_Record
            | Type_Mode_Protected =>
             raise Internal_Error;
       end case;
@@ -4680,10 +4680,10 @@ package body Trans.Chap7 is
       for I in Natural loop
          El := Get_Nth_Element (El_List, I);
          exit when El = Null_Iir;
+         Open_Temp;
          Le := Chap6.Translate_Selected_Element (L, El);
          Re := Chap6.Translate_Selected_Element (R, El);
 
-         Open_Temp;
          Start_If_Stmt
            (If_Blk,
             New_Monadic_Op (ON_Not,
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index d28f3bb6e..a155041da 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -1652,7 +1652,7 @@ package body Trans.Rtis is
             New_Record_Aggr_El (Aggr, New_Rti_Address (Type_Rti));
             for I in Object_Kind_Type loop
                if Field_Info.Field_Node (I) /= O_Fnode_Null then
-                  Val := New_Offsetof (Info.Ortho_Type (I),
+                  Val := New_Offsetof (Info.B.Base_Type (I),
                                        Field_Info.Field_Node (I),
                                        Ghdl_Index_Type);
                else
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 8d2f87267..228496b26 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -722,18 +722,21 @@ package Trans is
             Range_Dir    : O_Fnode;
             Range_Length : O_Fnode;
 
-         when Kind_Type_Array =>
+         when Kind_Type_Array
+           | Kind_Type_Record =>
+            --  For unbounded types:
+            --  The base type.
             Base_Type       : O_Tnode_Array;
             Base_Ptr_Type   : O_Tnode_Array;
+            --  The dope vector.
             Bounds_Type     : O_Tnode;
             Bounds_Ptr_Type : O_Tnode;
 
+            --  The ortho type is a fat pointer to the base and the bounds.
+            --  These are the fields of the fat pointer.
             Base_Field   : O_Fnode_Array;
             Bounds_Field : O_Fnode_Array;
 
-         when Kind_Type_Record =>
-            null;
-
          when Kind_Type_File =>
             --  Constant containing the signature of the file.
             File_Signature : O_Dnode;
@@ -811,7 +814,13 @@ package Trans is
 
    Ortho_Info_Basetype_Record_Init : constant Ortho_Info_Basetype_Type :=
      (Kind => Kind_Type_Record,
-      Rti_Max_Depth => 0);
+      Rti_Max_Depth => 0,
+      Base_Type => (O_Tnode_Null, O_Tnode_Null),
+      Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null),
+      Bounds_Type => O_Tnode_Null,
+      Bounds_Ptr_Type => O_Tnode_Null,
+      Base_Field => (O_Fnode_Null, O_Fnode_Null),
+      Bounds_Field => (O_Fnode_Null, O_Fnode_Null));
 
    Ortho_Info_Basetype_File_Init : constant Ortho_Info_Basetype_Type :=
      (Kind => Kind_Type_File,
@@ -1182,6 +1191,9 @@ package Trans is
             --  Node for a record element declaration.
             Field_Node : O_Fnode_Array := (O_Fnode_Null, O_Fnode_Null);
 
+            --  The field in the dope vector (for unbounded element).
+            Field_Bound : O_Fnode := O_Fnode_Null;
+
          when Kind_Expr =>
             --  Ortho tree which represents the expression, used for
             --  enumeration literals.