diff options
-rw-r--r-- | src/ortho/llvm/ortho_llvm.adb | 44 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap3.adb | 15 |
2 files changed, 41 insertions, 18 deletions
diff --git a/src/ortho/llvm/ortho_llvm.adb b/src/ortho/llvm/ortho_llvm.adb index 848cb2c..ce5213e 100644 --- a/src/ortho/llvm/ortho_llvm.adb +++ b/src/ortho/llvm/ortho_llvm.adb @@ -460,7 +460,8 @@ package body Ortho_LLVM is procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is begin - -- LLVM type will be created when the type is declared. + -- LLVM type will be created when the type is declared, as the name + -- is required (for unification). Res := new O_Tnode_Type'(Kind => ON_Incomplete_Record_Type, LLVM => Null_TypeRef, Dbg => Null_ValueRef); @@ -608,7 +609,10 @@ package body Ortho_LLVM is Atype.Acc_Type := Dtype; -- Debug. - -- FIXME. + if Atype.Dbg /= Null_ValueRef then + pragma Assert (GetMDNodeNumOperands (Atype.Dbg) = 10); + MDNodeReplaceOperandWith (Atype.Dbg, 9, Dtype.Dbg); + end if; end Finish_Access_Type; -------------------- @@ -1719,13 +1723,12 @@ package body Ortho_LLVM is return MDNode (Vals, Vals'Length); end Add_Dbg_Enum_Type; - function Add_Dbg_Pointer_Type (Id : O_Ident; Ptype : O_Tnode) - return ValueRef + function Add_Dbg_Pointer_Type + (Id : O_Ident; Ptype : O_Tnode; Designated_Dbg : ValueRef) + return ValueRef is Vals : ValueRefArray (0 .. 9); begin - pragma Assert (Ptype.Acc_Type.Dbg /= Null_ValueRef); - Vals := (ConstInt (Int32Type, DW_TAG_Pointer_Type, 0), Dbg_Current_Filedir, Null_ValueRef, -- context @@ -1735,10 +1738,24 @@ package body Ortho_LLVM is Dbg_Align (Ptype.LLVM), ConstInt (Int32Type, 0, 0), -- Offset ConstInt (Int32Type, 1024, 0), -- Flags - Ptype.Acc_Type.Dbg); + Designated_Dbg); return MDNode (Vals, Vals'Length); end Add_Dbg_Pointer_Type; + function Add_Dbg_Pointer_Type (Id : O_Ident; Ptype : O_Tnode) + return ValueRef is + begin + pragma Assert (Ptype.Acc_Type /= null); + pragma Assert (Ptype.Acc_Type.Dbg /= Null_ValueRef); + return Add_Dbg_Pointer_Type (Id, Ptype, Ptype.Acc_Type.Dbg); + end Add_Dbg_Pointer_Type; + + function Add_Dbg_Incomplete_Pointer_Type (Id : O_Ident; Ptype : O_Tnode) + return ValueRef is + begin + return Add_Dbg_Pointer_Type (Id, Ptype, Null_ValueRef); + end Add_Dbg_Incomplete_Pointer_Type; + function Add_Dbg_Record_Type (Id : O_Ident; Rtype : O_Tnode) return ValueRef is @@ -1770,6 +1787,8 @@ package body Ortho_LLVM is procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) is begin + -- Create the incomplete structure. This is the only way in LLVM to + -- build recursive types. case Atype.Kind is when ON_Incomplete_Record_Type => Atype.LLVM := @@ -1781,7 +1800,7 @@ package body Ortho_LLVM is null; end case; - -- Emit debug info + -- Emit debug info. if Flag_Debug then case Atype.Kind is when ON_Unsigned_Type => @@ -1796,6 +1815,8 @@ package body Ortho_LLVM is Atype.Dbg := Add_Dbg_Enum_Type (Ident, Atype); when ON_Access_Type => Atype.Dbg := Add_Dbg_Pointer_Type (Ident, Atype); + when ON_Incomplete_Access_Type => + Atype.Dbg := Add_Dbg_Incomplete_Pointer_Type (Ident, Atype); when ON_Record_Type => Atype.Dbg := Add_Dbg_Record_Type (Ident, Atype); when ON_Incomplete_Record_Type => @@ -1804,9 +1825,6 @@ package body Ortho_LLVM is | ON_Array_Sub_Type => -- FIXME: typedef null; - when ON_Incomplete_Access_Type => - -- FIXME: todo - null; when ON_Union_Type => -- FIXME: todo null; @@ -2212,6 +2230,9 @@ package body Ortho_LLVM is MDNode (Subprg_Vals, Subprg_Vals'Length); Append (Subprg_Nodes, Cur_Declare_Block.Dbg_Scope); Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope; + + -- Kill current debug metadata, as it is not upto date. + Dbg_Insn_MD := Null_ValueRef; end; end if; @@ -2265,6 +2286,7 @@ package body Ortho_LLVM is Cur_Func := Null_ValueRef; Dbg_Current_Scope := Null_ValueRef; + Dbg_Insn_MD := Null_ValueRef; end Finish_Subprogram_Body; ------------------------- diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index 4ad2a99..a6ba4c9 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -1277,10 +1277,9 @@ package body Trans.Chap3 is ------------------------ -- Incomplete types -- ------------------------ + procedure Translate_Incomplete_Type (Def : Iir) is - -- Ftype : Iir; - -- Info : Type_Info_Acc; Info : Incomplete_Type_Info_Acc; Ctype : Iir; begin @@ -1290,6 +1289,8 @@ package body Trans.Chap3 is -- types not used before the full type declaration). return; end if; + + -- Get the complete type definition. Ctype := Get_Type (Get_Type_Declarator (Def)); Info := Add_Info (Ctype, Kind_Incomplete_Type); Info.Incomplete_Type := Def; @@ -1300,20 +1301,20 @@ package body Trans.Chap3 is procedure Translate_Complete_Type (Incomplete_Info : in out Incomplete_Type_Info_Acc; Ctype : Iir) is + C_Info : constant Type_Info_Acc := Get_Info (Ctype); List : Iir_List; Atype : Iir; Def_Info : Type_Info_Acc; - C_Info : Type_Info_Acc; Dtype : O_Tnode; begin - C_Info := Get_Info (Ctype); List := Get_Incomplete_Type_List (Incomplete_Info.Incomplete_Type); for I in Natural loop Atype := Get_Nth_Element (List, I); exit when Atype = Null_Iir; - if Get_Kind (Atype) /= Iir_Kind_Access_Type_Definition then - raise Internal_Error; - end if; + + -- Only access type can be completed. + pragma Assert (Get_Kind (Atype) = Iir_Kind_Access_Type_Definition); + Def_Info := Get_Info (Atype); case C_Info.Type_Mode is when Type_Mode_Arrays => |