2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgTailCall.lhs,v 1.40 2004/09/30 10:35:50 simonpj Exp $
6 %********************************************************
8 \section[CgTailCall]{Tail calls: converting @StgApps@}
10 %********************************************************
14 cgTailCall, performTailCall,
15 performReturn, performPrimReturn,
16 emitKnownConReturnCode, emitAlgReturnCode,
17 returnUnboxedTuple, ccallReturnUnboxedTuple,
24 #include "HsVersions.h"
27 import CgBindery ( getArgAmodes, getCgIdInfo, CgIdInfo, maybeLetNoEscape,
28 idInfoToAmode, cgIdInfoId, cgIdInfoLF,
30 import CgInfoTbls ( entryCode, emitDirectReturnInstr, dataConTagZ,
31 emitVectoredReturnInstr, closureInfoPtr )
33 import CgStackery ( setRealSp, mkStkAmodes, adjustStackHW,
35 import CgHeapery ( setRealHp, getHpRelOffset )
36 import CgUtils ( emitSimultaneously )
39 import SMRep ( CgRep, isVoidArg, separateByPtrFollowness )
42 import CLabel ( CLabel, mkRtsPrimOpLabel, mkSeqInfoLabel )
43 import Type ( isUnLiftedType )
44 import Id ( Id, idName, idUnique, idType )
45 import DataCon ( DataCon, dataConTyCon )
46 import StgSyn ( StgArg )
47 import TyCon ( TyCon )
48 import PrimOp ( PrimOp )
53 -----------------------------------------------------------------------------
56 cgTailCall :: Id -> [StgArg] -> Code
58 -- Here's the code we generate for a tail call. (NB there may be no
59 -- arguments, in which case this boils down to just entering a variable.)
61 -- * Put args in the top locations of the stack.
62 -- * Adjust the stack ptr
63 -- * Make R1 point to the function closure if necessary.
64 -- * Perform the call.
66 -- Things to be careful about:
68 -- * Don't overwrite stack locations before you have finished with
69 -- them (remember you need the function and the as-yet-unmoved
71 -- * Preferably, generate no code to replace x by x on the stack (a
72 -- common situation in tail-recursion).
73 -- * Adjust the stack high water mark appropriately.
75 -- Treat unboxed locals exactly like literals (above) except use the addr
76 -- mode for the local instead of (CLit lit) in the assignment.
79 = do { fun_info <- getCgIdInfo fun
81 ; if isUnLiftedType (idType fun)
82 then -- Primitive return
84 do { fun_amode <- idInfoToAmode fun_info
85 ; performPrimReturn (cgIdInfoArgRep fun_info) fun_amode }
87 else -- Normal case, fun is boxed
88 do { arg_amodes <- getArgAmodes args
89 ; performTailCall fun_info arg_amodes noStmts }
93 -- -----------------------------------------------------------------------------
94 -- The guts of a tail-call
97 :: CgIdInfo -- The function
98 -> [(CgRep,CmmExpr)] -- Args
99 -> CmmStmts -- Pending simultaneous assignments
100 -- *** GUARANTEED to contain only stack assignments.
103 performTailCall fun_info arg_amodes pending_assts
104 | Just join_sp <- maybeLetNoEscape fun_info
105 = -- A let-no-escape is slightly different, because we
106 -- arrange the stack arguments into pointers and non-pointers
107 -- to make the heap check easier. The tail-call sequence
108 -- is very similar to returning an unboxed tuple, so we
110 do { (final_sp, arg_assts) <- pushUnboxedTuple join_sp arg_amodes
111 ; emitSimultaneously (pending_assts `plusStmts` arg_assts)
112 ; let lbl = enterReturnPtLabel (idUnique (cgIdInfoId fun_info))
113 ; doFinalJump final_sp True {- Is LNE -} (jumpToLbl lbl) }
116 = do { fun_amode <- idInfoToAmode fun_info
117 ; let node_asst = oneStmt (CmmAssign nodeReg fun_amode)
118 opt_node_asst | nodeMustPointToIt lf_info = node_asst
119 | otherwise = noStmts
120 ; EndOfBlockInfo sp _ <- getEndOfBlockInfo
122 ; case (getCallMethod fun_name lf_info (length arg_amodes)) of
124 -- Node must always point to things we enter
126 { emitSimultaneously (node_asst `plusStmts` pending_assts)
127 ; let target = entryCode (closureInfoPtr (CmmReg nodeReg))
128 ; doFinalJump sp False (stmtC (CmmJump target [])) }
130 -- A function, but we have zero arguments. It is already in WHNF,
131 -- so we can just return it.
132 -- As with any return, Node must point to it.
134 { emitSimultaneously (node_asst `plusStmts` pending_assts)
135 ; doFinalJump sp False emitDirectReturnInstr }
137 -- A real constructor. Don't bother entering it,
138 -- just do the right sort of return instead.
139 -- As with any return, Node must point to it.
141 { emitSimultaneously (node_asst `plusStmts` pending_assts)
142 ; doFinalJump sp False (emitKnownConReturnCode con) }
145 { emitSimultaneously (opt_node_asst `plusStmts` pending_assts)
146 ; doFinalJump sp False (jumpToLbl lbl) }
148 -- A slow function call via the RTS apply routines
149 -- Node must definitely point to the thing
151 { let (apply_lbl, new_amodes) = constructSlowCall arg_amodes
153 -- Fill in all the arguments on the stack
154 ; (final_sp,stk_assts) <- mkStkAmodes sp new_amodes
156 ; emitSimultaneously (node_asst `plusStmts` stk_assts
157 `plusStmts` pending_assts)
159 ; when (not (null arg_amodes)) $ do
160 { if (isKnownFun lf_info)
161 then tickyKnownCallTooFewArgs
162 else tickyUnknownCall
163 ; tickySlowCallPat (map fst arg_amodes)
166 ; doFinalJump (final_sp + 1)
167 -- Add one, because the stg_ap functions
168 -- expect there to be a free slot on the stk
169 False (jumpToLbl apply_lbl)
172 -- A direct function call (possibly with some left-over arguments)
173 DirectEntry lbl arity -> do
175 -- The args beyond the arity go straight on the stack
176 (arity_args, extra_stk_args) = splitAt arity arg_amodes
178 -- First chunk of args go in registers
179 (reg_arg_amodes, stk_args) = assignCallRegs arity_args
181 -- Any "extra" arguments are placed in frames on the
182 -- stack after the other arguments.
183 slow_stk_args = slowArgs extra_stk_args
185 reg_assts = assignToRegs reg_arg_amodes
187 ; if null slow_stk_args
188 then tickyKnownCallExact
189 else do tickyKnownCallExtraArgs
190 tickySlowCallPat (map fst extra_stk_args)
192 ; (final_sp, stk_assts) <- mkStkAmodes sp
193 (stk_args ++ slow_stk_args)
195 ; emitSimultaneously (opt_node_asst `plusStmts`
196 reg_assts `plusStmts`
197 stk_assts `plusStmts`
200 ; doFinalJump final_sp False (jumpToLbl lbl) }
203 fun_name = idName (cgIdInfoId fun_info)
204 lf_info = cgIdInfoLF fun_info
208 -- -----------------------------------------------------------------------------
209 -- The final clean-up before we do a jump at the end of a basic block.
210 -- This code is shared by tail-calls and returns.
212 doFinalJump :: VirtualSpOffset -> Bool -> Code -> Code
213 doFinalJump final_sp is_let_no_escape jump_code
214 = do { -- Adjust the high-water mark if necessary
215 adjustStackHW final_sp
217 -- Push a return address if necessary (after the assignments
218 -- above, in case we clobber a live stack location)
220 -- DONT push the return address when we're about to jump to a
221 -- let-no-escape: the final tail call in the let-no-escape
223 ; eob <- getEndOfBlockInfo
224 ; whenC (not is_let_no_escape) (pushReturnAddress eob)
226 -- Final adjustment of Sp/Hp
227 ; adjustSpAndHp final_sp
232 -- -----------------------------------------------------------------------------
233 -- A general return (just a special case of doFinalJump, above)
235 performReturn :: Code -- The code to execute to actually do the return
238 performReturn finish_code
239 = do { EndOfBlockInfo args_sp sequel <- getEndOfBlockInfo
240 ; doFinalJump args_sp False{-not a LNE-} finish_code }
242 -- -----------------------------------------------------------------------------
244 -- Just load the return value into the right register, and return.
246 performPrimReturn :: CgRep -> CmmExpr -- The thing to return
248 performPrimReturn rep amode
249 = do { whenC (not (isVoidArg rep))
250 (stmtC (CmmAssign ret_reg amode))
251 ; performReturn emitDirectReturnInstr }
253 ret_reg = dataReturnConvPrim rep
255 -- -----------------------------------------------------------------------------
256 -- Algebraic constructor returns
258 -- Constructor is built on the heap; Node is set.
259 -- All that remains is to do the right sort of jump.
261 emitKnownConReturnCode :: DataCon -> Code
262 emitKnownConReturnCode con
263 = emitAlgReturnCode (dataConTyCon con)
264 (CmmLit (mkIntCLit (dataConTagZ con)))
265 -- emitAlgReturnCode requires zero-indexed tag
267 emitAlgReturnCode :: TyCon -> CmmExpr -> Code
268 -- emitAlgReturnCode is used both by emitKnownConReturnCode,
269 -- and by by PrimOps that return enumerated types (i.e.
270 -- all the comparison operators).
271 emitAlgReturnCode tycon tag
272 = do { case ctrlReturnConvAlg tycon of
273 VectoredReturn fam_sz -> do { tickyVectoredReturn fam_sz
274 ; emitVectoredReturnInstr tag }
275 UnvectoredReturn _ -> emitDirectReturnInstr
279 -- ---------------------------------------------------------------------------
280 -- Unboxed tuple returns
282 -- These are a bit like a normal tail call, except that:
284 -- - The tail-call target is an info table on the stack
286 -- - We separate stack arguments into pointers and non-pointers,
287 -- to make it easier to leave things in a sane state for a heap check.
288 -- This is OK because we can never partially-apply an unboxed tuple,
289 -- unlike a function. The same technique is used when calling
290 -- let-no-escape functions, because they also can't be partially
293 returnUnboxedTuple :: [(CgRep, CmmExpr)] -> Code
294 returnUnboxedTuple amodes
295 = do { eob@(EndOfBlockInfo args_sp sequel) <- getEndOfBlockInfo
296 ; tickyUnboxedTupleReturn (length amodes)
297 ; (final_sp, assts) <- pushUnboxedTuple args_sp amodes
298 ; emitSimultaneously assts
299 ; doFinalJump final_sp False{-not a LNE-} emitDirectReturnInstr }
301 pushUnboxedTuple :: VirtualSpOffset -- Sp at which to start pushing
302 -> [(CgRep, CmmExpr)] -- amodes of the components
303 -> FCode (VirtualSpOffset, -- final Sp
304 CmmStmts) -- assignments (regs+stack)
306 pushUnboxedTuple sp []
307 = return (sp, noStmts)
308 pushUnboxedTuple sp amodes
309 = do { let (reg_arg_amodes, stk_arg_amodes) = assignReturnRegs amodes
311 -- separate the rest of the args into pointers and non-pointers
312 (ptr_args, nptr_args) = separateByPtrFollowness stk_arg_amodes
313 reg_arg_assts = assignToRegs reg_arg_amodes
315 -- push ptrs, then nonptrs, on the stack
316 ; (ptr_sp, ptr_assts) <- mkStkAmodes sp ptr_args
317 ; (final_sp, nptr_assts) <- mkStkAmodes ptr_sp nptr_args
319 ; returnFC (final_sp,
320 reg_arg_assts `plusStmts`
321 ptr_assts `plusStmts` nptr_assts) }
324 -- -----------------------------------------------------------------------------
325 -- Returning unboxed tuples. This is mainly to support _ccall_GC_, where
326 -- we want to do things in a slightly different order to normal:
328 -- - push return address
329 -- - adjust stack pointer
330 -- - r = call(args...)
331 -- - assign regs for unboxed tuple (usually just R1 = r)
332 -- - return to continuation
334 -- The return address (i.e. stack frame) must be on the stack before
335 -- doing the call in case the call ends up in the garbage collector.
337 -- Sadly, the information about the continuation is lost after we push it
338 -- (in order to avoid pushing it again), so we end up doing a needless
339 -- indirect jump (ToDo).
341 ccallReturnUnboxedTuple :: [(CgRep, CmmExpr)] -> Code -> Code
342 ccallReturnUnboxedTuple amodes before_jump
343 = do { eob@(EndOfBlockInfo args_sp _) <- getEndOfBlockInfo
345 -- Push a return address if necessary
346 ; pushReturnAddress eob
347 ; setEndOfBlockInfo (EndOfBlockInfo args_sp OnStack)
348 (do { adjustSpAndHp args_sp
350 ; returnUnboxedTuple amodes })
353 -- -----------------------------------------------------------------------------
354 -- Calling an out-of-line primop
356 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
357 tailCallPrimOp op args
358 = do { -- We're going to perform a normal-looking tail call,
359 -- except that *all* the arguments will be in registers.
360 -- Hence the ASSERT( null leftovers )
361 arg_amodes <- getArgAmodes args
362 ; let (arg_regs, leftovers) = assignPrimOpCallRegs arg_amodes
363 jump_to_primop = jumpToLbl (mkRtsPrimOpLabel op)
365 ; ASSERT(null leftovers) -- no stack-resident args
366 emitSimultaneously (assignToRegs arg_regs)
368 ; EndOfBlockInfo args_sp _ <- getEndOfBlockInfo
369 ; doFinalJump args_sp False{-not a LNE-} jump_to_primop }
371 -- -----------------------------------------------------------------------------
374 -- | We always push the return address just before performing a tail call
375 -- or return. The reason we leave it until then is because the stack
376 -- slot that the return address is to go into might contain something
379 -- If the end of block info is 'CaseAlts', then we're in the scrutinee of a
380 -- case expression and the return address is still to be pushed.
382 -- There are cases where it doesn't look necessary to push the return
383 -- address: for example, just before doing a return to a known
384 -- continuation. However, the continuation will expect to find the
385 -- return address on the stack in case it needs to do a heap check.
387 pushReturnAddress :: EndOfBlockInfo -> Code
389 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _ False))
390 = do { sp_rel <- getSpRelOffset args_sp
391 ; stmtC (CmmStore sp_rel (mkLblExpr lbl)) }
393 -- For a polymorphic case, we have two return addresses to push: the case
394 -- return, and stg_seq_frame_info which turns a possible vectored return
395 -- into a direct one.
396 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _ True))
397 = do { sp_rel <- getSpRelOffset (args_sp-1)
398 ; stmtC (CmmStore sp_rel (mkLblExpr lbl))
399 ; sp_rel <- getSpRelOffset args_sp
400 ; stmtC (CmmStore sp_rel (CmmLit (CmmLabel mkSeqInfoLabel))) }
402 pushReturnAddress _ = nopC
404 -- -----------------------------------------------------------------------------
407 jumpToLbl :: CLabel -> Code
408 -- Passes no argument to the destination procedure
409 jumpToLbl lbl = stmtC (CmmJump (CmmLit (CmmLabel lbl)) [{- No args -}])
411 assignToRegs :: [(CmmExpr, GlobalReg)] -> CmmStmts
412 assignToRegs reg_args
413 = mkStmts [ CmmAssign (CmmGlobal reg_id) expr
414 | (expr, reg_id) <- reg_args ]
418 %************************************************************************
420 \subsection[CgStackery-adjust]{Adjusting the stack pointers}
422 %************************************************************************
424 This function adjusts the stack and heap pointers just before a tail
425 call or return. The stack pointer is adjusted to its final position
426 (i.e. to point to the last argument for a tail call, or the activation
427 record for a return). The heap pointer may be moved backwards, in
428 cases where we overallocated at the beginning of the basic block (see
429 CgCase.lhs for discussion).
431 These functions {\em do not} deal with high-water-mark adjustment.
432 That's done by functions which allocate stack space.
435 adjustSpAndHp :: VirtualSpOffset -- New offset for Arg stack ptr
437 adjustSpAndHp newRealSp
438 = do { -- Adjust stack, if necessary.
439 -- NB: the conditional on the monad-carried realSp
440 -- is out of line (via codeOnly), to avoid a black hole
441 ; new_sp <- getSpRelOffset newRealSp
442 ; checkedAbsC (CmmAssign spReg new_sp) -- Will generate no code in the case
443 ; setRealSp newRealSp -- where realSp==newRealSp
445 -- Adjust heap. The virtual heap pointer may be less than the real Hp
446 -- because the latter was advanced to deal with the worst-case branch
447 -- of the code, and we may be in a better-case branch. In that case,
448 -- move the real Hp *back* and retract some ticky allocation count.
449 ; hp_usg <- getHpUsage
450 ; let rHp = realHp hp_usg
452 ; new_hp <- getHpRelOffset vHp
453 ; checkedAbsC (CmmAssign hpReg new_hp) -- Generates nothing when vHp==rHp
454 ; tickyAllocHeap (vHp - rHp) -- ...ditto