--- this is just a special case of doTailCall, later.
-performReturn sim_assts finish_code
- = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
-
- -- Do the simultaneous assignments,
- doSimAssts sim_assts `thenC`
-
- -- push a return address if necessary
- -- (after the assignments above, in case we clobber a live
- -- stack location)
- pushReturnAddress eob `thenC`
-
- -- Adjust Sp/Hp
- adjustSpAndHp args_sp `thenC`
-
- -- Do the return
- finish_code sequel -- "sequel" is `robust' in that it doesn't
- -- depend on stk-ptr values
-\end{code}
-
-Returning unboxed tuples. This is mainly to support _ccall_GC_, where
-we want to do things in a slightly different order to normal:
-
- - push return address
- - adjust stack pointer
- - r = call(args...)
- - assign regs for unboxed tuple (usually just R1 = r)
- - return to continuation
-
-The return address (i.e. stack frame) must be on the stack before
-doing the call in case the call ends up in the garbage collector.
-
-Sadly, the information about the continuation is lost after we push it
-(in order to avoid pushing it again), so we end up doing a needless
-indirect jump (ToDo).
-
-\begin{code}
-returnUnboxedTuple :: [CAddrMode] -> Code -> Code
-returnUnboxedTuple amodes before_jump
- = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
-
- -- push a return address if necessary
- pushReturnAddress eob `thenC`
- setEndOfBlockInfo (EndOfBlockInfo args_sp (OnStack args_sp)) (
-
- -- Adjust Sp/Hp
- adjustSpAndHp args_sp `thenC`
-
- before_jump `thenC`
-
- let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
- in
-
- profCtrC SLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
-
- doTailCall amodes ret_regs
- mkUnboxedTupleReturnCode
- (length leftovers) {- fast args arity -}
- AbsCNop {-no pending assigments-}
- Nothing {-not a let-no-escape-}
- False {-node doesn't point-}
- )
-\end{code}
-
-\begin{code}
-performTailCall :: Id -- Function
- -> [StgArg] -- Args
- -> Code
-
-performTailCall fun args
- = -- Get all the info we have about the function and args and go on to
- -- the business end
- getCAddrModeAndInfo fun `thenFC` \ (fun_amode, lf_info) ->
- getArgAmodes args `thenFC` \ arg_amodes ->
-
- tailCallFun
- fun fun_amode lf_info arg_amodes
- AbsCNop {- No pending assignments -}
-
-
--- generating code for a tail call to a function (or closure)
-
-tailCallFun :: Id -> CAddrMode -- Function and its amode
- -> LambdaFormInfo -- Info about the function
- -> [CAddrMode] -- Arguments
-
- -> AbstractC -- Pending simultaneous assignments
- -- *** GUARANTEED to contain only stack
- -- assignments.
-
- -- In ptic, we don't need to look in
- -- here to discover all live regs
-
- -> Code
-
-tailCallFun fun fun_amode lf_info arg_amodes pending_assts
- = nodeMustPointToIt lf_info `thenFC` \ node_points ->
- getEntryConvention (idName fun) lf_info
- (map getAmodeRep arg_amodes) `thenFC` \ entry_conv ->
- let
- node_asst
- = if node_points then
- CAssign (CReg node) fun_amode
- else
- AbsCNop
-
- (arg_regs, finish_code, arity)
- = case entry_conv of
- ViaNode ->
- ([],
- profCtrC SLIT("TICK_ENT_VIA_NODE") [] `thenC`
- absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
- [CVal (nodeRel 0) DataPtrRep]))
- , 0)
- StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
- DirectEntry lbl arity regs ->
- (regs, absC (CJump (CLbl lbl CodePtrRep)),
- arity - length regs)
-
- -- set up for a let-no-escape if necessary
- join_sp = case fun_amode of
- CJoinPoint sp -> Just sp
- other -> Nothing
- in
- doTailCall arg_amodes arg_regs (const finish_code) arity
- (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
-
-
--- this generic tail call code is used for both function calls and returns.
-
-doTailCall
- :: [CAddrMode] -- args to pass to function
- -> [MagicId] -- registers to use
- -> (Sequel->Code) -- code to perform jump
- -> Int -- number of "fast" stack arguments
- -> AbstractC -- pending assignments
- -> Maybe VirtualSpOffset -- sp offset to trim stack to:
- -- USED iff destination is a let-no-escape
- -> Bool -- node points to the closure to enter
- -> Code
-
-doTailCall arg_amodes arg_regs finish_code arity pending_assts
- maybe_join_sp node_points
- = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
-
- let
- no_of_args = length arg_amodes