new_offsetof: add argument for record type (llvm preliminary work).

11 files changed, 82 insertions, 41 deletions

diff --git a/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb
index 74c80788f..023729b27 100644
--- a/ortho/debug/ortho_debug.adb
+++ b/ortho/debug/ortho_debug.adb
@@ -437,13 +437,17 @@ package body Ortho_Debug is
                                        S_Type => Atype);
    end New_Alignof;
 
-   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode
    is
       subtype O_Cnode_Offsetof_Type is O_Cnode_Type (OC_Offsetof_Lit);
    begin
       if Rtype.Kind /= ON_Unsigned_Type then
          raise Type_Error;
       end if;
+      if Field.Parent /= Rec_Type then
+         raise Type_Error;
+      end if;
       return new O_Cnode_Offsetof_Type'(Kind => OC_Offsetof_Lit,
                                         Ctype => Rtype,
                                         Ref => False,
diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c
index 5404afbc9..fe02dbcf0 100644
--- a/ortho/gcc/ortho-lang.c
+++ b/ortho/gcc/ortho-lang.c
@@ -1442,13 +1442,15 @@ new_access_element (tree acc)
 }
 
 tree
-new_offsetof (tree field, tree rtype)
+new_offsetof (tree rec_type, tree field, tree rtype)
 {
   tree off;
   tree bit_off;
   HOST_WIDE_INT pos;
   tree res;
 
+  gcc_assert (DECL_CONTEXT (field) == rec_type);
+
   off = DECL_FIELD_OFFSET (field);
 
   /*  The offset must be a constant.  */
diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads
index 31005ae6c..d01caeed8 100644
--- a/ortho/gcc/ortho_gcc.ads
+++ b/ortho/gcc/ortho_gcc.ads
@@ -237,9 +237,10 @@ package Ortho_Gcc is
    --  unsgined type RTYPE.
    function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
 
-   --  Returns the offset of FIELD in its record.  The result is a literal
-   --  of unsigned type RTYPE.
-   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode;
+   --  Returns the offset of FIELD in its record REC_TYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
 
    --  Get an element of an array.
    --  INDEX must be of the type of the array index.
diff --git a/ortho/mcode/ortho_code-consts.adb b/ortho/mcode/ortho_code-consts.adb
index 1122b8e34..d09a13c34 100644
--- a/ortho/mcode/ortho_code-consts.adb
+++ b/ortho/mcode/ortho_code-consts.adb
@@ -496,8 +496,12 @@ package body Ortho_Code.Consts is
       return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype;
    end Get_Alignof_Type;
 
-   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode is
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode is
    begin
+      if Get_Field_Parent (Field) /= Rec_Type then
+         raise Syntax_Error;
+      end if;
       return New_Unsigned_Literal
         (Rtype, Unsigned_64 (Get_Field_Offset (Field)));
    end New_Offsetof;
diff --git a/ortho/mcode/ortho_code-consts.ads b/ortho/mcode/ortho_code-consts.ads
index 7059b569a..0076bc6eb 100644
--- a/ortho/mcode/ortho_code-consts.ads
+++ b/ortho/mcode/ortho_code-consts.ads
@@ -126,9 +126,10 @@ package Ortho_Code.Consts is
    --  unsgined type RTYPE.
    function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
 
-   --  Returns the offset of FIELD in its record.  The result is a literal
-   --  of unsigned type RTYPE.
-   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode;
+   --  Returns the offset of FIELD in its record REC_TYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
 
    procedure Disp_Stats;
 
diff --git a/ortho/mcode/ortho_code-types.adb b/ortho/mcode/ortho_code-types.adb
index d15722865..e0c070c27 100644
--- a/ortho/mcode/ortho_code-types.adb
+++ b/ortho/mcode/ortho_code-types.adb
@@ -77,6 +77,7 @@ package body Ortho_Code.Types is
       Table_Increment => 100);
 
    type Field_Type is record
+      Parent : O_Tnode;
       Ident : O_Ident;
       Ftype : O_Tnode;
       Offset : Uns32;
@@ -226,6 +227,11 @@ package body Ortho_Code.Types is
       Fnodes.Table (Field).Offset := Offset;
    end Set_Field_Offset;
 
+   function Get_Field_Parent (Field : O_Fnode) return O_Tnode is
+   begin
+      return Fnodes.Table (Field).Parent;
+   end Get_Field_Parent;
+
    function Get_Field_Type (Field : O_Fnode) return O_Tnode is
    begin
       return Fnodes.Table (Field).Ftype;
@@ -592,7 +598,8 @@ package body Ortho_Code.Types is
    begin
       Elements.Off := Do_Align (Elements.Off, Etype);
 
-      Fnodes.Append (Field_Type'(Ident => Ident,
+      Fnodes.Append (Field_Type'(Parent => Elements.Res,
+                                 Ident => Ident,
                                  Ftype => Etype,
                                  Offset => Elements.Off,
                                  Next => O_Fnode_Null));
diff --git a/ortho/mcode/ortho_code-types.ads b/ortho/mcode/ortho_code-types.ads
index 86a6c2cd3..da6549841 100644
--- a/ortho/mcode/ortho_code-types.ads
+++ b/ortho/mcode/ortho_code-types.ads
@@ -93,6 +93,9 @@ package Ortho_Code.Types is
    function Get_Type_Bool_False (Atype : O_Tnode) return O_Cnode;
    function Get_Type_Bool_True (Atype : O_Tnode) return O_Cnode;
 
+   --  Return the union/record type which contains FIELD.
+   function Get_Field_Parent (Field : O_Fnode) return O_Tnode;
+
    --  Get the offset of FIELD in its record/union.
    function Get_Field_Offset (Field : O_Fnode) return Uns32;
    procedure Set_Field_Offset (Field : O_Fnode; Offset : Uns32);
diff --git a/ortho/mcode/ortho_mcode.ads b/ortho/mcode/ortho_mcode.ads
index ea06573a6..369e74382 100644
--- a/ortho/mcode/ortho_mcode.ads
+++ b/ortho/mcode/ortho_mcode.ads
@@ -280,9 +280,10 @@ package Ortho_Mcode is
    function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
      renames Ortho_Code.Consts.New_Alignof;
 
-   --  Returns the offset of FIELD in its record.  The result is a literal
-   --  of unsigned type RTYPE.
-   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode
+   --  Returns the offset of FIELD in its record REC_TYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode
      renames Ortho_Code.Consts.New_Offsetof;
 
    --  Get an element of an array.
diff --git a/ortho/oread/ortho_front.adb b/ortho/oread/ortho_front.adb
index c6e1234cc..0d3e17875 100644
--- a/ortho/oread/ortho_front.adb
+++ b/ortho/oread/ortho_front.adb
@@ -1244,7 +1244,8 @@ package body Ortho_Front is
       Next_Expect (Tok_Ident);
       Rec_Field := Find_Field_By_Name (Rec_Type.Decl_Dtype);
       Next_Expect (Tok_Right_Paren);
-      return New_Offsetof (Rec_Field.Field_Fnode,
+      return New_Offsetof (Rec_Type.Decl_Dtype.Type_Onode,
+                           Rec_Field.Field_Fnode,
                            Atype.Type_Onode);
    end Parse_Offsetof;
 
diff --git a/ortho/ortho_nodes.common.ads b/ortho/ortho_nodes.common.ads
index 9e29d372b..ee26f602e 100644
--- a/ortho/ortho_nodes.common.ads
+++ b/ortho/ortho_nodes.common.ads
@@ -171,9 +171,10 @@ package ORTHO_NODES is
    --  unsgined type RTYPE.
    function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
 
-   --  Returns the offset of FIELD in its record.  The result is a literal
-   --  of unsigned type RTYPE.
-   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode;
+   --  Returns the offset of FIELD in its record REC_TYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
 
    --  Get the address of a subprogram.
    function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
diff --git a/translate/translation.adb b/translate/translation.adb
index ab21e069b..d60bf9804 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -351,6 +351,7 @@ package body Translation is
       --  Used only to generate RTI.
       function Is_Var_Field (Var : Var_Acc) return Boolean;
       function Get_Var_Field (Var : Var_Acc) return O_Fnode;
+      function Get_Var_Record (Var : Var_Acc) return O_Tnode;
       function Get_Var_Label (Var : Var_Acc) return O_Dnode;
    private
       type Local_Identifier_Type is new Natural;
@@ -4450,14 +4451,13 @@ package body Translation is
                   when Iir_Kind_Component_Instantiation_Statement =>
                      declare
                         Assoc : O_Assoc_List;
-                        Info : Block_Info_Acc;
-                        Comp_Info : Comp_Info_Acc;
+                        Info : constant Block_Info_Acc := Get_Info (El);
+                        Comp_Info : constant Comp_Info_Acc :=
+                          Get_Info (Get_Instantiated_Unit (El));
                         V : O_Lnode;
                      begin
                         --  The component is really a component and not a
                         --  direct instance.
-                        Info := Get_Info (El);
-                        Comp_Info := Get_Info (Get_Instantiated_Unit (El));
                         Start_Association (Assoc, Cfg_Info.Config_Subprg);
                         V := Get_Instance_Ref (Block_Info.Block_Decls_Type);
                         V := New_Selected_Element (V, Info.Block_Link_Field);
@@ -21703,7 +21703,7 @@ package body Translation is
 
       procedure Translate_Component_Instantiation_Statement (Inst : Iir)
       is
-         Comp : Iir;
+         Comp : constant Iir := Get_Instantiated_Unit (Inst);
          Info : Block_Info_Acc;
          Comp_Info : Comp_Info_Acc;
 
@@ -21711,7 +21711,6 @@ package body Translation is
          Assoc, Conv, In_Type : Iir;
          Has_Conv_Record : Boolean := False;
       begin
-         Comp := Get_Instantiated_Unit (Inst);
          Info := Add_Info (Inst, Kind_Block);
          Info.Block_Decls_Type := O_Tnode_Null;
          if Get_Kind (Comp) = Iir_Kind_Component_Declaration then
@@ -23987,6 +23986,17 @@ package body Translation is
          end case;
       end Get_Var_Field;
 
+      function Get_Var_Record (Var : Var_Acc) return O_Tnode is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               raise Internal_Error;
+            when Var_Scope =>
+               return Var.I_Type;
+         end case;
+      end Get_Var_Record;
+
       function Get_Var_Label (Var : Var_Acc) return O_Dnode is
       begin
          case Var.Kind is
@@ -26278,7 +26288,8 @@ package body Translation is
       begin
          if Is_Var_Field (Var) then
             return New_Union_Aggr (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset,
-                                   New_Offsetof (Get_Var_Field (Var),
+                                   New_Offsetof (Get_Var_Record (Var),
+                                                 Get_Var_Field (Var),
                                                  Ghdl_Index_Type));
          else
             return New_Union_Aggr
@@ -26892,10 +26903,9 @@ package body Translation is
          Prev : Rti_Block;
          El_Arr : O_Dnode;
          Res : O_Cnode;
-         Info : Type_Info_Acc;
+         Info : constant Type_Info_Acc := Get_Info (Atype);
          Max_Depth : Rti_Depth_Type;
       begin
-         Info := Get_Info (Atype);
          Generate_Type_Rti (Info, Ghdl_Rtin_Type_Record);
          if Global_Storage = O_Storage_External then
             return;
@@ -26912,23 +26922,21 @@ package body Translation is
             declare
                Type_Rti : O_Dnode;
                El_Name : O_Dnode;
-               El_Type : Iir;
+               El_Type : constant Iir := Get_Type (El);
                Aggr : O_Record_Aggr_List;
-               Field_Info : Field_Info_Acc;
+               Field_Info : constant Field_Info_Acc := Get_Info (El);
                Val : O_Cnode;
                El_Const : O_Dnode;
                Mark : Id_Mark_Type;
             begin
                Push_Identifier_Prefix (Mark, Get_Identifier (El));
 
-               El_Type := Get_Type (El);
                Type_Rti := Generate_Type_Definition (El_Type);
                Max_Depth :=
                  Rti_Depth_Type'Max (Max_Depth,
                                      Get_Info (El_Type).T.Rti_Max_Depth);
 
                El_Name := Generate_Name (El);
-               Field_Info := Get_Info (El);
                New_Const_Decl (El_Const, Create_Identifier ("RTIEL"),
                                Global_Storage, Ghdl_Rtin_Element);
                Start_Const_Value (El_Const);
@@ -26939,7 +26947,8 @@ package body Translation 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 (Field_Info.Field_Node (I),
+                     Val := New_Offsetof (Info.Ortho_Type (I),
+                                          Field_Info.Field_Node (I),
                                           Ghdl_Index_Type);
                   else
                      Val := Ghdl_Index_0;
@@ -27393,24 +27402,25 @@ package body Translation is
          Name : O_Dnode;
          List : O_Record_Aggr_List;
          Val : O_Cnode;
-         Inst : Iir;
-         Info : Block_Info_Acc;
+         Inst : constant Iir := Get_Instantiated_Unit (Stmt);
+         Info : constant Block_Info_Acc := Get_Info (Stmt);
       begin
          Name := Generate_Name (Stmt);
-         Info := Get_Info (Stmt);
 
          New_Const_Decl (Info.Block_Rti_Const, Create_Identifier ("RTI"),
                          Global_Storage, Ghdl_Rtin_Instance);
 
-         Inst := Get_Instantiated_Unit (Stmt);
          Start_Const_Value (Info.Block_Rti_Const);
          Start_Record_Aggr (List, Ghdl_Rtin_Instance);
          New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Instance));
          New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
          New_Record_Aggr_El
-           (List, New_Union_Aggr (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset,
-                                  New_Offsetof (Info.Block_Link_Field,
-                                                Ghdl_Index_Type)));
+           (List,
+            New_Union_Aggr (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset,
+                            New_Offsetof
+                              (Get_Info (Get_Parent (Stmt)).Block_Decls_Type,
+                               Info.Block_Link_Field,
+                               Ghdl_Index_Type)));
          New_Record_Aggr_El (List, New_Rti_Address (Parent));
          case Get_Kind (Inst) is
             when Iir_Kind_Component_Declaration =>
@@ -27599,6 +27609,7 @@ package body Translation is
          Info : Ortho_Info_Acc;
 
          Field : O_Fnode;
+         Field_Parent : O_Tnode;
          Inst : O_Tnode;
       begin
          --  The type of a generator iterator is elaborated in the parent.
@@ -27646,6 +27657,7 @@ package body Translation is
                  (Get_Concurrent_Statement_Chain (Blk), Rti);
                Field := Info.Block_Parent_Field;
                Inst := Info.Block_Decls_Type;
+               Field_Parent := Info.Block_Decls_Type;
             when Iir_Kind_Entity_Declaration =>
                Kind := Ghdl_Rtik_Entity;
                Generate_Declaration_Chain (Get_Generic_Chain (Blk));
@@ -27659,6 +27671,7 @@ package body Translation is
                Kind := Ghdl_Rtik_Process;
                Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
                Field := Info.Process_Parent_Field;
+               Field_Parent := Get_Info (Get_Parent (Blk)).Block_Decls_Type;
                Inst := Info.Process_Decls_Type;
             when Iir_Kind_Block_Statement =>
                Kind := Ghdl_Rtik_Block;
@@ -27683,6 +27696,7 @@ package body Translation is
                Generate_Concurrent_Statement_Chain
                  (Get_Concurrent_Statement_Chain (Blk), Rti);
                Field := Info.Block_Parent_Field;
+               Field_Parent := Get_Info (Get_Parent (Blk)).Block_Decls_Type;
                Inst := Info.Block_Decls_Type;
             when Iir_Kind_Generate_Statement =>
                declare
@@ -27702,6 +27716,7 @@ package body Translation is
                Generate_Concurrent_Statement_Chain
                  (Get_Concurrent_Statement_Chain (Blk), Rti);
                Field := Info.Block_Parent_Field;
+               Field_Parent := Get_Info (Get_Parent (Blk)).Block_Decls_Type;
                Inst := Info.Block_Decls_Type;
             when others =>
                Error_Kind ("rti.generate_block", Blk);
@@ -27718,9 +27733,10 @@ package body Translation is
          if Field = O_Fnode_Null then
             Res := Get_Null_Loc;
          else
-            Res := New_Union_Aggr (Ghdl_Rti_Loc,
-                                   Ghdl_Rti_Loc_Offset,
-                                   New_Offsetof (Field, Ghdl_Index_Type));
+            Res := New_Union_Aggr
+              (Ghdl_Rti_Loc,
+               Ghdl_Rti_Loc_Offset,
+               New_Offsetof (Field_Parent, Field, Ghdl_Index_Type));
          end if;
          New_Record_Aggr_El (List, Res);
          if Parent_Rti = O_Dnode_Null then