X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgForeignCall.hs;h=ce272e9a86e8c94b9265fc2295ea3f7e92c2ca22;hb=474b582b68ea9289f3da4355da816164138604b0;hp=b2ca5b166a540c850604dc22b153f22afcced077;hpb=affbe8dae5d7eb350686b42ddbd4f3561b7bd0ec;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index b2ca5b1..ce272e9 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -37,12 +37,6 @@ import Constants import StaticFlags import Outputable -import MachRegs (callerSaveVolatileRegs) - -- HACK: this is part of the NCG so we shouldn't use this, but we need - -- it for now to eliminate the need for saved regs to be in CmmCall. - -- The long term solution is to factor callerSaveVolatileRegs - -- from nativeGen into codeGen - import Control.Monad -- ----------------------------------------------------------------------------- @@ -116,7 +110,7 @@ emitForeignCall' safety results target args vols srt temp_args <- load_args_into_temps args let (caller_save, caller_load) = callerSaveVolatileRegs vols stmtsC caller_save - stmtC (CmmCall target results temp_args srt) + stmtC (CmmCall target results temp_args CmmUnsafe) stmtsC caller_load | otherwise = do @@ -129,17 +123,20 @@ emitForeignCall' safety results target args vols srt let (caller_save, caller_load) = callerSaveVolatileRegs vols emitSaveThreadState stmtsC caller_save - -- Using the same SRT for each of these is a little bit conservative - -- but it should work for now. + -- The CmmUnsafe arguments are only correct because this part + -- of the code hasn't been moved into the CPS pass yet. + -- Once that happens, this function will just emit a (CmmSafe srt) call, + -- and the CPS will will be the one to convert that + -- to this sequence of three CmmUnsafe calls. stmtC (CmmCall (CmmForeignCall suspendThread CCallConv) [ (id,PtrHint) ] [ (CmmReg (CmmGlobal BaseReg), PtrHint) ] - srt) - stmtC (CmmCall temp_target results temp_args srt) + CmmUnsafe) + stmtC (CmmCall temp_target results temp_args CmmUnsafe) stmtC (CmmCall (CmmForeignCall resumeThread CCallConv) [ (new_base, PtrHint) ] [ (CmmReg (CmmLocal id), PtrHint) ] - srt) + CmmUnsafe) -- Assign the result to BaseReg: we -- might now have a different Capability! stmtC (CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)))