2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgTailCall.lhs,v 1.26 2000/07/14 08:14:53 simonpj Exp $
6 %********************************************************
8 \section[CgTailCall]{Tail calls: converting @StgApps@}
10 %********************************************************
15 performReturn, performPrimReturn,
16 mkStaticAlgReturnCode, mkDynamicAlgReturnCode,
17 mkUnboxedTupleReturnCode, returnUnboxedTuple,
27 #include "HsVersions.h"
31 import PprAbsC ( pprAmode )
33 import AbsCUtils ( mkAbstractCs, getAmodeRep )
34 import CgBindery ( getArgAmodes, getCAddrMode, getCAddrModeAndInfo )
35 import CgRetConv ( dataReturnConvPrim,
36 ctrlReturnConvAlg, CtrlReturnConvention(..),
37 assignAllRegs, assignRegs
39 import CgStackery ( mkTaggedStkAmodes, adjustStackHW )
40 import CgUsages ( getSpRelOffset, adjustSpAndHp )
41 import CgUpdate ( pushSeqFrame )
42 import CLabel ( mkUpdInfoLabel, mkRtsPrimOpLabel,
43 mkBlackHoleInfoTableLabel )
44 import ClosureInfo ( nodeMustPointToIt,
45 getEntryConvention, EntryConvention(..),
48 import CmdLineOpts ( opt_DoSemiTagging )
49 import Id ( Id, idType, idName )
50 import DataCon ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
51 import Maybes ( assocMaybe, maybeToBool )
52 import PrimRep ( PrimRep(..) )
53 import StgSyn ( StgArg, GenStgArg(..) )
54 import Type ( isUnLiftedType )
55 import TyCon ( TyCon )
56 import PrimOp ( PrimOp )
57 import Util ( zipWithEqual )
58 import Unique ( mkPseudoUnique1 )
60 import Panic ( panic, assertPanic )
63 %************************************************************************
65 \subsection[tailcall-doc]{Documentation}
67 %************************************************************************
70 cgTailCall :: Id -> [StgArg] -> Code
73 Here's the code we generate for a tail call. (NB there may be no
74 arguments, in which case this boils down to just entering a variable.)
77 \item Adjust the stack ptr to \tr{tailSp + #args}.
78 \item Put args in the top locations of the resulting stack.
79 \item Make Node point to the function closure.
80 \item Enter the function closure.
83 Things to be careful about:
85 \item Don't overwrite stack locations before you have finished with
86 them (remember you need the function and the as-yet-unmoved
88 \item Preferably, generate no code to replace x by x on the stack (a
89 common situation in tail-recursion).
90 \item Adjust the stack high water mark appropriately.
93 Treat unboxed locals exactly like literals (above) except use the addr
94 mode for the local instead of (CLit lit) in the assignment.
96 Case for unboxed @Ids@ first:
99 | isUnLiftedType (idType fun)
100 = getCAddrMode fun `thenFC` \ amode ->
101 performPrimReturn (ppr fun) amode
104 The general case (@fun@ is boxed):
106 cgTailCall fun args = performTailCall fun args
109 %************************************************************************
111 \subsection[return-and-tail-call]{Return and tail call}
113 %************************************************************************
116 performPrimReturn :: SDoc -- Just for debugging (sigh)
117 -> CAddrMode -- The thing to return
120 performPrimReturn doc amode
122 kind = getAmodeRep amode
123 ret_reg = WARN( case kind of { PtrRep -> True; other -> False }, text "primRet" <+> doc <+> pprAmode amode )
124 dataReturnConvPrim kind
126 assign_possibly = case kind of
128 kind -> (CAssign (CReg ret_reg) amode)
130 performReturn assign_possibly (mkPrimReturnCode doc)
132 mkPrimReturnCode :: SDoc -- Debugging only
135 mkPrimReturnCode doc UpdateCode = pprPanic "mkPrimReturnCode: Upd" doc
136 mkPrimReturnCode doc sequel = sequelToAmode sequel `thenFC` \ dest_amode ->
137 absC (CReturn dest_amode DirectReturn)
138 -- Direct, no vectoring
140 -- Constructor is built on the heap; Node is set.
141 -- All that remains is
142 -- (a) to set TagReg, if necessary
143 -- (c) to do the right sort of jump.
145 mkStaticAlgReturnCode :: DataCon -- The constructor
146 -> Sequel -- where to return to
149 mkStaticAlgReturnCode con sequel
150 = -- Generate profiling code if necessary
151 (case return_convention of
152 VectoredReturn sz -> profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz]
156 -- Set tag if necessary
157 -- This is done by a macro, because if we are short of registers
158 -- we don't set TagReg; instead the continuation gets the tag
159 -- by indexing off the info ptr
160 (case return_convention of
162 UnvectoredReturn no_of_constrs
164 -> absC (CMacroStmt SET_TAG [mkIntCLit zero_indexed_tag])
169 -- Generate the right jump or return
171 UpdateCode -> -- Ha! We can go direct to the update code,
172 -- (making sure to jump to the *correct* update
174 absC (CReturn (CLbl mkUpdInfoLabel CodePtrRep)
177 CaseAlts _ (Just (alts, _)) -> -- Ho! We know the constructor so
178 -- we can go right to the alternative
180 case assocMaybe alts tag of
181 Just (alt_absC, join_lbl) ->
182 absC (CJump (CLbl join_lbl CodePtrRep))
183 Nothing -> panic "mkStaticAlgReturnCode: default"
184 -- The Nothing case should never happen;
185 -- it's the subject of a wad of special-case
186 -- code in cgReturnCon
188 -- can't be a SeqFrame, because we're returning a constructor
190 other -> -- OnStack, or (CaseAlts ret_amode Nothing)
191 sequelToAmode sequel `thenFC` \ ret_amode ->
192 absC (CReturn ret_amode return_info)
197 tycon = dataConTyCon con
198 return_convention = ctrlReturnConvAlg tycon
199 zero_indexed_tag = tag - fIRST_TAG -- Adjust tag to be zero-indexed
200 -- cf AbsCUtils.mkAlgAltsCSwitch
203 case return_convention of
204 UnvectoredReturn _ -> DirectReturn
205 VectoredReturn _ -> StaticVectoredReturn zero_indexed_tag
207 mkUnboxedTupleReturnCode :: Sequel -> Code
208 mkUnboxedTupleReturnCode sequel
210 -- can't update with an unboxed tuple!
211 UpdateCode -> panic "mkUnboxedTupleReturnCode"
213 CaseAlts _ (Just ([(_,(alt_absC,join_lbl))], _)) ->
214 absC (CJump (CLbl join_lbl CodePtrRep))
216 -- can't be a SeqFrame
218 other -> -- OnStack, or (CaseAlts ret_amode something)
219 sequelToAmode sequel `thenFC` \ ret_amode ->
220 absC (CReturn ret_amode DirectReturn)
222 -- This function is used by PrimOps that return enumerated types (i.e.
223 -- all the comparison operators).
225 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
227 mkDynamicAlgReturnCode tycon dyn_tag sequel
228 = case ctrlReturnConvAlg tycon of
231 profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
232 sequelToAmode sequel `thenFC` \ ret_addr ->
233 absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
235 UnvectoredReturn no_of_constrs ->
237 -- Set tag if necessary
238 -- This is done by a macro, because if we are short of registers
239 -- we don't set TagReg; instead the continuation gets the tag
240 -- by indexing off the info ptr
241 (if no_of_constrs > 1 then
242 absC (CMacroStmt SET_TAG [dyn_tag])
248 sequelToAmode sequel `thenFC` \ ret_addr ->
249 -- Generate the right jump or return
250 absC (CReturn ret_addr DirectReturn)
254 performReturn :: AbstractC -- Simultaneous assignments to perform
255 -> (Sequel -> Code) -- The code to execute to actually do
256 -- the return, given an addressing mode
257 -- for the return address
260 -- this is just a special case of doTailCall, later.
261 performReturn sim_assts finish_code
262 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
264 -- Do the simultaneous assignments,
265 doSimAssts sim_assts `thenC`
267 -- push a return address if necessary
268 -- (after the assignments above, in case we clobber a live
270 pushReturnAddress eob `thenC`
273 adjustSpAndHp args_sp `thenC`
276 finish_code sequel -- "sequel" is `robust' in that it doesn't
277 -- depend on stk-ptr values
280 Returning unboxed tuples. This is mainly to support _ccall_GC_, where
281 we want to do things in a slightly different order to normal:
283 - push return address
284 - adjust stack pointer
286 - assign regs for unboxed tuple (usually just R1 = r)
287 - return to continuation
289 The return address (i.e. stack frame) must be on the stack before
290 doing the call in case the call ends up in the garbage collector.
292 Sadly, the information about the continuation is lost after we push it
293 (in order to avoid pushing it again), so we end up doing a needless
294 indirect jump (ToDo).
297 returnUnboxedTuple :: [CAddrMode] -> Code -> Code
298 returnUnboxedTuple amodes before_jump
299 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
301 -- push a return address if necessary
302 pushReturnAddress eob `thenC`
303 setEndOfBlockInfo (EndOfBlockInfo args_sp (OnStack args_sp)) (
306 adjustSpAndHp args_sp `thenC`
310 let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
313 profCtrC SLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
315 doTailCall amodes ret_regs
316 mkUnboxedTupleReturnCode
317 (length leftovers) {- fast args arity -}
318 AbsCNop {-no pending assigments-}
319 Nothing {-not a let-no-escape-}
320 False {-node doesn't point-}
325 performTailCall :: Id -- Function
329 performTailCall fun args
330 = -- Get all the info we have about the function and args and go on to
332 getCAddrModeAndInfo fun `thenFC` \ (fun_amode, lf_info) ->
333 getArgAmodes args `thenFC` \ arg_amodes ->
336 fun fun_amode lf_info arg_amodes
337 AbsCNop {- No pending assignments -}
340 -- generating code for a tail call to a function (or closure)
342 tailCallFun :: Id -> CAddrMode -- Function and its amode
343 -> LambdaFormInfo -- Info about the function
344 -> [CAddrMode] -- Arguments
346 -> AbstractC -- Pending simultaneous assignments
347 -- *** GUARANTEED to contain only stack
350 -- In ptic, we don't need to look in
351 -- here to discover all live regs
355 tailCallFun fun fun_amode lf_info arg_amodes pending_assts
356 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
357 getEntryConvention (idName fun) lf_info
358 (map getAmodeRep arg_amodes) `thenFC` \ entry_conv ->
361 = if node_points then
362 CAssign (CReg node) fun_amode
366 (arg_regs, finish_code, arity)
370 profCtrC SLIT("TICK_ENT_VIA_NODE") [] `thenC`
371 absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
372 [CVal (nodeRel 0) DataPtrRep]))
374 StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
375 DirectEntry lbl arity regs ->
376 (regs, absC (CJump (CLbl lbl CodePtrRep)),
379 -- set up for a let-no-escape if necessary
380 join_sp = case fun_amode of
381 CJoinPoint sp -> Just sp
384 doTailCall arg_amodes arg_regs (const finish_code) arity
385 (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
388 -- this generic tail call code is used for both function calls and returns.
391 :: [CAddrMode] -- args to pass to function
392 -> [MagicId] -- registers to use
393 -> (Sequel->Code) -- code to perform jump
394 -> Int -- number of "fast" stack arguments
395 -> AbstractC -- pending assignments
396 -> Maybe VirtualSpOffset -- sp offset to trim stack to:
397 -- USED iff destination is a let-no-escape
398 -> Bool -- node points to the closure to enter
401 doTailCall arg_amodes arg_regs finish_code arity pending_assts
402 maybe_join_sp node_points
403 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
406 (reg_arg_amodes, stk_arg_amodes) = splitAt (length arg_regs) arg_amodes
407 -- We get some stk_arg_amodes if (a) no regs, or
408 -- (b) args beyond arity
411 = mkAbstractCs (zipWithEqual "assign_to_reg2"
412 assign_to_reg arg_regs reg_arg_amodes)
414 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
416 join_sp = case maybe_join_sp of
417 Just sp -> ASSERT(not (args_sp > sp)) sp
418 -- If ASSERTion fails: Oops: the join point has *lower*
419 -- stack ptrs than the continuation Note that we take
420 -- the Sp point without the return address here. The
421 -- return address is put on by the let-no-escapey thing
425 (fast_stk_amodes, tagged_stk_amodes) =
426 splitAt arity stk_arg_amodes
428 -- eager blackholing, at the end of the basic block.
429 (r1_tmp_asst, bh_asst)
432 -- no: UpdateCode doesn't tell us that we're in a thunk's entry code.
433 -- we might be in a case continuation later down the line. Also,
434 -- we might have pushed a return address on the stack, if we're in
435 -- a case scrut, and still be in the thunk's entry code.
437 (CAssign node_save nodeReg,
438 CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
440 (CLbl mkBlackHoleInfoTableLabel DataPtrRep))
442 node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
444 _ -> (AbsCNop, AbsCNop)
446 -- We can omit tags on the arguments passed to the fast entry point,
447 -- but we have to be careful to fill in the tags on any *extra*
448 -- arguments we're about to push on the stack.
450 mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
451 \ (fast_sp, tagged_arg_assts, tag_assts) ->
453 mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
454 \ (final_sp, fast_arg_assts, _) ->
456 -- adjust the high-water mark if necessary
457 adjustStackHW final_sp `thenC`
459 -- The stack space for the pushed return addess,
460 -- with any args pushed on top, is recorded in final_sp.
462 -- Do the simultaneous assignments,
463 doSimAssts (mkAbstractCs [r1_tmp_asst,
471 -- push a return address if necessary
472 -- (after the assignments above, in case we clobber a live
475 -- DONT push the return address when we're about
476 -- to jump to a let-no-escape: the final tail call
477 -- in the let-no-escape will do this.
478 (if (maybeToBool maybe_join_sp)
480 else pushReturnAddress eob) `thenC`
482 -- Final adjustment of Sp/Hp
483 adjustSpAndHp final_sp `thenC`
485 -- Now decide about semi-tagging
487 semi_tagging_on = opt_DoSemiTagging
489 case (semi_tagging_on, arg_amodes, node_points, sequel) of
492 -- *************** The semi-tagging case ***************
494 {- XXX leave this out for now.
495 ( True, [], True, CaseAlts _ (Just (st_alts, maybe_deflt_join_details))) ->
497 -- Whoppee! Semi-tagging rules OK!
498 -- (a) semi-tagging is switched on
499 -- (b) there are no arguments,
500 -- (c) Node points to the closure
501 -- (d) we have a case-alternative sequel with
502 -- some visible alternatives
504 -- Why is test (c) necessary?
505 -- Usually Node will point to it at this point, because we're
506 -- scrutinsing something which is either a thunk or a
508 -- But not always! The example I came across is when we have
509 -- a top-level Double:
511 -- ... (case lit.3 of ...) ...
512 -- Here, lit.3 is built as a re-entrant thing, which you must enter.
513 -- (OK, the simplifier should have eliminated this, but it's
514 -- easy to deal with the case anyway.)
516 join_details_to_code (load_regs_and_profiling_code, join_lbl)
517 = load_regs_and_profiling_code `mkAbsCStmts`
518 CJump (CLbl join_lbl CodePtrRep)
520 semi_tagged_alts = [ (mkMachInt (fromInt (tag - fIRST_TAG)),
521 join_details_to_code join_details)
522 | (tag, join_details) <- st_alts
526 -- Enter Node (we know infoptr will have the info ptr in it)!
528 CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
529 [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
530 CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
534 CAssign (CReg infoptr)
535 (CVal (NodeRel zeroOff) DataPtrRep),
537 case maybe_deflt_join_details of
539 CSwitch (CMacroExpr IntRep INFO_TAG [CReg infoptr])
543 CSwitch (CMacroExpr IntRep EVAL_TAG [CReg infoptr])
544 [(mkMachInt 0, enter_jump)]
546 (CMacroExpr IntRep INFO_TAG [CReg infoptr])
548 (join_details_to_code details))
553 -- *************** The non-semi-tagging case ***************
555 other -> finish_code sequel
558 %************************************************************************
560 \subsection[tailCallPrimOp]{@tailCallPrimOp@}
562 %************************************************************************
565 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
566 tailCallPrimOp op args =
567 -- we're going to perform a normal-looking tail call,
568 -- except that *all* the arguments will be in registers.
569 getArgAmodes args `thenFC` \ arg_amodes ->
570 let (arg_regs, leftovers) = assignAllRegs [] (map getAmodeRep arg_amodes)
572 ASSERT(null leftovers) -- no stack-resident args
573 doTailCall arg_amodes arg_regs
574 (const (absC (CJump (CLbl (mkRtsPrimOpLabel op) CodePtrRep))))
575 0 {- arity shouldn't matter, all args in regs -}
576 AbsCNop {- no pending assignments -}
577 Nothing {- not a let-no-escape -}
578 False {- node doesn't point -}
581 %************************************************************************
583 \subsection[doSimAssts]{@doSimAssts@}
585 %************************************************************************
587 @doSimAssts@ happens at the end of every block of code.
588 They are separate because we sometimes do some jiggery-pokery in between.
591 doSimAssts :: AbstractC -> Code
594 = absC (CSimultaneous sim_assts)
597 %************************************************************************
599 \subsection[retAddr]{@Return Addresses@}
601 %************************************************************************
603 We always push the return address just before performing a tail call
604 or return. The reason we leave it until then is because the stack
605 slot that the return address is to go into might contain something
608 If the end of block info is CaseAlts, then we're in the scrutinee of a
609 case expression and the return address is still to be pushed.
611 There are cases where it doesn't look necessary to push the return
612 address: for example, just before doing a return to a known
613 continuation. However, the continuation will expect to find the
614 return address on the stack in case it needs to do a heap check.
617 pushReturnAddress :: EndOfBlockInfo -> Code
618 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts amode _)) =
619 getSpRelOffset args_sp `thenFC` \ sp_rel ->
620 absC (CAssign (CVal sp_rel RetRep) amode)
621 pushReturnAddress (EndOfBlockInfo args_sp sequel@(SeqFrame amode _)) =
622 pushSeqFrame args_sp `thenFC` \ ret_sp ->
623 getSpRelOffset ret_sp `thenFC` \ sp_rel ->
624 absC (CAssign (CVal sp_rel RetRep) amode)
625 pushReturnAddress _ = nopC