WIP: translate size of unbounded records.

5 files changed, 80 insertions, 13 deletions

diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 5492d26f2..fda63c81d 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -1107,9 +1107,9 @@ package body Iirs_Utils is
                for I in Natural loop
                   Bel := Get_Nth_Element (El_Blist, I);
                   exit when Bel = Null_Iir;
-                  if not Is_Fully_Constrained_Type (Bel) then
+                  if not Is_Fully_Constrained_Type (Get_Type (Bel)) then
                      El := Get_Nth_Element (El_List, I);
-                     if not Are_Bounds_Locally_Static (El) then
+                     if not Are_Bounds_Locally_Static (Get_Type (El)) then
                         return False;
                      end if;
                   end if;
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 0802e6128..adf305b7d 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -157,9 +157,8 @@ package body Sem_Decls is
    --  protected type or if a subelement of DECL is an access type.
    procedure Check_Signal_Type (Decl : Iir)
    is
-      Decl_Type : Iir;
+      Decl_Type : constant Iir := Get_Type (Decl);
    begin
-      Decl_Type := Get_Type (Decl);
       if Get_Signal_Type_Flag (Decl_Type) = False then
          Error_Msg_Sem (+Decl, "type of %n cannot be %n", (+Decl, +Decl_Type));
          case Get_Kind (Decl_Type) is
@@ -1850,6 +1849,8 @@ package body Sem_Decls is
       case Get_Kind (Atype) is
          when Iir_Kind_File_Type_Definition =>
             Error_Msg_Sem (+Decl, "%n cannot be of type file", +Decl);
+         when Iir_Kind_Error =>
+            null;
          when others =>
             if Get_Kind (Decl) /= Iir_Kind_Variable_Declaration then
                Check_Signal_Type (Decl);
diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb
index 09806ad05..b0da9362d 100644
--- a/src/vhdl/sem_types.adb
+++ b/src/vhdl/sem_types.adb
@@ -1881,6 +1881,7 @@ package body Sem_Types is
 
       Tm_El_List := Get_Elements_Declaration_List (Type_Mark);
       if El_List /= Null_Iir_List or Res_List /= Null_Iir_List then
+         --  Constraints (either range or resolution) have been added.
          declare
             Nbr_Els : constant Natural := Get_Nbr_Elements (Tm_El_List);
             Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir);
@@ -1888,16 +1889,20 @@ package body Sem_Types is
             Pos : Natural;
             Constraint : Iir_Constraint;
          begin
-            --  Fill ELS.
+            --  Fill ELS with record constraints.
             if El_List /= Null_Iir_List then
                for I in Natural loop
                   El := Get_Nth_Element (El_List, I);
                   exit when El = Null_Iir;
                   Tm_El := Find_Name_In_List (Tm_El_List, Get_Identifier (El));
                   if Tm_El = Null_Iir then
+                     --  Constraint element references an element name that
+                     --  doesn't exist.
                      Error_Msg_Sem (+El, "%n has no %n", (+Type_Mark, +El));
                   else
                      Set_Element_Declaration (El, Tm_El);
+                     Set_Base_Element_Declaration
+                       (El, Get_Base_Element_Declaration (Tm_El));
                      Pos := Natural (Get_Element_Position (Tm_El));
                      if Els (Pos) /= Null_Iir then
                         Error_Msg_Sem
@@ -1912,6 +1917,7 @@ package body Sem_Types is
                      El_Type := Get_Type (El);
                      Tm_El_Type := Get_Type (Tm_El);
                      if Get_Kind (El_Type) = Iir_Kind_Parenthesis_Name then
+                        --  Recurse.
                         case Get_Kind (Tm_El_Type) is
                            when Iir_Kinds_Array_Type_Definition =>
                               El_Type := Reparse_As_Array_Constraint
@@ -1929,10 +1935,11 @@ package body Sem_Types is
                      Set_Type (El, El_Type);
                   end if;
                end loop;
+               --  Record element constraints are now in Els.
                Destroy_Iir_List (El_List);
             end if;
 
-            --  Fill Res_Els.
+            --  Fill Res_Els (handle resolution constraints).
             if Res_List /= Null_Iir_List then
                for I in Natural loop
                   El := Get_Nth_Element (Res_List, I);
@@ -1963,13 +1970,18 @@ package body Sem_Types is
             for I in Els'Range loop
                Tm_El := Get_Nth_Element (Tm_El_List, I);
                if Els (I) = Null_Iir and Res_Els (I) = Null_Iir then
+                  --  No new record element constraints.  Copy the element from
+                  --  the type mark.
                   El := Tm_El;
                   El_Type := Get_Type (El);
                else
                   if Els (I) = Null_Iir then
+                     --  Only a resolution constraint.
                      El := Create_Iir (Iir_Kind_Record_Element_Constraint);
                      Location_Copy (El, Tm_El);
                      Set_Element_Declaration (El, Tm_El);
+                     Set_Base_Element_Declaration
+                       (El, Get_Base_Element_Declaration (Tm_El));
                      Set_Element_Position (El, Get_Element_Position (Tm_El));
                      El_Type := Null_Iir;
                   else
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 20601f8f8..1306dfc10 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -1205,6 +1205,10 @@ package body Trans.Chap3 is
          end if;
       end loop;
 
+      --  By default, use the same representation as the type mark.
+      Info.all := Get_Info (Type_Mark).all;
+      Info.S := Ortho_Info_Subtype_Record_Init;
+
       if Get_Constraint_State (Def) /= Fully_Constrained
         or else not Has_New_Constraints
       then
@@ -1212,8 +1216,6 @@ package body Trans.Chap3 is
          --    create objects, so wait until it is compltely constrained.
          --  The subtype is simply an alias.
          --  In both cases, use the same representation as its type mark.
-         Info.all := Get_Info (Type_Mark).all;
-         Info.S := Ortho_Info_Subtype_Record_Init;
          return;
       end if;
 
@@ -2443,6 +2445,19 @@ package body Trans.Chap3 is
                    Iinfo.B.Range_Type, Iinfo.B.Range_Ptr_Type);
    end Bounds_To_Range;
 
+   function Bounds_To_Element_Bounds (B : Mnode; El : Iir) return Mnode
+   is
+      El_Type : constant Iir := Get_Type (El);
+      El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type);
+      Base_El : constant Iir := Get_Base_Element_Declaration (El);
+   begin
+      return Lv2M
+        (New_Selected_Element (M2Lv (B),
+                               Get_Info (Base_El).Field_Bound),
+         El_Tinfo, Mode_Value,
+         El_Tinfo.B.Range_Type, El_Tinfo.B.Range_Ptr_Type);
+   end Bounds_To_Element_Bounds;
+
    function Type_To_Range (Atype : Iir) return Mnode
    is
       Info : constant Type_Info_Acc := Get_Info (Atype);
@@ -2796,8 +2811,8 @@ package body Trans.Chap3 is
             | Type_Mode_Array
             | Type_Mode_Record =>
             return New_Lit (New_Sizeof (Type_Info.Ortho_Type (Kind),
-                            Ghdl_Index_Type));
-         when Type_Mode_Fat_Array =>
+                                        Ghdl_Index_Type));
+         when Type_Mode_Unbounded_Array =>
             declare
                El_Type  : constant Iir := Get_Element_Subtype (Atype);
                El_Sz    : O_Enode;
@@ -2807,6 +2822,41 @@ package body Trans.Chap3 is
                return New_Dyadic_Op
                  (ON_Mul_Ov, Chap3.Get_Bounds_Length (Bounds, Atype), El_Sz);
             end;
+         when Type_Mode_Unbounded_Record =>
+            declare
+               El_List : constant Iir_List :=
+                 Get_Elements_Declaration_List (Atype);
+               El : Iir;
+               El_Type : Iir;
+               El_Type_Info : Type_Info_Acc;
+               El_Bounds : Mnode;
+               Res : O_Enode;
+            begin
+               --  Size of base type
+               Res := New_Lit (New_Sizeof (Type_Info.B.Base_Type (Kind),
+                                           Ghdl_Index_Type));
+               for I in Natural loop
+                  El := Get_Nth_Element (El_List, I);
+                  exit when El = Null_Iir;
+                  El_Type := Get_Type (El);
+                  El_Type_Info := Get_Info (El_Type);
+                  if El_Type_Info.Type_Mode in Type_Mode_Unbounded then
+                     --  Recurse
+                     Res := Realign (Res, El_Type);
+                     El_Bounds := Bounds_To_Element_Bounds (Bounds, El);
+                     Res := New_Dyadic_Op
+                       (ON_Add_Ov,
+                        Res, Get_Subtype_Size (El_Type, El_Bounds, Kind));
+                  elsif Is_Complex_Type (El_Type_Info) then
+                     --  Add supplement
+                     Res := Realign (Res, El_Type);
+                     Res := New_Dyadic_Op
+                       (ON_Add_Ov,
+                        Res, Get_Subtype_Size (El_Type, Mnode_Null, Kind));
+                  end if;
+               end loop;
+               return Res;
+            end;
          when others =>
             raise Internal_Error;
       end case;
@@ -2818,7 +2868,7 @@ package body Trans.Chap3 is
       Type_Info : constant Type_Info_Acc := Get_Type_Info (Obj);
       Kind      : constant Object_Kind_Type := Get_Object_Kind (Obj);
    begin
-      if Type_Info.Type_Mode = Type_Mode_Fat_Array then
+      if Type_Info.Type_Mode in Type_Mode_Unbounded then
          return Get_Subtype_Size (Obj_Type, Get_Array_Bounds (Obj), Kind);
       else
          return Get_Subtype_Size (Obj_Type, Mnode_Null, Kind);
@@ -2848,7 +2898,7 @@ package body Trans.Chap3 is
       Dinfo : constant Type_Info_Acc := Get_Info (Obj_Type);
       Kind  : constant Object_Kind_Type := Get_Object_Kind (Res);
    begin
-      if Dinfo.Type_Mode = Type_Mode_Fat_Array then
+      if Dinfo.Type_Mode in Type_Mode_Unbounded then
          --  Allocate memory for bounds.
          New_Assign_Stmt
            (M2Lp (Chap3.Get_Array_Bounds (Res)),
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index 53bff13d2..ec0921b01 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -157,7 +157,7 @@ package Trans.Chap3 is
    function Range_To_Left (R : Mnode) return Mnode;
    function Range_To_Right (R : Mnode) return Mnode;
 
-   --  Get range for dimension DIM (1 based) of array bounds B or type
+   --  Get range for dimension DIM (1 based) of array bounds B of type
    --  ATYPE.
    function Bounds_To_Range (B : Mnode; Atype : Iir; Dim : Positive)
                                 return Mnode;
@@ -173,6 +173,10 @@ package Trans.Chap3 is
    function Get_Bounds_Acc_Base
      (Acc : O_Enode; D_Type : Iir) return O_Enode;
 
+   --  From an unbounded record bounds B, get the bounds for (unbounded)
+   --  element EL.
+   function Bounds_To_Element_Bounds (B : Mnode; El : Iir) return Mnode;
+
    --  Deallocate OBJ.
    procedure Gen_Deallocate (Obj : O_Enode);