2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgTailCall.lhs,v 1.35 2002/10/25 16:54:56 simonpj Exp $
6 %********************************************************
8 \section[CgTailCall]{Tail calls: converting @StgApps@}
10 %********************************************************
15 performReturn, performPrimReturn,
16 mkStaticAlgReturnCode, mkDynamicAlgReturnCode,
17 mkUnboxedTupleReturnCode, returnUnboxedTuple,
27 #include "HsVersions.h"
32 import AbsCUtils ( mkAbstractCs, getAmodeRep )
33 import CgBindery ( getArgAmodes, getCAddrMode, getCAddrModeAndInfo )
34 import CgRetConv ( dataReturnConvPrim,
35 ctrlReturnConvAlg, CtrlReturnConvention(..),
36 assignAllRegs, assignRegs
38 import CgStackery ( mkTaggedStkAmodes, adjustStackHW )
39 import CgUsages ( getSpRelOffset, adjustSpAndHp )
40 import CgUpdate ( pushSeqFrame )
41 import CLabel ( mkUpdInfoLabel, mkRtsPrimOpLabel )
42 import ClosureInfo ( nodeMustPointToIt,
43 getEntryConvention, EntryConvention(..), LambdaFormInfo
45 import CmdLineOpts ( opt_DoSemiTagging )
46 import Id ( Id, idType, idName )
47 import DataCon ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
48 import Maybes ( maybeToBool )
49 import PrimRep ( PrimRep(..) )
50 import StgSyn ( StgArg )
51 import Type ( isUnLiftedType )
52 import TyCon ( TyCon )
53 import PrimOp ( PrimOp )
54 import Util ( zipWithEqual, splitAtList )
55 import ListSetOps ( assocMaybe )
57 import Panic ( panic, assertPanic )
60 %************************************************************************
62 \subsection[tailcall-doc]{Documentation}
64 %************************************************************************
67 cgTailCall :: Id -> [StgArg] -> Code
70 Here's the code we generate for a tail call. (NB there may be no
71 arguments, in which case this boils down to just entering a variable.)
74 \item Adjust the stack ptr to \tr{tailSp + #args}.
75 \item Put args in the top locations of the resulting stack.
76 \item Make Node point to the function closure.
77 \item Enter the function closure.
80 Things to be careful about:
82 \item Don't overwrite stack locations before you have finished with
83 them (remember you need the function and the as-yet-unmoved
85 \item Preferably, generate no code to replace x by x on the stack (a
86 common situation in tail-recursion).
87 \item Adjust the stack high water mark appropriately.
90 Treat unboxed locals exactly like literals (above) except use the addr
91 mode for the local instead of (CLit lit) in the assignment.
93 Case for unboxed @Ids@ first:
96 | isUnLiftedType (idType fun)
97 = getCAddrMode fun `thenFC` \ amode ->
98 performPrimReturn (ppr fun) amode
101 The general case (@fun@ is boxed):
103 cgTailCall fun args = performTailCall fun args
106 %************************************************************************
108 \subsection[return-and-tail-call]{Return and tail call}
110 %************************************************************************
113 performPrimReturn :: SDoc -- Just for debugging (sigh)
114 -> CAddrMode -- The thing to return
117 performPrimReturn doc amode
119 kind = getAmodeRep amode
120 ret_reg = dataReturnConvPrim kind
122 assign_possibly = case kind of
124 kind -> (CAssign (CReg ret_reg) amode)
126 performReturn assign_possibly (mkPrimReturnCode doc)
128 mkPrimReturnCode :: SDoc -- Debugging only
131 mkPrimReturnCode doc UpdateCode = pprPanic "mkPrimReturnCode: Upd" doc
132 mkPrimReturnCode doc sequel = sequelToAmode sequel `thenFC` \ dest_amode ->
133 absC (CReturn dest_amode DirectReturn)
134 -- Direct, no vectoring
136 -- Constructor is built on the heap; Node is set.
137 -- All that remains is
138 -- (a) to set TagReg, if necessary
139 -- (c) to do the right sort of jump.
141 mkStaticAlgReturnCode :: DataCon -- The constructor
142 -> Sequel -- where to return to
145 mkStaticAlgReturnCode con sequel
146 = -- Generate profiling code if necessary
147 (case return_convention of
148 VectoredReturn sz -> profCtrC FSLIT("TICK_VEC_RETURN") [mkIntCLit sz]
152 -- Set tag if necessary
153 -- This is done by a macro, because if we are short of registers
154 -- we don't set TagReg; instead the continuation gets the tag
155 -- by indexing off the info ptr
156 (case return_convention of
158 UnvectoredReturn no_of_constrs
160 -> absC (CMacroStmt SET_TAG [mkIntCLit zero_indexed_tag])
165 -- Generate the right jump or return
167 UpdateCode -> -- Ha! We can go direct to the update code,
168 -- (making sure to jump to the *correct* update
170 absC (CReturn (CLbl mkUpdInfoLabel CodePtrRep)
173 CaseAlts _ (Just (alts, _)) -> -- Ho! We know the constructor so
174 -- we can go right to the alternative
176 case assocMaybe alts tag of
177 Just (alt_absC, join_lbl) ->
178 absC (CJump (CLbl join_lbl CodePtrRep))
179 Nothing -> panic "mkStaticAlgReturnCode: default"
180 -- The Nothing case should never happen;
181 -- it's the subject of a wad of special-case
182 -- code in cgReturnCon
184 -- can't be a SeqFrame, because we're returning a constructor
186 other -> -- OnStack, or (CaseAlts ret_amode Nothing)
187 sequelToAmode sequel `thenFC` \ ret_amode ->
188 absC (CReturn ret_amode return_info)
193 tycon = dataConTyCon con
194 return_convention = ctrlReturnConvAlg tycon
195 zero_indexed_tag = tag - fIRST_TAG -- Adjust tag to be zero-indexed
196 -- cf AbsCUtils.mkAlgAltsCSwitch
199 case return_convention of
200 UnvectoredReturn _ -> DirectReturn
201 VectoredReturn _ -> StaticVectoredReturn zero_indexed_tag
203 mkUnboxedTupleReturnCode :: Sequel -> Code
204 mkUnboxedTupleReturnCode sequel
206 -- can't update with an unboxed tuple!
207 UpdateCode -> panic "mkUnboxedTupleReturnCode"
209 CaseAlts _ (Just ([(_,(alt_absC,join_lbl))], _)) ->
210 absC (CJump (CLbl join_lbl CodePtrRep))
212 -- can't be a SeqFrame
214 other -> -- OnStack, or (CaseAlts ret_amode something)
215 sequelToAmode sequel `thenFC` \ ret_amode ->
216 absC (CReturn ret_amode DirectReturn)
218 -- This function is used by PrimOps that return enumerated types (i.e.
219 -- all the comparison operators).
221 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
223 mkDynamicAlgReturnCode tycon dyn_tag sequel
224 = case ctrlReturnConvAlg tycon of
227 profCtrC FSLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
228 sequelToAmode sequel `thenFC` \ ret_addr ->
229 absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
231 UnvectoredReturn no_of_constrs ->
233 -- Set tag if necessary
234 -- This is done by a macro, because if we are short of registers
235 -- we don't set TagReg; instead the continuation gets the tag
236 -- by indexing off the info ptr
237 (if no_of_constrs > 1 then
238 absC (CMacroStmt SET_TAG [dyn_tag])
244 sequelToAmode sequel `thenFC` \ ret_addr ->
245 -- Generate the right jump or return
246 absC (CReturn ret_addr DirectReturn)
250 performReturn :: AbstractC -- Simultaneous assignments to perform
251 -> (Sequel -> Code) -- The code to execute to actually do
252 -- the return, given an addressing mode
253 -- for the return address
256 -- this is just a special case of doTailCall, later.
257 performReturn sim_assts finish_code
258 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
260 -- Do the simultaneous assignments,
261 doSimAssts sim_assts `thenC`
263 -- push a return address if necessary
264 -- (after the assignments above, in case we clobber a live
266 pushReturnAddress eob `thenC`
269 adjustSpAndHp args_sp `thenC`
272 finish_code sequel -- "sequel" is `robust' in that it doesn't
273 -- depend on stk-ptr values
276 Returning unboxed tuples. This is mainly to support _ccall_GC_, where
277 we want to do things in a slightly different order to normal:
279 - push return address
280 - adjust stack pointer
282 - assign regs for unboxed tuple (usually just R1 = r)
283 - return to continuation
285 The return address (i.e. stack frame) must be on the stack before
286 doing the call in case the call ends up in the garbage collector.
288 Sadly, the information about the continuation is lost after we push it
289 (in order to avoid pushing it again), so we end up doing a needless
290 indirect jump (ToDo).
293 returnUnboxedTuple :: [CAddrMode] -> Code -> Code
294 returnUnboxedTuple amodes before_jump
295 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
297 -- push a return address if necessary
298 pushReturnAddress eob `thenC`
299 setEndOfBlockInfo (EndOfBlockInfo args_sp (OnStack args_sp)) (
302 adjustSpAndHp args_sp `thenC`
306 let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
309 profCtrC FSLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
311 doTailCall amodes ret_regs
312 mkUnboxedTupleReturnCode
313 (length leftovers) {- fast args arity -}
314 AbsCNop {-no pending assigments-}
315 Nothing {-not a let-no-escape-}
316 False {-node doesn't point-}
321 performTailCall :: Id -> [StgArg] -> Code
322 performTailCall fun args
323 = getCAddrModeAndInfo fun `thenFC` \ (fun', fun_amode, lf_info) ->
324 getArgAmodes args `thenFC` \ arg_amodes ->
325 tailCallFun fun' fun_amode lf_info arg_amodes AbsCNop{- No pending assignments -}
328 Generating code for a tail call to a function (or closure)
335 -> [CAddrMode] -- Arguments
336 -> AbstractC -- Pending simultaneous assignments
337 -- *** GUARANTEED to contain only stack
339 -- In ptic, we don't need to look in
340 -- here to discover all live regs
343 tailCallFun fun fun_amode lf_info arg_amodes pending_assts
344 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
345 -- we use the name of fun', the Id from the environment, rather than
346 -- fun from the STG tree, in case it is a top-level name that we externalised
347 -- (see cgTopRhsClosure).
348 getEntryConvention (idName fun) lf_info
349 (map getAmodeRep arg_amodes) `thenFC` \ entry_conv ->
352 = if node_points then
353 CAssign (CReg node) fun_amode
357 (arg_regs, finish_code, arity)
361 profCtrC FSLIT("TICK_ENT_VIA_NODE") [] `thenC`
362 absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
363 [CVal (nodeRel 0) DataPtrRep]))
365 StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
366 DirectEntry lbl arity regs ->
367 (regs, absC (CJump (CLbl lbl CodePtrRep)),
370 -- set up for a let-no-escape if necessary
371 join_sp = case fun_amode of
372 CJoinPoint sp -> Just sp
375 doTailCall arg_amodes arg_regs (const finish_code) arity
376 (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
379 -- this generic tail call code is used for both function calls and returns.
382 :: [CAddrMode] -- args to pass to function
383 -> [MagicId] -- registers to use
384 -> (Sequel->Code) -- code to perform jump
385 -> Int -- number of "fast" stack arguments
386 -> AbstractC -- pending assignments
387 -> Maybe VirtualSpOffset -- sp offset to trim stack to:
388 -- USED iff destination is a let-no-escape
389 -> Bool -- node points to the closure to enter
392 doTailCall arg_amodes arg_regs finish_code arity pending_assts
393 maybe_join_sp node_points
394 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
397 (reg_arg_amodes, stk_arg_amodes) = splitAtList arg_regs arg_amodes
398 -- We get some stk_arg_amodes if (a) no regs, or
399 -- (b) args beyond arity
402 = mkAbstractCs (zipWithEqual "assign_to_reg2"
403 assign_to_reg arg_regs reg_arg_amodes)
405 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
407 join_sp = case maybe_join_sp of
408 Just sp -> ASSERT(not (args_sp > sp)) sp
409 -- If ASSERTion fails: Oops: the join point has *lower*
410 -- stack ptrs than the continuation Note that we take
411 -- the Sp point without the return address here. The
412 -- return address is put on by the let-no-escapey thing
416 (fast_stk_amodes, tagged_stk_amodes) =
417 splitAt arity stk_arg_amodes
419 -- eager blackholing, at the end of the basic block.
420 (r1_tmp_asst, bh_asst)
423 -- no: UpdateCode doesn't tell us that we're in a thunk's entry code.
424 -- we might be in a case continuation later down the line. Also,
425 -- we might have pushed a return address on the stack, if we're in
426 -- a case scrut, and still be in the thunk's entry code.
428 (CAssign node_save nodeReg,
429 CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
431 (CLbl mkBlackHoleInfoTableLabel DataPtrRep))
433 node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
435 _ -> (AbsCNop, AbsCNop)
437 -- We can omit tags on the arguments passed to the fast entry point,
438 -- but we have to be careful to fill in the tags on any *extra*
439 -- arguments we're about to push on the stack.
441 mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
442 \ (fast_sp, tagged_arg_assts, tag_assts) ->
444 mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
445 \ (final_sp, fast_arg_assts, _) ->
447 -- adjust the high-water mark if necessary
448 adjustStackHW final_sp `thenC`
450 -- The stack space for the pushed return addess,
451 -- with any args pushed on top, is recorded in final_sp.
453 -- Do the simultaneous assignments,
454 doSimAssts (mkAbstractCs [r1_tmp_asst,
462 -- push a return address if necessary
463 -- (after the assignments above, in case we clobber a live
466 -- DONT push the return address when we're about
467 -- to jump to a let-no-escape: the final tail call
468 -- in the let-no-escape will do this.
469 (if (maybeToBool maybe_join_sp)
471 else pushReturnAddress eob) `thenC`
473 -- Final adjustment of Sp/Hp
474 adjustSpAndHp final_sp `thenC`
476 -- Now decide about semi-tagging
478 semi_tagging_on = opt_DoSemiTagging
480 case (semi_tagging_on, arg_amodes, node_points, sequel) of
483 -- *************** The semi-tagging case ***************
485 {- XXX leave this out for now.
486 ( True, [], True, CaseAlts _ (Just (st_alts, maybe_deflt_join_details))) ->
488 -- Whoppee! Semi-tagging rules OK!
489 -- (a) semi-tagging is switched on
490 -- (b) there are no arguments,
491 -- (c) Node points to the closure
492 -- (d) we have a case-alternative sequel with
493 -- some visible alternatives
495 -- Why is test (c) necessary?
496 -- Usually Node will point to it at this point, because we're
497 -- scrutinsing something which is either a thunk or a
499 -- But not always! The example I came across is when we have
500 -- a top-level Double:
502 -- ... (case lit.3 of ...) ...
503 -- Here, lit.3 is built as a re-entrant thing, which you must enter.
504 -- (OK, the simplifier should have eliminated this, but it's
505 -- easy to deal with the case anyway.)
507 join_details_to_code (load_regs_and_profiling_code, join_lbl)
508 = load_regs_and_profiling_code `mkAbsCStmts`
509 CJump (CLbl join_lbl CodePtrRep)
511 semi_tagged_alts = [ (mkMachInt (fromInt (tag - fIRST_TAG)),
512 join_details_to_code join_details)
513 | (tag, join_details) <- st_alts
517 -- Enter Node (we know infoptr will have the info ptr in it)!
519 CCallProfCtrMacro FSLIT("RET_SEMI_FAILED")
520 [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
521 CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
525 CAssign (CReg infoptr)
526 (CVal (NodeRel zeroOff) DataPtrRep),
528 case maybe_deflt_join_details of
530 CSwitch (CMacroExpr IntRep INFO_TAG [CReg infoptr])
534 CSwitch (CMacroExpr IntRep EVAL_TAG [CReg infoptr])
535 [(mkMachInt 0, enter_jump)]
537 (CMacroExpr IntRep INFO_TAG [CReg infoptr])
539 (join_details_to_code details))
544 -- *************** The non-semi-tagging case ***************
546 other -> finish_code sequel
549 %************************************************************************
551 \subsection[tailCallPrimOp]{@tailCallPrimOp@}
553 %************************************************************************
556 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
557 tailCallPrimOp op args =
558 -- we're going to perform a normal-looking tail call,
559 -- except that *all* the arguments will be in registers.
560 getArgAmodes args `thenFC` \ arg_amodes ->
561 let (arg_regs, leftovers) = assignAllRegs [] (map getAmodeRep arg_amodes)
563 ASSERT(null leftovers) -- no stack-resident args
564 doTailCall arg_amodes arg_regs
565 (const (absC (CJump (CLbl (mkRtsPrimOpLabel op) CodePtrRep))))
566 0 {- arity shouldn't matter, all args in regs -}
567 AbsCNop {- no pending assignments -}
568 Nothing {- not a let-no-escape -}
569 False {- node doesn't point -}
572 %************************************************************************
574 \subsection[doSimAssts]{@doSimAssts@}
576 %************************************************************************
578 @doSimAssts@ happens at the end of every block of code.
579 They are separate because we sometimes do some jiggery-pokery in between.
582 doSimAssts :: AbstractC -> Code
585 = absC (CSimultaneous sim_assts)
588 %************************************************************************
590 \subsection[retAddr]{@Return Addresses@}
592 %************************************************************************
594 We always push the return address just before performing a tail call
595 or return. The reason we leave it until then is because the stack
596 slot that the return address is to go into might contain something
599 If the end of block info is CaseAlts, then we're in the scrutinee of a
600 case expression and the return address is still to be pushed.
602 There are cases where it doesn't look necessary to push the return
603 address: for example, just before doing a return to a known
604 continuation. However, the continuation will expect to find the
605 return address on the stack in case it needs to do a heap check.
608 pushReturnAddress :: EndOfBlockInfo -> Code
609 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts amode _)) =
610 getSpRelOffset args_sp `thenFC` \ sp_rel ->
611 absC (CAssign (CVal sp_rel RetRep) amode)
612 pushReturnAddress (EndOfBlockInfo args_sp sequel@(SeqFrame amode _)) =
613 pushSeqFrame args_sp `thenFC` \ ret_sp ->
614 getSpRelOffset ret_sp `thenFC` \ sp_rel ->
615 absC (CAssign (CVal sp_rel RetRep) amode)
616 pushReturnAddress _ = nopC