diff options
Diffstat (limited to 'src/ortho/llvm4-nodebug/ortho_llvm.adb')
| -rw-r--r-- | src/ortho/llvm4-nodebug/ortho_llvm.adb | 66 |
1 files changed, 52 insertions, 14 deletions
diff --git a/src/ortho/llvm4-nodebug/ortho_llvm.adb b/src/ortho/llvm4-nodebug/ortho_llvm.adb index 4e02a908a..2f0edca3c 100644 --- a/src/ortho/llvm4-nodebug/ortho_llvm.adb +++ b/src/ortho/llvm4-nodebug/ortho_llvm.adb @@ -782,22 +782,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; @@ -811,6 +810,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 -- ------------------- @@ -1177,6 +1194,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 -- ------------------------ @@ -1367,12 +1406,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 @@ -1725,7 +1760,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); @@ -1758,6 +1794,8 @@ package body Ortho_LLVM is Destroy_Declare_Block; Cur_Func := Null_ValueRef; + + Unreach := False; end Finish_Subprogram_Body; ------------------------- |