-performTailCall fun fun_amode lf_info arg_amodes pending_assts =
- nodeMustPointToIt lf_info `thenFC` \ node_points ->
- let
- -- assign to node if necessary
- node_asst
- | node_points = CAssign (CReg node) fun_amode
- | otherwise = AbsCNop
- in
-
- getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
-
- let
- -- set up for a let-no-escape if necessary
- join_sp = case fun_amode of
- CJoinPoint sp -> sp
- other -> args_sp
- in
-
- -- decide how to code the tail-call: which registers assignments to make,
- -- what args to push on the stack, and how to make the jump
- constructTailCall (idName fun) lf_info arg_amodes join_sp
- node_points fun_amode sequel
- `thenFC` \ (final_sp, arg_assts, jump_code) ->
-
- let sim_assts = mkAbstractCs [node_asst,
- pending_assts,
- arg_assts]
-
- is_lne = case fun_amode of { CJoinPoint _ -> True; _ -> False }
- in
-
- doFinalJump final_sp sim_assts is_lne (const jump_code)
-
-
--- Figure out how to do a particular tail-call.
-
-constructTailCall
- :: Name
- -> LambdaFormInfo
- -> [CAddrMode]
- -> VirtualSpOffset -- Sp at which to make the call
- -> Bool -- node points to the fun closure?
- -> CAddrMode -- addressing mode of the function
- -> Sequel -- the sequel, in case we need it
- -> FCode (
- VirtualSpOffset, -- Sp after pushing the args
- AbstractC, -- assignments
- Code -- code to do the jump
- )
-
-constructTailCall name lf_info arg_amodes sp node_points fun_amode sequel =
-
- getEntryConvention name lf_info (map getAmodeRep arg_amodes)
- `thenFC` \ entry_conv ->
-
- case entry_conv of
- EnterIt -> returnFC (sp, AbsCNop, code)
- where code = profCtrC FSLIT("TICK_ENT_VIA_NODE") [] `thenC`
- absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
- [CVal (nodeRel 0) DataPtrRep]))
-
- -- A function, but we have zero arguments. It is already in WHNF,
- -- so we can just return it.
- ReturnIt -> returnFC (sp, asst, code)
- where -- if node doesn't already point to the closure, we have to
- -- load it up.
- asst | node_points = AbsCNop
- | otherwise = CAssign (CReg node) fun_amode
-
- code = sequelToAmode sequel `thenFC` \ dest_amode ->
- absC (CReturn dest_amode DirectReturn)
-
- JumpToIt lbl -> returnFC (sp, AbsCNop, code)
- where code = absC (CJump (CLbl lbl CodePtrRep))
-
- -- a slow function call via the RTS apply routines
- SlowCall ->
- let (apply_fn, new_amodes) = constructSlowCall arg_amodes
-
- -- if node doesn't already point to the closure,
- -- we have to load it up.
- node_asst | node_points = AbsCNop
- | otherwise = CAssign (CReg node) fun_amode
- in
-
- -- Fill in all the arguments on the stack
- mkStkAmodes sp new_amodes `thenFC`
- \ (final_sp, stk_assts) ->
-
- returnFC
- (final_sp + 1, -- add one, because the stg_ap functions
- -- expect there to be a free slot on the stk
- mkAbstractCs [node_asst, stk_assts],
- absC (CJump apply_fn)
- )
-
- -- A direct function call (possibly with some left-over arguments)
- DirectEntry lbl arity regs
-
- -- A let-no-escape is slightly different, because we