Gen_Call_Type_Builder: use Mnode.

4 files changed, 53 insertions, 119 deletions

diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 9fd88f735..4ea331299 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -136,11 +136,9 @@ package body Trans.Chap3 is
       Finish_Subprogram_Decl (Interface_List, Info.C (Kind).Builder_Func);
    end Create_Builder_Subprogram_Decl;
 
-   function Gen_Call_Type_Builder (Var_Ptr  : O_Dnode;
-                                   Var_Type : Iir;
-                                   Kind     : Object_Kind_Type)
-                                   return O_Enode
+   function Gen_Call_Type_Builder (Var : Mnode; Var_Type : Iir) return O_Enode
    is
+      Kind  : constant Object_Kind_Type := Get_Object_Kind (Var);
       Tinfo : constant Type_Info_Acc := Get_Info (Var_Type);
       Binfo : constant Type_Info_Acc := Get_Info (Get_Base_Type (Var_Type));
       Assoc : O_Assoc_List;
@@ -153,30 +151,17 @@ package body Trans.Chap3 is
       case Tinfo.Type_Mode is
          when Type_Mode_Record
             | Type_Mode_Array =>
-            New_Association (Assoc, New_Obj_Value (Var_Ptr));
+            New_Association (Assoc, M2Addr (Var));
          when Type_Mode_Fat_Array =>
             --  Note: a fat array can only be at the top of a complex type;
             --  the bounds must have been set.
-            New_Association
-              (Assoc, New_Value_Selected_Acc_Value
-                 (New_Obj (Var_Ptr), Tinfo.T.Base_Field (Kind)));
+            New_Association (Assoc, M2Addr (Chap3.Get_Array_Base (Var)));
          when others =>
             raise Internal_Error;
       end case;
 
       if Tinfo.Type_Mode in Type_Mode_Arrays then
-         declare
-            Arr : Mnode;
-         begin
-            case Type_Mode_Arrays (Tinfo.Type_Mode) is
-               when Type_Mode_Array =>
-                  Arr := T2M (Var_Type, Kind);
-               when Type_Mode_Fat_Array =>
-                  Arr := Dp2M (Var_Ptr, Tinfo, Kind);
-            end case;
-            New_Association
-              (Assoc, M2Addr (Chap3.Get_Array_Bounds (Arr)));
-         end;
+         New_Association (Assoc, M2Addr (Chap3.Get_Array_Bounds (Var)));
       end if;
 
       return New_Function_Call (Assoc);
@@ -190,9 +175,7 @@ package body Trans.Chap3 is
       Open_Temp;
       V := Stabilize (Var);
       Mem := Create_Temp (Ghdl_Index_Type);
-      New_Assign_Stmt
-        (New_Obj (Mem),
-         Gen_Call_Type_Builder (M2Dp (V), Var_Type, Get_Object_Kind (Var)));
+      New_Assign_Stmt (New_Obj (Mem), Gen_Call_Type_Builder (V, Var_Type));
       Close_Temp;
    end Gen_Call_Type_Builder;
 
@@ -858,9 +841,8 @@ package body Trans.Chap3 is
       Index            : Iir;
       Targ             : Mnode;
    begin
-      Targ := Lv2M (Target, null, Mode_Value, True,
-                    Baseinfo.T.Bounds_Type,
-                    Baseinfo.T.Bounds_Ptr_Type);
+      Targ := Lv2M (Target, null, Mode_Value,
+                    Baseinfo.T.Bounds_Type, Baseinfo.T.Bounds_Ptr_Type);
       Open_Temp;
       if Get_Nbr_Elements (Indexes_List) > 1 then
          Targ := Stabilize (Targ);
@@ -907,8 +889,7 @@ package body Trans.Chap3 is
    end Get_Array_Bounds_Staticness;
 
    --  Create a variable containing the bounds for array subtype DEF.
-   procedure Create_Array_Subtype_Bounds_Var
-     (Def : Iir; Elab_Now : Boolean)
+   procedure Create_Array_Subtype_Bounds_Var (Def : Iir; Elab_Now : Boolean)
    is
       Info      : constant Type_Info_Acc := Get_Info (Def);
       Base_Info : Type_Info_Acc;
@@ -992,27 +973,26 @@ package body Trans.Chap3 is
       --  Set each index of the array.
       Init_Var (Var_Off);
       Start_Loop_Stmt (Label);
-      Gen_Exit_When (Label,
-                     New_Compare_Op (ON_Eq,
-                       New_Obj_Value (Var_Off),
-                       New_Obj_Value (Var_Length),
-                       Ghdl_Bool_Type));
+      Gen_Exit_When (Label, New_Compare_Op (ON_Eq,
+                                            New_Obj_Value (Var_Off),
+                                            New_Obj_Value (Var_Length),
+                                            Ghdl_Bool_Type));
 
       New_Assign_Stmt
         (New_Obj (Var_Mem),
          New_Unchecked_Address
            (New_Slice (New_Access_Element
-            (New_Convert_Ov (New_Obj_Value (Base),
-                 Char_Ptr_Type)),
-            Chararray_Type,
-            New_Obj_Value (Var_Off)),
+                         (New_Convert_Ov (New_Obj_Value (Base),
+                                          Char_Ptr_Type)),
+                       Chararray_Type,
+                       New_Obj_Value (Var_Off)),
             Info.T.Base_Ptr_Type (Kind)));
 
       New_Assign_Stmt
         (New_Obj (Var_Off),
          New_Dyadic_Op (ON_Add_Ov,
            New_Obj_Value (Var_Off),
-           Gen_Call_Type_Builder (Var_Mem, El_Type, Kind)));
+           Gen_Call_Type_Builder (Dp2M (Var_Mem, El_Info, Kind), El_Type)));
       Finish_Loop_Stmt (Label);
 
       New_Return_Stmt (New_Obj_Value (Var_Off));
@@ -1175,8 +1155,7 @@ package body Trans.Chap3 is
       --  OFF = SIZEOF (record).
       New_Assign_Stmt
         (New_Obj (Off_Var),
-         New_Lit (New_Sizeof (Info.Ortho_Type (Kind),
-           Ghdl_Index_Type)));
+         New_Lit (New_Sizeof (Info.Ortho_Type (Kind), Ghdl_Index_Type)));
 
       --  Set memory for each complex element.
       List := Get_Elements_Declaration_List (Def);
@@ -1219,9 +1198,9 @@ package body Trans.Chap3 is
                New_Assign_Stmt
                  (New_Obj (Off_Var),
                   New_Dyadic_Op (ON_Add_Ov,
-                    New_Obj_Value (Off_Var),
-                    Gen_Call_Type_Builder
-                      (Ptr_Var, El_Type, Kind)));
+                                 New_Obj_Value (Off_Var),
+                                 Gen_Call_Type_Builder
+                                   (Dp2M (Ptr_Var, El_Tinfo, Kind), El_Type)));
 
                Finish_Declare_Stmt;
             else
@@ -1243,6 +1222,7 @@ package body Trans.Chap3 is
    --------------
    --  Access  --
    --------------
+
    procedure Translate_Access_Type (Def : Iir_Access_Type_Definition)
    is
       D_Type   : constant Iir := Get_Designated_Type (Def);
@@ -2362,11 +2342,9 @@ package body Trans.Chap3 is
         Get_Info (Get_Base_Type (Index_Type));
    begin
       return Lv2M (New_Selected_Element (M2Lv (B),
-                   Base_Index_Info.Index_Field),
-                   Iinfo,
-                   Get_Object_Kind (B),
-                   Iinfo.T.Range_Type,
-                   Iinfo.T.Range_Ptr_Type);
+                                         Base_Index_Info.Index_Field),
+                   Iinfo, Mode_Value,
+                   Iinfo.T.Range_Type, Iinfo.T.Range_Ptr_Type);
    end Bounds_To_Range;
 
    function Type_To_Range (Atype : Iir) return Mnode
@@ -2607,7 +2585,7 @@ package body Trans.Chap3 is
          return Lv2M (New_Slice (M2Lv (Base),
                                  T_Info.T.Base_Type (Kind),
                                  Index),
-                      T_Info, Kind, False,
+                      T_Info, Kind,
                       T_Info.T.Base_Type (Kind),
                       T_Info.T.Base_Ptr_Type (Kind));
       end if;
@@ -2766,11 +2744,10 @@ package body Trans.Chap3 is
       else
          New_Assign_Stmt
            (M2Lp (Res),
-            Gen_Alloc
-              (Alloc_Kind,
-               Chap3.Get_Object_Size (T2M (Obj_Type, Kind),
-                 Obj_Type),
-               Dinfo.Ortho_Ptr_Type (Kind)));
+            Gen_Alloc (Alloc_Kind,
+                       Chap3.Get_Object_Size (T2M (Obj_Type, Kind),
+                                              Obj_Type),
+                       Dinfo.Ortho_Ptr_Type (Kind)));
 
          if Is_Complex_Type (Dinfo)
            and then Dinfo.C (Kind).Builder_Need_Func
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index b3dfced0b..6c0ec502e 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -4294,8 +4294,7 @@ package body Trans.Chap7 is
    begin
       Open_Temp;
       Arange1 := Stabilize (Lv2M (Arange, Rinfo, Mode_Value,
-                                  Rinfo.T.Range_Type,
-                                  Rinfo.T.Range_Ptr_Type));
+                                  Rinfo.T.Range_Type, Rinfo.T.Range_Ptr_Type));
       Res1 := Stabilize (Res);
       New_Assign_Stmt (M2Lv (Chap3.Range_To_Left (Res1)),
                        M2E (Chap3.Range_To_Right (Arange1)));
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index 82e34ae87..a2f0a89a8 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -1083,25 +1083,22 @@ package body Trans is
    begin
       case M.M1.State is
          when Mstate_E =>
-            if M.M1.Is_Composite then
+            if Is_Composite (M.M1.T) then
                --  Create a pointer variable.
                D := Create_Temp_Init (M.M1.Ptype, M.M1.E);
                return Mnode'(M1 => (State => Mstate_Dp,
-                                    Is_Composite => True,
                                     K => K, T => M.M1.T, Dp => D,
                                     Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
             else
                --  Create a scalar variable.
                D := Create_Temp_Init (M.M1.Vtype, M.M1.E);
                return Mnode'(M1 => (State => Mstate_Dv,
-                                    Is_Composite => False,
                                     K => K, T => M.M1.T, Dv => D,
                                     Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
             end if;
          when Mstate_Lp =>
             D := Create_Temp_Init (M.M1.Ptype, New_Value (M.M1.Lp));
             return Mnode'(M1 => (State => Mstate_Dp,
-                                 Is_Composite => M.M1.Is_Composite,
                                  K => K, T => M.M1.T, Dp => D,
                                  Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
          when Mstate_Lv =>
@@ -1111,14 +1108,12 @@ package body Trans is
                end if;
                D := Create_Temp_Init (M.M1.Vtype, New_Value (M.M1.Lv));
                return Mnode'(M1 => (State => Mstate_Dv,
-                                    Is_Composite => M.M1.Is_Composite,
                                     K => K, T => M.M1.T, Dv => D,
                                     Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
 
             else
                D := Create_Temp_Ptr (M.M1.Ptype, M.M1.Lv);
                return Mnode'(M1 => (State => Mstate_Dp,
-                                    Is_Composite => M.M1.Is_Composite,
                                     K => K, T => M.M1.T, Dp => D,
                                     Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
             end if;
@@ -1142,9 +1137,7 @@ package body Trans is
       E : O_Enode;
    begin
       --  M must be scalar or access.
-      if M.M1.Is_Composite then
-         raise Internal_Error;
-      end if;
+      pragma Assert (not Is_Composite (M.M1.T));
       case M.M1.State is
          when Mstate_E =>
             E := M.M1.E;
@@ -1162,7 +1155,6 @@ package body Trans is
 
       D := Create_Temp_Init (M.M1.Vtype, E);
       return Mnode'(M1 => (State => Mstate_Dv,
-                           Is_Composite => M.M1.Is_Composite,
                            K => M.M1.K, T => M.M1.T, Dv => D,
                            Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
    end Stabilize_Value;
@@ -1378,7 +1370,6 @@ package body Trans is
                  return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_E,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T, E => E,
                            Vtype => T.Ortho_Type (Kind),
                            Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1388,7 +1379,6 @@ package body Trans is
                   return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_Lv,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T, Lv => L,
                            Vtype => T.Ortho_Type (Kind),
                            Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1397,13 +1387,11 @@ package body Trans is
    function Lv2M (L     : O_Lnode;
                   T     : Type_Info_Acc;
                   Kind  : Object_Kind_Type;
-                  Comp  : Boolean;
                   Vtype : O_Tnode;
                   Ptype : O_Tnode)
                   return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_Lv,
-                           Is_Composite => Comp,
                            K => Kind, T => T, Lv => L,
                            Vtype => Vtype, Ptype => Ptype));
    end Lv2M;
@@ -1412,7 +1400,6 @@ package body Trans is
                   return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_Lp,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T, Lp => L,
                            Vtype => T.Ortho_Type (Kind),
                            Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1426,31 +1413,16 @@ package body Trans is
                   return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_Lp,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T, Lp => L,
                            Vtype => Vtype, Ptype => Ptype));
    end Lp2M;
 
-   function Lv2M (L     : O_Lnode;
-                  T     : Type_Info_Acc;
-                  Kind  : Object_Kind_Type;
-                  Vtype : O_Tnode;
-                  Ptype : O_Tnode)
-                  return Mnode is
-   begin
-      return Mnode'(M1 => (State => Mstate_Lv,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
-                           K => Kind, T => T, Lv => L,
-                           Vtype => Vtype, Ptype => Ptype));
-   end Lv2M;
-
    function Dv2M (D    : O_Dnode;
                   T    : Type_Info_Acc;
                   Kind : Object_Kind_Type)
                   return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_Dv,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T, Dv => D,
                            Vtype => T.Ortho_Type (Kind),
                            Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1464,7 +1436,6 @@ package body Trans is
                   return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_Dv,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T, Dv => D,
                            Vtype => Vtype,
                            Ptype => Ptype));
@@ -1478,7 +1449,6 @@ package body Trans is
                   return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_Dp,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T, Dp => D,
                            Vtype => Vtype, Ptype => Ptype));
    end Dp2M;
@@ -1489,7 +1459,6 @@ package body Trans is
                   return Mnode is
    begin
       return Mnode'(M1 => (State => Mstate_Dp,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T, Dp => D,
                            Vtype => T.Ortho_Type (Kind),
                            Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1578,7 +1547,6 @@ package body Trans is
    begin
       T := Get_Info (Atype);
       return Mnode'(M1 => (State => Mstate_Null,
-                           Is_Composite => T.Type_Mode in Type_Mode_Fat,
                            K => Kind, T => T,
                            Vtype => T.Ortho_Type (Kind),
                            Ptype => T.Ortho_Ptr_Type (Kind)));
@@ -1643,11 +1611,10 @@ package body Trans is
          when Mstate_Dv =>
             return New_Address (New_Obj (M.M1.Dv), M.M1.Ptype);
          when Mstate_E =>
-            if M.M1.Is_Composite then
-               return M.M1.E;
-            else
-               raise Internal_Error;
-            end if;
+            --  For scalar, M contains the value so there is no lvalue from
+            --  which the address can be taken.
+            pragma Assert (Is_Composite (M.M1.T));
+            return M.M1.E;
          when Mstate_Bad
             | Mstate_Null =>
             raise Internal_Error;
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 7156a488d..656bf9a17 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -1459,9 +1459,6 @@ package Trans is
       Mstate_Bad);
 
    type Mnode1 (State : Mstate := Mstate_Bad) is record
-      --  True if the object is composite (its value cannot be read directly).
-      Is_Composite : Boolean;
-
       --  Additionnal informations about the objects: kind and type.
       K : Object_Kind_Type;
       T : Type_Info_Acc;
@@ -1496,7 +1493,6 @@ package Trans is
 
    --  Null Mnode.
    Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null,
-                                                Is_Composite => False,
                                                 K => Mode_Value,
                                                 Ptype => O_Tnode_Null,
                                                 Vtype => O_Tnode_Null,
@@ -1530,30 +1526,24 @@ package Trans is
    function Get_Type_Info (M : Mnode) return Type_Info_Acc;
    pragma Inline (Get_Type_Info);
 
+   --  Creation of Mnodes.
+
    function E2M (E : O_Enode; T : Type_Info_Acc; Kind : Object_Kind_Type)
                 return Mnode;
 
-   function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
-                 return Mnode;
-
+   --  From a Lnode, general form (can be used for ranges, bounds, base...)
    function Lv2M (L     : O_Lnode;
                   T     : Type_Info_Acc;
                   Kind  : Object_Kind_Type;
-                  Comp  : Boolean;
                   Vtype : O_Tnode;
                   Ptype : O_Tnode)
                  return Mnode;
 
-   function Lv2M (L     : O_Lnode;
-                  T     : Type_Info_Acc;
-                  Kind  : Object_Kind_Type;
-                  Vtype : O_Tnode;
-                  Ptype : O_Tnode)
-                 return Mnode;
-
-   function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+   --  From a Lnode, only for values.
+   function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
                  return Mnode;
 
+   --  From a Lnode that designates a pointer, general form.
    function Lp2M (L     : O_Lnode;
                   T     : Type_Info_Acc;
                   Kind  : Object_Kind_Type;
@@ -1561,9 +1551,11 @@ package Trans is
                   Ptype : O_Tnode)
                  return Mnode;
 
-   function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+   --  From a Lnode that designates a pointer to a value.
+   function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
                  return Mnode;
 
+   --  From a variable declaration, general form.
    function Dv2M (D     : O_Dnode;
                   T     : Type_Info_Acc;
                   Kind  : Object_Kind_Type;
@@ -1571,6 +1563,11 @@ package Trans is
                   Ptype : O_Tnode)
                   return Mnode;
 
+   --  From a variable for a value.
+   function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
+                 return Mnode;
+
+   --  From a pointer variable, general form.
    function Dp2M (D     : O_Dnode;
                   T     : Type_Info_Acc;
                   Kind  : Object_Kind_Type;
@@ -1578,6 +1575,7 @@ package Trans is
                   Ptype : O_Tnode)
                   return Mnode;
 
+   --  From a pointer to a value variable.
    function Dp2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
                  return Mnode;
 
@@ -1602,13 +1600,6 @@ package Trans is
 
    function Is_Stable (M : Mnode) return Boolean;
 
-   --    function Varv2M
-   --      (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
-   --      return Mnode is
-   --    begin
-   --       return Lv2M (Get_Var (Var), Vtype, Mode);
-   --    end Varv2M;
-
    function Varv2M (Var      : Var_Type;
                     Var_Type : Type_Info_Acc;
                     Mode     : Object_Kind_Type;