diff options
Diffstat (limited to 'src/ortho/llvm/ortho_llvm.adb')
-rw-r--r-- | src/ortho/llvm/ortho_llvm.adb | 67 |
1 files changed, 53 insertions, 14 deletions
diff --git a/src/ortho/llvm/ortho_llvm.adb b/src/ortho/llvm/ortho_llvm.adb index d5e172532..250870224 100644 --- a/src/ortho/llvm/ortho_llvm.adb +++ b/src/ortho/llvm/ortho_llvm.adb @@ -1115,22 +1115,21 @@ package body Ortho_LLVM is -- New_Global_Address -- ------------------------ - function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) + function New_Global_Address (Lvalue : O_Gnode; Atype : O_Tnode) return O_Cnode is begin - return O_Cnode'(LLVM => ConstBitCast (Decl.LLVM, Get_LLVM_Type (Atype)), - Ctype => Atype); + return New_Global_Unchecked_Address (Lvalue, Atype); end New_Global_Address; ---------------------------------- -- New_Global_Unchecked_Address -- ---------------------------------- - function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) - return O_Cnode - is + function New_Global_Unchecked_Address (Lvalue : O_Gnode; Atype : O_Tnode) + return O_Cnode is begin - return O_Cnode'(LLVM => ConstBitCast (Decl.LLVM, Get_LLVM_Type (Atype)), + return O_Cnode'(LLVM => ConstBitCast (Lvalue.LLVM, + Get_LLVM_Type (Atype)), Ctype => Atype); end New_Global_Unchecked_Address; @@ -1144,6 +1143,24 @@ package body Ortho_LLVM is Etype => Lit.Ctype); end New_Lit; + ---------------- + -- New_Global -- + ---------------- + + function New_Global (Decl : O_Dnode) return O_Gnode is + begin + -- Can be used to build global objects, even when Unreach is set. + -- As this doesn't generate code, this is ok. + case Decl.Kind is + when ON_Const_Decl + | ON_Var_Decl => + return O_Gnode'(LLVM => Decl.LLVM, + Ltype => Decl.Dtype); + when others => + raise Program_Error; + end case; + end New_Global; + ------------------- -- New_Dyadic_Op -- ------------------- @@ -1517,6 +1534,28 @@ package body Ortho_LLVM is return O_Lnode'(Direct => False, LLVM => Res, Ltype => El.Ftype); end New_Selected_Element; + function New_Global_Selected_Element (Rec : O_Gnode; El : O_Fnode) + return O_Gnode + is + Res : ValueRef; + begin + case El.Kind is + when OF_Record => + declare + Idx : constant ValueRefArray (1 .. 2) := + (ConstInt (Int32Type, 0, 0), + ConstInt (Int32Type, Unsigned_64 (El.Index), 0)); + begin + Res := ConstGEP (Rec.LLVM, Idx, 2); + end; + when OF_Union => + Res := ConstBitCast (Rec.LLVM, El.Ptr_Type); + when OF_None => + raise Program_Error; + end case; + return O_Gnode'(LLVM => Res, Ltype => El.Ftype); + end New_Global_Selected_Element; + ------------------------ -- New_Access_Element -- ------------------------ @@ -1708,12 +1747,8 @@ package body Ortho_LLVM is function New_Obj (Obj : O_Dnode) return O_Lnode is begin - if Unreach then - return O_Lnode'(Direct => False, - LLVM => Null_ValueRef, - Ltype => Obj.Dtype); - end if; - + -- Can be used to build global objects, even when Unreach is set. + -- As this doesn't generate code, this is ok. case Obj.Kind is when ON_Const_Decl | ON_Var_Decl @@ -2257,7 +2292,8 @@ package body Ortho_LLVM is Cur_Func := Func.LLVM; Cur_Func_Decl := Func; - Unreach := False; + + pragma Assert (not Unreach); Decl_BB := AppendBasicBlock (Cur_Func, Empty_Cstring); PositionBuilderAtEnd (Decl_Builder, Decl_BB); @@ -2399,6 +2435,9 @@ package body Ortho_LLVM is Destroy_Declare_Block; Cur_Func := Null_ValueRef; + + Unreach := False; + Dbg_Current_Scope := Null_ValueRef; Dbg_Insn_MD := Null_ValueRef; end Finish_Subprogram_Body; |