X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FMkZipCfgCmm.hs;h=46f0659e1ae3d865e705aca96ccdbdefb3aaf6ce;hp=4eabffb208272989b2b906004f05b3531cb6a69b;hb=f1a90f54590e5a7a32a9c3ef2950740922b1f425;hpb=5dd61c6680eb9c2091048cacbfa53ab9e55ddcb6 diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs index 4eabffb..46f0659 100644 --- a/compiler/cmm/MkZipCfgCmm.hs +++ b/compiler/cmm/MkZipCfgCmm.hs @@ -35,7 +35,6 @@ import PprCmm() import FastString import ForeignCall import MkZipCfg -import Outputable import Panic import SMRep (ByteOff) import StaticFlags @@ -65,7 +64,7 @@ mkCall :: CmmExpr -> (Convention, Convention) -> CmmFormals -> CmmActuals mkCmmCall :: CmmExpr -> CmmFormals -> CmmActuals -> UpdFrameOffset -> CmmAGraph -- Native C-- calling convention -mkSafeCall :: MidCallTarget -> CmmFormals -> CmmActuals -> UpdFrameOffset -> CmmAGraph +mkSafeCall :: MidCallTarget -> CmmFormals -> CmmActuals -> UpdFrameOffset -> Bool -> CmmAGraph mkUnsafeCall :: MidCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> UpdFrameOffset -> CmmAGraph -- Never returns; like exit() or barf() @@ -132,9 +131,9 @@ mkAssign l r = if opt_StubDeadValues then assign l r <*> check l else assign l r mkCbranch pred ifso ifnot = mkLast (LastCondBranch pred ifso ifnot) mkSwitch e tbl = mkLast $ LastSwitch e tbl -mkSafeCall t fs as upd = +mkSafeCall t fs as upd interruptible = withFreshLabel "safe call" $ \k -> - mkMiddle $ MidForeignCall (Safe k upd) t fs as + mkMiddle $ MidForeignCall (Safe k upd interruptible) t fs as mkUnsafeCall t fs as = mkMiddle $ MidForeignCall Unsafe t fs as -- For debugging purposes, we can stub out dead stack slots: @@ -262,8 +261,6 @@ mkCmmCall f results actuals = mkCall f (NativeDirectCall, NativeReturn) results -- I'm dropping the SRT, but that should be okay: we plan to reconstruct it later. mkCall f (callConv, retConv) results actuals updfr_off = - pprTrace "mkCall" (ppr f <+> ppr actuals <+> ppr results <+> ppr callConv <+> - ppr retConv) $ withFreshLabel "call successor" $ \k -> let area = CallArea $ Young k (off, copyin) = copyInOflow retConv area results