import CmmUtils
import CmmCallConv
-import CgProf (curCCS, curCCSAddr)
-import CgUtils (cmmOffsetW)
-import CgInfoTbls (entryCode)
+import CgProf
+import CgUtils
+import CgInfoTbls
import SMRep
import ForeignCall
import Panic
-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 CPS
-
-- The format for the call to a continuation
-- The fst is the arguments that must be passed to the continuation
-- by the continuation's caller.
arguments = map formal_to_actual (continuation_formals cont_format)
in (new_next,
[BasicBlock new_next $
- pack_continuation False curr_format cont_format ++
+ pack_continuation curr_format cont_format ++
tail_call (curr_stack - cont_stack)
(CmmLit $ CmmLabel $ toCLabel next)
arguments])
tail_call curr_stack target arguments
-- A regular Cmm function call
- FinalCall next (CmmForeignCall target CmmCallConv)
- results arguments _ _ ->
- pack_continuation True curr_format cont_format ++
+ FinalCall next (CmmCallee target CmmCallConv)
+ results arguments _ _ _ ->
+ pack_continuation curr_format cont_format ++
tail_call (curr_stack - cont_stack)
target arguments
where
cont_stack = continuation_frame_size cont_format
-- A safe foreign call
- FinalCall next (CmmForeignCall target conv)
- results arguments _ _ ->
+ FinalCall next (CmmCallee target conv)
+ results arguments _ _ _ ->
target_stmts ++
- foreignCall call_uniques' (CmmForeignCall new_target conv)
+ foreignCall call_uniques' (CmmCallee new_target conv)
results arguments
where
(call_uniques', target_stmts, new_target) =
-- A safe prim call
FinalCall next (CmmPrim target)
- results arguments _ _ ->
+ results arguments _ _ _ ->
foreignCall call_uniques (CmmPrim target)
results arguments
arg_stmts ++
saveThreadState ++
caller_save ++
- [CmmCall (CmmForeignCall suspendThread CCallConv)
+ [CmmCall (CmmCallee suspendThread CCallConv)
[ (id,PtrHint) ]
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
- CmmUnsafe,
- CmmCall call results new_args CmmUnsafe,
- CmmCall (CmmForeignCall resumeThread CCallConv)
+ CmmUnsafe
+ CmmMayReturn,
+ CmmCall call results new_args CmmUnsafe CmmMayReturn,
+ CmmCall (CmmCallee resumeThread CCallConv)
[ (new_base, PtrHint) ]
[ (CmmReg (CmmLocal id), PtrHint) ]
- CmmUnsafe,
+ CmmUnsafe
+ CmmMayReturn,
-- Assign the result to BaseReg: we
-- might now have a different Capability!
CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++
gc_block]
-pack_continuation :: Bool -- ^ Whether to set the top/header
- -- of the stack. We only need to
- -- set it if we are calling down
- -- as opposed to continuation
- -- adaptors.
- -> ContinuationFormat -- ^ The current format
+pack_continuation :: ContinuationFormat -- ^ The current format
-> ContinuationFormat -- ^ The return point format
-> [CmmStmt]
-pack_continuation allow_header_set
- (ContinuationFormat _ curr_id curr_frame_size _)
- (ContinuationFormat _ cont_id cont_frame_size live_regs)
+pack_continuation (ContinuationFormat _ curr_id curr_frame_size _)
+ (ContinuationFormat _ cont_id cont_frame_size live_regs)
= pack_frame curr_frame_size cont_frame_size maybe_header continuation_args
where
continuation_args = map (maybe Nothing (Just . CmmReg . CmmLocal))
(Just x, Just y) -> x /= y
_ -> isJust cont_id
- maybe_header = if allow_header_set && needs_header_set
+ maybe_header = if needs_header_set
then maybe Nothing (Just . CmmLit . CmmLabel . entryLblToInfoLbl) cont_id
else Nothing