diff options
| -rw-r--r-- | ortho/debug/ortho_debug.adb | 8 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code_main.adb | 4 | ||||
| -rw-r--r-- | ortho/oread/ortho_front.adb | 48 | ||||
| -rw-r--r-- | translate/grt/grt-avhpi.adb | 20 | ||||
| -rw-r--r-- | translate/grt/grt-disp_rti.adb | 10 | ||||
| -rw-r--r-- | translate/grt/grt-disp_tree.adb | 6 | ||||
| -rw-r--r-- | translate/grt/grt-rtis.ads | 13 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_addr.adb | 34 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_addr.ads | 5 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_utils.adb | 6 | ||||
| -rw-r--r-- | translate/grt/grt-signals.adb | 6 | ||||
| -rw-r--r-- | translate/translation.adb | 73 |
12 files changed, 88 insertions, 145 deletions
diff --git a/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb index 023729b..ba02904 100644 --- a/ortho/debug/ortho_debug.adb +++ b/ortho/debug/ortho_debug.adb @@ -410,7 +410,9 @@ package body Ortho_Debug is is subtype O_Cnode_Sizeof_Type is O_Cnode_Type (OC_Sizeof_Lit); begin - if Rtype.Kind /= ON_Unsigned_Type then + if Rtype.Kind /= ON_Unsigned_Type + and then Rtype.Kind /= ON_Access_Type + then raise Type_Error; end if; Check_Complete_Type (Atype); @@ -442,7 +444,9 @@ package body Ortho_Debug is is subtype O_Cnode_Offsetof_Type is O_Cnode_Type (OC_Offsetof_Lit); begin - if Rtype.Kind /= ON_Unsigned_Type then + if Rtype.Kind /= ON_Unsigned_Type + and then Rtype.Kind /= ON_Access_Type + then raise Type_Error; end if; if Field.Parent /= Rec_Type then diff --git a/ortho/mcode/ortho_code_main.adb b/ortho/mcode/ortho_code_main.adb index 7454d8f..a0e6dc6 100644 --- a/ortho/mcode/ortho_code_main.adb +++ b/ortho/mcode/ortho_code_main.adb @@ -33,7 +33,7 @@ procedure Ortho_Code_Main is Output : String_Acc := null; type Format_Type is (Format_Coff, Format_Elf); - Format : Format_Type := Format_Elf; + Format : constant Format_Type := Format_Elf; Fd : File_Descriptor; First_File : Natural; @@ -56,7 +56,7 @@ begin I := 1; while I <= Argc loop declare - Arg : String := Argument (I); + Arg : constant String := Argument (I); begin if Arg (1) = '-' then if Arg'Length > 5 and then Arg (1 .. 5) = "--be-" then diff --git a/ortho/oread/ortho_front.adb b/ortho/oread/ortho_front.adb index 0d3e178..2b82fd8 100644 --- a/ortho/oread/ortho_front.adb +++ b/ortho/oread/ortho_front.adb @@ -899,6 +899,7 @@ package body Ortho_Front is function Parse_Constant_Value (Atype : Node_Acc) return O_Cnode; function Parse_Address (Prefix : Node_Acc) return O_Enode; + function Parse_Constant_Address (Prefix : Node_Acc) return O_Cnode; procedure Parse_Declaration; procedure Parse_Compound_Statement; @@ -1320,6 +1321,7 @@ package body Ortho_Front is Res := New_Float_Literal (Atype.Type_Onode, Token_Float); when Tok_Ident => declare + Pfx : Node_Acc; N : Node_Acc; begin -- Note: we don't use get_decl, since the name can be a literal @@ -1328,7 +1330,8 @@ package body Ortho_Front is and then Token_Sym.Name.Inter.Kind = Decl_Type then -- A typed expression. - N := Token_Sym.Name.Inter.Decl_Dtype; + Pfx := Token_Sym.Name.Inter; + N := Pfx.Decl_Dtype; if Atype /= null and then N /= Atype then Parse_Error ("type mismatch"); end if; @@ -1345,6 +1348,11 @@ package body Ortho_Front is Res := Parse_Sizeof (N); elsif Token_Sym = Id_Alignof then Res := Parse_Alignof (N); + elsif Token_Sym = Id_Address + or Token_Sym = Id_Unchecked_Address + or Token_Sym = Id_Subprg_Addr + then + Res := Parse_Constant_Address (Pfx); elsif Token_Sym = Id_Conv then Next_Expect (Tok_Left_Paren); Next_Token; @@ -2312,7 +2320,6 @@ package body Ortho_Front is end if; end if; Expect (Tok_Right_Paren); - Next_Token; return Res; end Parse_Constant_Address; @@ -2346,7 +2353,8 @@ package body Ortho_Front is | Type_Signed | Type_Enum | Type_Float - | Type_Boolean => + | Type_Boolean + | Type_Access => --return Parse_Primary_Expression (Atype); return Parse_Typed_Literal (Atype); when Type_Record => @@ -2397,40 +2405,6 @@ package body Ortho_Front is Next_Token; return Res; end; - when Type_Access => - -- The only way to initialize an access is either NULL - -- or 'Address. - if Tok = Tok_Null then - Res := New_Null_Access (Atype.Type_Onode); - Next_Token; - return Res; - end if; - - if Tok /= Tok_Ident then - Parse_Error ("identifier expected for access literal"); - end if; - - declare - T : Node_Acc; - begin - T := Get_Decl (Token_Sym); - Next_Expect (Tok_Tick); - Next_Token; - if Tok = Tok_Left_Brack then - if T.Kind /= Decl_Type - or else T.Decl_Dtype.Kind /= Type_Access - then - Parse_Error ("name is not an access type name"); - end if; - Next_Expect (Tok_Null); - Next_Expect (Tok_Right_Brack); - Next_Token; - return New_Null_Access (Atype.Type_Onode); - else - Expect (Tok_Ident); - return Parse_Constant_Address (T); - end if; - end; when others => raise Program_Error; end case; diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb index 58b9870..8d7dd1b 100644 --- a/translate/grt/grt-avhpi.adb +++ b/translate/grt/grt-avhpi.adb @@ -182,11 +182,11 @@ package body Grt.Avhpi is end if; when Ghdl_Rtik_Subtype_Array => if Is_Sig then - El_Size := - To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Sigsize.Off; + El_Size := Ghdl_Index_Type + (To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Sigsize); else - El_Size := - To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Valsize.Off; + El_Size := Ghdl_Index_Type + (To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Valsize); end if; when others => Internal_Error ("add_index"); @@ -259,7 +259,7 @@ package body Grt.Avhpi is declare Base : Address; begin - Base := To_Addr_Acc (Iterator.Ctxt.Base + Nblk.Loc.Off).all; + Base := To_Addr_Acc (Iterator.Ctxt.Base + Nblk.Loc).all; Base := Base + Iterator.It2 * Nblk.Size; Res := (Kind => VhpiForGenerateK, Ctxt => (Base => Base, @@ -277,20 +277,20 @@ package body Grt.Avhpi is case Ch.Kind is when Ghdl_Rtik_Process => Res := (Kind => VhpiProcessStmtK, - Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc.Off, + Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc, Block => Ch)); Error := AvhpiErrorOk; return; when Ghdl_Rtik_Block => Res := (Kind => VhpiBlockStmtK, - Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc.Off, + Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc, Block => Ch)); Error := AvhpiErrorOk; return; when Ghdl_Rtik_If_Generate => Res := (Kind => VhpiIfGenerateK, Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base - + Nblk.Loc.Off).all, + + Nblk.Loc).all, Block => Ch)); -- Return only if the condition is true. if Res.Ctxt.Base /= Null_Address then @@ -300,7 +300,7 @@ package body Grt.Avhpi is when Ghdl_Rtik_For_Generate => Res := (Kind => VhpiForGenerateK, Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base - + Nblk.Loc.Off).all, + + Nblk.Loc).all, Block => Ch)); Iterator.Max2 := Get_For_Generate_Length (Nblk, Iterator.Ctxt); Iterator.It2 := 0; @@ -743,7 +743,7 @@ package body Grt.Avhpi is Rti := To_Ghdl_Rtin_Block_Acc (Ref.Ctxt.Block).Parent; Ent := To_Ghdl_Rtin_Block_Acc (Rti); Res := (Kind => VhpiEntityDeclK, - Ctxt => (Base => Ref.Ctxt.Base + Ent.Loc.Off, + Ctxt => (Base => Ref.Ctxt.Base + Ent.Loc, Block => Rti)); Error := AvhpiErrorOk; end; diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb index b2010f2..67ddc40 100644 --- a/translate/grt/grt-disp_rti.adb +++ b/translate/grt/grt-disp_rti.adb @@ -430,7 +430,7 @@ package body Grt.Disp_Rti is procedure Align (A : Ghdl_Index_Type) is begin - Bounds := Align (Bounds, A); + Bounds := Align (Bounds, Ghdl_Rti_Loc (A)); end Align; procedure Update (S : Ghdl_Index_Type) is @@ -602,7 +602,7 @@ package body Grt.Disp_Rti is | Ghdl_Rtik_Architecture | Ghdl_Rtik_Block | Ghdl_Rtik_Process => - Nctxt := (Base => Ctxt.Base + Blk.Loc.Off, + Nctxt := (Base => Ctxt.Base + Blk.Loc, Block => To_Ghdl_Rti_Access (Blk)); Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children, Nctxt, Indent + 1); @@ -610,7 +610,7 @@ package body Grt.Disp_Rti is declare Length : Ghdl_Index_Type; begin - Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc.Off).all, + Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc).all, Block => To_Ghdl_Rti_Access (Blk)); Length := Get_For_Generate_Length (Blk, Ctxt); for I in 1 .. Length loop @@ -620,7 +620,7 @@ package body Grt.Disp_Rti is end loop; end; when Ghdl_Rtik_If_Generate => - Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc.Off).all, + Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc).all, Block => To_Ghdl_Rti_Access (Blk)); if Nctxt.Base /= Null_Address then Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children, @@ -705,7 +705,7 @@ package body Grt.Disp_Rti is Disp_Name (Inst.Name); New_Line; - Inst_Addr := Ctxt.Base + Inst.Loc.Off; + Inst_Addr := Ctxt.Base + Inst.Loc; -- Read sub instance. Inst_Base := To_Addr_Acc (Inst_Addr).all; diff --git a/translate/grt/grt-disp_tree.adb b/translate/grt/grt-disp_tree.adb index c72d67b..9e92c83 100644 --- a/translate/grt/grt-disp_tree.adb +++ b/translate/grt/grt-disp_tree.adb @@ -237,7 +237,7 @@ package body Grt.Disp_Tree is To_Ghdl_Rtin_Block_Acc (Child); Nctxt : Rti_Context; begin - Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off, + Nctxt := (Base => Ctxt.Base + Nblk.Loc, Block => Child); Disp_Header (Nctxt, False); Disp_Sub_Block (Nblk, Nctxt); @@ -250,7 +250,7 @@ package body Grt.Disp_Tree is Length : Ghdl_Index_Type; Old_Child2 : Ghdl_Rti_Access; begin - Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all, + Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all, Block => Child); Length := Get_For_Generate_Length (Nblk, Ctxt); Disp_Header (Nctxt, Length > 1); @@ -276,7 +276,7 @@ package body Grt.Disp_Tree is To_Ghdl_Rtin_Block_Acc (Child); Nctxt : Rti_Context; begin - Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all, + Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all, Block => Child); Disp_Header (Nctxt); if Nctxt.Base /= Null_Address then diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads index 01dc7c7..977c9c1 100644 --- a/translate/grt/grt-rtis.ads +++ b/translate/grt/grt-rtis.ads @@ -108,15 +108,8 @@ package Grt.Rtis is type Ghdl_Rti_Array is array (Ghdl_Index_Type) of Ghdl_Rti_Access; type Ghdl_Rti_Arr_Acc is access Ghdl_Rti_Array; - type Ghdl_Rti_Loc (Rel : Boolean := False) is record - case Rel is - when True => - Off : Ghdl_Index_Type; - when False => - Addr : Address; - end case; - end record; - pragma Unchecked_Union (Ghdl_Rti_Loc); + subtype Ghdl_Rti_Loc is Integer_Address; + Null_Rti_Loc : constant Ghdl_Rti_Loc := 0; type Ghdl_C_String_Array is array (Ghdl_Index_Type) of Ghdl_C_String; type Ghdl_C_String_Array_Ptr is access Ghdl_C_String_Array; @@ -344,7 +337,7 @@ package Grt.Rtis is Ghdl_Rti_Top : Ghdl_Rtin_Block := (Common => (Ghdl_Rtik_Top, 0, 0, 0), Name => null, - Loc => (Rel => True, Off => 0), + Loc => Null_Rti_Loc, Parent => null, Size => 0, Nbr_Child => 0, diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb index adbedf7..f63f47b 100644 --- a/translate/grt/grt-rtis_addr.adb +++ b/translate/grt/grt-rtis_addr.adb @@ -18,24 +18,30 @@ with Grt.Errors; use Grt.Errors; package body Grt.Rtis_Addr is + function "+" (L : Address; R : Ghdl_Rti_Loc) return Address + is + begin + return To_Address (To_Integer (L) + R); + end "+"; + function "+" (L : Address; R : Ghdl_Index_Type) return Address is begin return To_Address (To_Integer (L) + Integer_Address (R)); end "+"; - function "-" (L : Address; R : Ghdl_Index_Type) return Address + function "-" (L : Address; R : Ghdl_Rti_Loc) return Address is begin - return To_Address (To_Integer (L) - Integer_Address (R)); + return To_Address (To_Integer (L) - R); end "-"; - function Align (L : Address; R : Ghdl_Index_Type) return Address + function Align (L : Address; R : Ghdl_Rti_Loc) return Address is Nad : Integer_Address; begin Nad := To_Integer (L + (R - 1)); - return To_Address (Nad - (Nad mod Integer_Address (R))); + return To_Address (Nad - (Nad mod R)); end Align; function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context @@ -46,13 +52,13 @@ package body Grt.Rtis_Addr is case Ctxt.Block.Kind is when Ghdl_Rtik_Process | Ghdl_Rtik_Block => - return (Base => Ctxt.Base - Blk.Loc.Off, + return (Base => Ctxt.Base - Blk.Loc, Block => Blk.Parent); when Ghdl_Rtik_Architecture => - if Blk.Loc.Off /= 0 then + if Blk.Loc /= Null_Rti_Loc then Internal_Error ("get_parent_context(3)"); end if; - return (Base => Ctxt.Base + Blk.Loc.Off, + return (Base => Ctxt.Base + Blk.Loc, Block => Blk.Parent); when Ghdl_Rtik_For_Generate | Ghdl_Rtik_If_Generate => @@ -75,7 +81,7 @@ package body Grt.Rtis_Addr is exit; when Ghdl_Rtik_Block => Blk1 := To_Ghdl_Rtin_Block_Acc (Parent); - Nbase := Nbase + Blk1.Loc.Off; + Nbase := Nbase + Blk1.Loc; Parent := Blk1.Parent; when others => Internal_Error ("get_parent_context(2)"); @@ -102,7 +108,7 @@ package body Grt.Rtis_Addr is else Stmt := Link.Parent.Stmt; Obj := To_Ghdl_Rtin_Instance_Acc (Stmt); - Ctxt := (Base => Link.Parent.all'Address - Obj.Loc.Off, + Ctxt := (Base => Link.Parent.all'Address - Obj.Loc, Block => Obj.Parent); end if; end Get_Instance_Link; @@ -116,10 +122,10 @@ package body Grt.Rtis_Addr is Nctxt : Rti_Context; begin if Depth = 0 then - return Loc.Addr; + return To_Address (Loc); elsif Ctxt.Block.Depth = Depth then --Addr := Base + Storage_Offset (Obj.Loc.Off); - return Ctxt.Base + Loc.Off; + return Ctxt.Base + Loc; else if Ctxt.Block.Depth < Depth then Internal_Error ("loc_to_addr"); @@ -128,7 +134,7 @@ package body Grt.Rtis_Addr is loop Nctxt := Get_Parent_Context (Cur_Ctxt); if Nctxt.Block.Depth = Depth then - return Nctxt.Base + Loc.Off; + return Nctxt.Base + Loc; end if; Cur_Ctxt := Nctxt; end loop; @@ -178,7 +184,7 @@ package body Grt.Rtis_Addr is Inst_Base : Address; begin -- Address of the field containing the address of the instance. - Inst_Addr := Ctxt.Base + Inst.Loc.Off; + Inst_Addr := Ctxt.Base + Inst.Loc; -- Read sub instance address. Inst_Base := To_Addr_Acc (Inst_Addr).all; -- Read instance RTI. @@ -198,7 +204,7 @@ package body Grt.Rtis_Addr is procedure Align (A : Ghdl_Index_Type) is begin - Bounds := Align (Bounds, A); + Bounds := Align (Bounds, Ghdl_Rti_Loc (A)); end Align; procedure Update (S : Ghdl_Index_Type) is diff --git a/translate/grt/grt-rtis_addr.ads b/translate/grt/grt-rtis_addr.ads index 8f79126..b4e4b5f 100644 --- a/translate/grt/grt-rtis_addr.ads +++ b/translate/grt/grt-rtis_addr.ads @@ -22,11 +22,12 @@ with Grt.Rtis; use Grt.Rtis; -- Addresses handling. package Grt.Rtis_Addr is + function "+" (L : Address; R : Ghdl_Rti_Loc) return Address; function "+" (L : Address; R : Ghdl_Index_Type) return Address; - function "-" (L : Address; R : Ghdl_Index_Type) return Address; + function "-" (L : Address; R : Ghdl_Rti_Loc) return Address; - function Align (L : Address; R : Ghdl_Index_Type) return Address; + function Align (L : Address; R : Ghdl_Rti_Loc) return Address; -- An RTI context contains a pointer (BASE) to or into an instance. -- BLOCK describes data being pointed. If a reference is made to a field diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb index 1c526c3..403e404 100644 --- a/translate/grt/grt-rtis_utils.adb +++ b/translate/grt/grt-rtis_utils.adb @@ -50,7 +50,7 @@ package body Grt.Rtis_Utils is Nblk : Ghdl_Rtin_Block_Acc; begin Nblk := To_Ghdl_Rtin_Block_Acc (Child); - Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off, + Nctxt := (Base => Ctxt.Base + Nblk.Loc, Block => Child); Res := Traverse_Blocks_1 (Nctxt); end; @@ -61,7 +61,7 @@ package body Grt.Rtis_Utils is begin Nblk := To_Ghdl_Rtin_Block_Acc (Child); Nctxt := - (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all, + (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all, Block => Child); Length := Get_For_Generate_Length (Nblk, Ctxt); for I in 1 .. Length loop @@ -76,7 +76,7 @@ package body Grt.Rtis_Utils is begin Nblk := To_Ghdl_Rtin_Block_Acc (Child); Nctxt := - (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all, + (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all, Block => Child); if Nctxt.Base /= Null_Address then Res := Traverse_Blocks_1 (Nctxt); diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb index 3ea693d..67aa5fd 100644 --- a/translate/grt/grt-signals.adb +++ b/translate/grt/grt-signals.adb @@ -1290,7 +1290,7 @@ package body Grt.Signals is Mode => Ghdl_Rti_Signal_Mode_None, Max_Depth => 0), Name => null, - Loc => (Rel => True, Off => 0), + Loc => Null_Rti_Loc, Obj_Type => null); Boolean_Signal_Rti : aliased Ghdl_Rtin_Object := @@ -1299,7 +1299,7 @@ package body Grt.Signals is Mode => Ghdl_Rti_Signal_Mode_None, Max_Depth => 0), Name => null, - Loc => (Rel => True, Off => 0), + Loc => Null_Rti_Loc, Obj_Type => null); function Ghdl_Create_Signal_Attribute @@ -1380,7 +1380,7 @@ package body Grt.Signals is Mode => Ghdl_Rti_Signal_Mode_None, Max_Depth => 0), Name => null, - Loc => (Rel => True, Off => 0), + Loc => Null_Rti_Loc, Obj_Type => Std_Standard_Boolean_RTI_Ptr); function Ghdl_Signal_Create_Guard (This : System.Address; diff --git a/translate/translation.adb b/translate/translation.adb index d60bf98..7f7945c 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -691,11 +691,6 @@ package body Translation is Ghdl_Rti_Array : O_Tnode; Ghdl_Rti_Arr_Acc : O_Tnode; - -- Location of an object. - Ghdl_Rti_Loc : O_Tnode; - Ghdl_Rti_Loc_Offset : O_Fnode; - Ghdl_Rti_Loc_Address : O_Fnode; - -- Instance link. -- This is a structure at the beginning of each entity/architecture -- instance. This allow the run-time to find the parent of an instance. @@ -25776,19 +25771,6 @@ package body Translation is Finish_Record_Type (Constr, Ghdl_Component_Link_Type); end; - -- Create type ghdl_rti_loc - declare - Constr : O_Element_List; - begin - Start_Union_Type (Constr); - New_Union_Field (Constr, Ghdl_Rti_Loc_Offset, - Get_Identifier ("offset"), Ghdl_Index_Type); - New_Union_Field (Constr, Ghdl_Rti_Loc_Address, - Get_Identifier ("address"), Ghdl_Ptr_Type); - Finish_Union_Type (Constr, Ghdl_Rti_Loc); - New_Type_Decl (Get_Identifier ("__ghdl_rti_loc"), Ghdl_Rti_Loc); - end; - -- Create type ghdl_rtin_block declare Constr : O_Element_List; @@ -25799,7 +25781,7 @@ package body Translation is New_Record_Field (Constr, Ghdl_Rtin_Block_Name, Get_Identifier ("name"), Char_Ptr_Type); New_Record_Field (Constr, Ghdl_Rtin_Block_Loc, - Get_Identifier ("loc"), Ghdl_Rti_Loc); + Get_Identifier ("loc"), Ghdl_Ptr_Type); New_Record_Field (Constr, Ghdl_Rtin_Block_Parent, Wki_Parent, Ghdl_Rti_Access); New_Record_Field (Constr, Ghdl_Rtin_Block_Size, @@ -25858,7 +25840,7 @@ package body Translation is New_Record_Field (Constr, Ghdl_Rtin_Subtype_Scalar_Base, Get_Identifier ("base"), Ghdl_Rti_Access); New_Record_Field (Constr, Ghdl_Rtin_Subtype_Scalar_Range, - Get_Identifier ("range"), Ghdl_Rti_Loc); + Get_Identifier ("range"), Ghdl_Ptr_Type); Finish_Record_Type (Constr, Ghdl_Rtin_Subtype_Scalar); New_Type_Decl (Get_Identifier ("__ghdl_rtin_subtype_scalar"), Ghdl_Rtin_Subtype_Scalar); @@ -25962,11 +25944,11 @@ package body Translation is New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Basetype, Get_Identifier ("basetype"), Ghdl_Rti_Access); New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Bounds, - Get_Identifier ("bounds"), Ghdl_Rti_Loc); + Get_Identifier ("bounds"), Ghdl_Ptr_Type); New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Valsize, - Get_Identifier ("val_size"), Ghdl_Rti_Loc); + Get_Identifier ("val_size"), Ghdl_Ptr_Type); New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Sigsize, - Get_Identifier ("sig_size"), Ghdl_Rti_Loc); + Get_Identifier ("sig_size"), Ghdl_Ptr_Type); Finish_Record_Type (Constr, Ghdl_Rtin_Subtype_Array); New_Type_Decl (Get_Identifier ("__ghdl_rtin_subtype_array"), Ghdl_Rtin_Subtype_Array); @@ -25985,10 +25967,6 @@ package body Translation is Get_Identifier ("nbrel"), Ghdl_Index_Type); New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Elements, Get_Identifier ("elements"), Ghdl_Rti_Arr_Acc); - --New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Valsize, - -- Get_Identifier ("val_size"), Ghdl_Rti_Loc); - --New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Sigsize, - -- Get_Identifier ("sig_size"), Ghdl_Rti_Loc); Finish_Record_Type (Constr, Ghdl_Rtin_Type_Record); New_Type_Decl (Get_Identifier ("__ghdl_rtin_type_record"), Ghdl_Rtin_Type_Record); @@ -26024,7 +26002,7 @@ package body Translation is New_Record_Field (Constr, Ghdl_Rtin_Object_Name, Get_Identifier ("name"), Char_Ptr_Type); New_Record_Field (Constr, Ghdl_Rtin_Object_Loc, - Get_Identifier ("loc"), Ghdl_Rti_Loc); + Get_Identifier ("loc"), Ghdl_Ptr_Type); New_Record_Field (Constr, Ghdl_Rtin_Object_Type, Get_Identifier ("obj_type"), Ghdl_Rti_Access); Finish_Record_Type (Constr, Ghdl_Rtin_Object); @@ -26042,7 +26020,7 @@ package body Translation is New_Record_Field (Constr, Ghdl_Rtin_Instance_Name, Get_Identifier ("name"), Char_Ptr_Type); New_Record_Field (Constr, Ghdl_Rtin_Instance_Loc, - Get_Identifier ("loc"), Ghdl_Rti_Loc); + Get_Identifier ("loc"), Ghdl_Ptr_Type); New_Record_Field (Constr, Ghdl_Rtin_Instance_Parent, Wki_Parent, Ghdl_Rti_Access); New_Record_Field (Constr, Ghdl_Rtin_Instance_Type, @@ -26278,24 +26256,19 @@ package body Translation is function Get_Null_Loc return O_Cnode is begin - return New_Union_Aggr (Ghdl_Rti_Loc, - Ghdl_Rti_Loc_Address, - New_Null_Access (Ghdl_Ptr_Type)); + return New_Null_Access (Ghdl_Ptr_Type); end Get_Null_Loc; function Var_Acc_To_Loc (Var : Var_Acc) return O_Cnode is begin if Is_Var_Field (Var) then - return New_Union_Aggr (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset, - New_Offsetof (Get_Var_Record (Var), - Get_Var_Field (Var), - Ghdl_Index_Type)); + return New_Offsetof (Get_Var_Record (Var), + Get_Var_Field (Var), + Ghdl_Ptr_Type); else - return New_Union_Aggr - (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Address, - New_Global_Unchecked_Address (Get_Var_Label (Var), - Ghdl_Ptr_Type)); + return New_Global_Unchecked_Address (Get_Var_Label (Var), + Ghdl_Ptr_Type); end if; end Var_Acc_To_Loc; @@ -26878,10 +26851,8 @@ package body Translation is Val := Var_Acc_To_Loc (Info.C (I).Size_Var); end if; else - Val := New_Union_Aggr - (Ghdl_Rti_Loc, Ghdl_Rti_Loc_Offset, - New_Sizeof (Info.Ortho_Type (I), - Ghdl_Index_Type)); + Val := New_Sizeof (Info.Ortho_Type (I), + Ghdl_Ptr_Type); end if; end if; when Type_Mode_Fat_Array => @@ -27415,12 +27386,9 @@ package body Translation is 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 - (Get_Info (Get_Parent (Stmt)).Block_Decls_Type, - Info.Block_Link_Field, - Ghdl_Index_Type))); + (List, New_Offsetof (Get_Info (Get_Parent (Stmt)).Block_Decls_Type, + Info.Block_Link_Field, + Ghdl_Ptr_Type)); New_Record_Aggr_El (List, New_Rti_Address (Parent)); case Get_Kind (Inst) is when Iir_Kind_Component_Declaration => @@ -27733,10 +27701,7 @@ 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_Parent, Field, Ghdl_Index_Type)); + Res := New_Offsetof (Field_Parent, Field, Ghdl_Ptr_Type); end if; New_Record_Aggr_El (List, Res); if Parent_Rti = O_Dnode_Null then |