2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgTailCall.lhs,v 1.32 2002/03/14 15:27:17 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 import ClosureInfo ( nodeMustPointToIt,
44 getEntryConvention, EntryConvention(..), LambdaFormInfo
46 import CmdLineOpts ( opt_DoSemiTagging )
47 import Id ( Id, idType, idName )
48 import DataCon ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
49 import Maybes ( maybeToBool )
50 import PrimRep ( PrimRep(..) )
51 import StgSyn ( StgArg )
52 import Type ( isUnLiftedType )
53 import TyCon ( TyCon )
54 import PrimOp ( PrimOp )
55 import Util ( zipWithEqual, splitAtList )
56 import ListSetOps ( assocMaybe )
58 import Panic ( panic, assertPanic )
61 %************************************************************************
63 \subsection[tailcall-doc]{Documentation}
65 %************************************************************************
68 cgTailCall :: Id -> [StgArg] -> Code
71 Here's the code we generate for a tail call. (NB there may be no
72 arguments, in which case this boils down to just entering a variable.)
75 \item Adjust the stack ptr to \tr{tailSp + #args}.
76 \item Put args in the top locations of the resulting stack.
77 \item Make Node point to the function closure.
78 \item Enter the function closure.
81 Things to be careful about:
83 \item Don't overwrite stack locations before you have finished with
84 them (remember you need the function and the as-yet-unmoved
86 \item Preferably, generate no code to replace x by x on the stack (a
87 common situation in tail-recursion).
88 \item Adjust the stack high water mark appropriately.
91 Treat unboxed locals exactly like literals (above) except use the addr
92 mode for the local instead of (CLit lit) in the assignment.
94 Case for unboxed @Ids@ first:
97 | isUnLiftedType (idType fun)
98 = getCAddrMode fun `thenFC` \ amode ->
99 performPrimReturn (ppr fun) amode
102 The general case (@fun@ is boxed):
104 cgTailCall fun args = performTailCall fun args
107 %************************************************************************
109 \subsection[return-and-tail-call]{Return and tail call}
111 %************************************************************************
114 performPrimReturn :: SDoc -- Just for debugging (sigh)
115 -> CAddrMode -- The thing to return
118 performPrimReturn doc amode
120 kind = getAmodeRep amode
121 ret_reg = WARN( case kind of { PtrRep -> True; other -> False }, text "primRet" <+> doc <+> pprAmode amode )
122 dataReturnConvPrim kind
124 assign_possibly = case kind of
126 kind -> (CAssign (CReg ret_reg) amode)
128 performReturn assign_possibly (mkPrimReturnCode doc)
130 mkPrimReturnCode :: SDoc -- Debugging only
133 mkPrimReturnCode doc UpdateCode = pprPanic "mkPrimReturnCode: Upd" doc
134 mkPrimReturnCode doc sequel = sequelToAmode sequel `thenFC` \ dest_amode ->
135 absC (CReturn dest_amode DirectReturn)
136 -- Direct, no vectoring
138 -- Constructor is built on the heap; Node is set.
139 -- All that remains is
140 -- (a) to set TagReg, if necessary
141 -- (c) to do the right sort of jump.
143 mkStaticAlgReturnCode :: DataCon -- The constructor
144 -> Sequel -- where to return to
147 mkStaticAlgReturnCode con sequel
148 = -- Generate profiling code if necessary
149 (case return_convention of
150 VectoredReturn sz -> profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz]
154 -- Set tag if necessary
155 -- This is done by a macro, because if we are short of registers
156 -- we don't set TagReg; instead the continuation gets the tag
157 -- by indexing off the info ptr
158 (case return_convention of
160 UnvectoredReturn no_of_constrs
162 -> absC (CMacroStmt SET_TAG [mkIntCLit zero_indexed_tag])
167 -- Generate the right jump or return
169 UpdateCode -> -- Ha! We can go direct to the update code,
170 -- (making sure to jump to the *correct* update
172 absC (CReturn (CLbl mkUpdInfoLabel CodePtrRep)
175 CaseAlts _ (Just (alts, _)) -> -- Ho! We know the constructor so
176 -- we can go right to the alternative
178 case assocMaybe alts tag of
179 Just (alt_absC, join_lbl) ->
180 absC (CJump (CLbl join_lbl CodePtrRep))
181 Nothing -> panic "mkStaticAlgReturnCode: default"
182 -- The Nothing case should never happen;
183 -- it's the subject of a wad of special-case
184 -- code in cgReturnCon
186 -- can't be a SeqFrame, because we're returning a constructor
188 other -> -- OnStack, or (CaseAlts ret_amode Nothing)
189 sequelToAmode sequel `thenFC` \ ret_amode ->
190 absC (CReturn ret_amode return_info)
195 tycon = dataConTyCon con
196 return_convention = ctrlReturnConvAlg tycon
197 zero_indexed_tag = tag - fIRST_TAG -- Adjust tag to be zero-indexed
198 -- cf AbsCUtils.mkAlgAltsCSwitch
201 case return_convention of
202 UnvectoredReturn _ -> DirectReturn
203 VectoredReturn _ -> StaticVectoredReturn zero_indexed_tag
205 mkUnboxedTupleReturnCode :: Sequel -> Code
206 mkUnboxedTupleReturnCode sequel
208 -- can't update with an unboxed tuple!
209 UpdateCode -> panic "mkUnboxedTupleReturnCode"
211 CaseAlts _ (Just ([(_,(alt_absC,join_lbl))], _)) ->
212 absC (CJump (CLbl join_lbl CodePtrRep))
214 -- can't be a SeqFrame
216 other -> -- OnStack, or (CaseAlts ret_amode something)
217 sequelToAmode sequel `thenFC` \ ret_amode ->
218 absC (CReturn ret_amode DirectReturn)
220 -- This function is used by PrimOps that return enumerated types (i.e.
221 -- all the comparison operators).
223 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
225 mkDynamicAlgReturnCode tycon dyn_tag sequel
226 = case ctrlReturnConvAlg tycon of
229 profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
230 sequelToAmode sequel `thenFC` \ ret_addr ->
231 absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
233 UnvectoredReturn no_of_constrs ->
235 -- Set tag if necessary
236 -- This is done by a macro, because if we are short of registers
237 -- we don't set TagReg; instead the continuation gets the tag
238 -- by indexing off the info ptr
239 (if no_of_constrs > 1 then
240 absC (CMacroStmt SET_TAG [dyn_tag])
246 sequelToAmode sequel `thenFC` \ ret_addr ->
247 -- Generate the right jump or return
248 absC (CReturn ret_addr DirectReturn)
252 performReturn :: AbstractC -- Simultaneous assignments to perform
253 -> (Sequel -> Code) -- The code to execute to actually do
254 -- the return, given an addressing mode
255 -- for the return address
258 -- this is just a special case of doTailCall, later.
259 performReturn sim_assts finish_code
260 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
262 -- Do the simultaneous assignments,
263 doSimAssts sim_assts `thenC`
265 -- push a return address if necessary
266 -- (after the assignments above, in case we clobber a live
268 pushReturnAddress eob `thenC`
271 adjustSpAndHp args_sp `thenC`
274 finish_code sequel -- "sequel" is `robust' in that it doesn't
275 -- depend on stk-ptr values
278 Returning unboxed tuples. This is mainly to support _ccall_GC_, where
279 we want to do things in a slightly different order to normal:
281 - push return address
282 - adjust stack pointer
284 - assign regs for unboxed tuple (usually just R1 = r)
285 - return to continuation
287 The return address (i.e. stack frame) must be on the stack before
288 doing the call in case the call ends up in the garbage collector.
290 Sadly, the information about the continuation is lost after we push it
291 (in order to avoid pushing it again), so we end up doing a needless
292 indirect jump (ToDo).
295 returnUnboxedTuple :: [CAddrMode] -> Code -> Code
296 returnUnboxedTuple amodes before_jump
297 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
299 -- push a return address if necessary
300 pushReturnAddress eob `thenC`
301 setEndOfBlockInfo (EndOfBlockInfo args_sp (OnStack args_sp)) (
304 adjustSpAndHp args_sp `thenC`
308 let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
311 profCtrC SLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
313 doTailCall amodes ret_regs
314 mkUnboxedTupleReturnCode
315 (length leftovers) {- fast args arity -}
316 AbsCNop {-no pending assigments-}
317 Nothing {-not a let-no-escape-}
318 False {-node doesn't point-}
323 performTailCall :: Id -> [StgArg] -> Code
324 performTailCall fun args
325 = getCAddrModeAndInfo fun `thenFC` \ (fun', fun_amode, lf_info) ->
326 getArgAmodes args `thenFC` \ arg_amodes ->
327 tailCallFun fun' fun_amode lf_info arg_amodes AbsCNop{- No pending assignments -}
330 Generating code for a tail call to a function (or closure)
337 -> [CAddrMode] -- Arguments
338 -> AbstractC -- Pending simultaneous assignments
339 -- *** GUARANTEED to contain only stack
341 -- In ptic, we don't need to look in
342 -- here to discover all live regs
345 tailCallFun fun fun_amode lf_info arg_amodes pending_assts
346 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
347 -- we use the name of fun', the Id from the environment, rather than
348 -- fun from the STG tree, in case it is a top-level name that we externalised
349 -- (see cgTopRhsClosure).
350 getEntryConvention (idName fun) lf_info
351 (map getAmodeRep arg_amodes) `thenFC` \ entry_conv ->
354 = if node_points then
355 CAssign (CReg node) fun_amode
359 (arg_regs, finish_code, arity)
363 profCtrC SLIT("TICK_ENT_VIA_NODE") [] `thenC`
364 absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
365 [CVal (nodeRel 0) DataPtrRep]))
367 StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
368 DirectEntry lbl arity regs ->
369 (regs, absC (CJump (CLbl lbl CodePtrRep)),
372 -- set up for a let-no-escape if necessary
373 join_sp = case fun_amode of
374 CJoinPoint sp -> Just sp
377 doTailCall arg_amodes arg_regs (const finish_code) arity
378 (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
381 -- this generic tail call code is used for both function calls and returns.
384 :: [CAddrMode] -- args to pass to function
385 -> [MagicId] -- registers to use
386 -> (Sequel->Code) -- code to perform jump
387 -> Int -- number of "fast" stack arguments
388 -> AbstractC -- pending assignments
389 -> Maybe VirtualSpOffset -- sp offset to trim stack to:
390 -- USED iff destination is a let-no-escape
391 -> Bool -- node points to the closure to enter
394 doTailCall arg_amodes arg_regs finish_code arity pending_assts
395 maybe_join_sp node_points
396 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
399 (reg_arg_amodes, stk_arg_amodes) = splitAtList arg_regs arg_amodes
400 -- We get some stk_arg_amodes if (a) no regs, or
401 -- (b) args beyond arity
404 = mkAbstractCs (zipWithEqual "assign_to_reg2"
405 assign_to_reg arg_regs reg_arg_amodes)
407 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
409 join_sp = case maybe_join_sp of
410 Just sp -> ASSERT(not (args_sp > sp)) sp
411 -- If ASSERTion fails: Oops: the join point has *lower*
412 -- stack ptrs than the continuation Note that we take
413 -- the Sp point without the return address here. The
414 -- return address is put on by the let-no-escapey thing
418 (fast_stk_amodes, tagged_stk_amodes) =
419 splitAt arity stk_arg_amodes
421 -- eager blackholing, at the end of the basic block.
422 (r1_tmp_asst, bh_asst)
425 -- no: UpdateCode doesn't tell us that we're in a thunk's entry code.
426 -- we might be in a case continuation later down the line. Also,
427 -- we might have pushed a return address on the stack, if we're in
428 -- a case scrut, and still be in the thunk's entry code.
430 (CAssign node_save nodeReg,
431 CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
433 (CLbl mkBlackHoleInfoTableLabel DataPtrRep))
435 node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
437 _ -> (AbsCNop, AbsCNop)
439 -- We can omit tags on the arguments passed to the fast entry point,
440 -- but we have to be careful to fill in the tags on any *extra*
441 -- arguments we're about to push on the stack.
443 mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
444 \ (fast_sp, tagged_arg_assts, tag_assts) ->
446 mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
447 \ (final_sp, fast_arg_assts, _) ->
449 -- adjust the high-water mark if necessary
450 adjustStackHW final_sp `thenC`
452 -- The stack space for the pushed return addess,
453 -- with any args pushed on top, is recorded in final_sp.
455 -- Do the simultaneous assignments,
456 doSimAssts (mkAbstractCs [r1_tmp_asst,
464 -- push a return address if necessary
465 -- (after the assignments above, in case we clobber a live
468 -- DONT push the return address when we're about
469 -- to jump to a let-no-escape: the final tail call
470 -- in the let-no-escape will do this.
471 (if (maybeToBool maybe_join_sp)
473 else pushReturnAddress eob) `thenC`
475 -- Final adjustment of Sp/Hp
476 adjustSpAndHp final_sp `thenC`
478 -- Now decide about semi-tagging
480 semi_tagging_on = opt_DoSemiTagging
482 case (semi_tagging_on, arg_amodes, node_points, sequel) of
485 -- *************** The semi-tagging case ***************
487 {- XXX leave this out for now.
488 ( True, [], True, CaseAlts _ (Just (st_alts, maybe_deflt_join_details))) ->
490 -- Whoppee! Semi-tagging rules OK!
491 -- (a) semi-tagging is switched on
492 -- (b) there are no arguments,
493 -- (c) Node points to the closure
494 -- (d) we have a case-alternative sequel with
495 -- some visible alternatives
497 -- Why is test (c) necessary?
498 -- Usually Node will point to it at this point, because we're
499 -- scrutinsing something which is either a thunk or a
501 -- But not always! The example I came across is when we have
502 -- a top-level Double:
504 -- ... (case lit.3 of ...) ...
505 -- Here, lit.3 is built as a re-entrant thing, which you must enter.
506 -- (OK, the simplifier should have eliminated this, but it's
507 -- easy to deal with the case anyway.)
509 join_details_to_code (load_regs_and_profiling_code, join_lbl)
510 = load_regs_and_profiling_code `mkAbsCStmts`
511 CJump (CLbl join_lbl CodePtrRep)
513 semi_tagged_alts = [ (mkMachInt (fromInt (tag - fIRST_TAG)),
514 join_details_to_code join_details)
515 | (tag, join_details) <- st_alts
519 -- Enter Node (we know infoptr will have the info ptr in it)!
521 CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
522 [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
523 CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
527 CAssign (CReg infoptr)
528 (CVal (NodeRel zeroOff) DataPtrRep),
530 case maybe_deflt_join_details of
532 CSwitch (CMacroExpr IntRep INFO_TAG [CReg infoptr])
536 CSwitch (CMacroExpr IntRep EVAL_TAG [CReg infoptr])
537 [(mkMachInt 0, enter_jump)]
539 (CMacroExpr IntRep INFO_TAG [CReg infoptr])
541 (join_details_to_code details))
546 -- *************** The non-semi-tagging case ***************
548 other -> finish_code sequel
551 %************************************************************************
553 \subsection[tailCallPrimOp]{@tailCallPrimOp@}
555 %************************************************************************
558 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
559 tailCallPrimOp op args =
560 -- we're going to perform a normal-looking tail call,
561 -- except that *all* the arguments will be in registers.
562 getArgAmodes args `thenFC` \ arg_amodes ->
563 let (arg_regs, leftovers) = assignAllRegs [] (map getAmodeRep arg_amodes)
565 ASSERT(null leftovers) -- no stack-resident args
566 doTailCall arg_amodes arg_regs
567 (const (absC (CJump (CLbl (mkRtsPrimOpLabel op) CodePtrRep))))
568 0 {- arity shouldn't matter, all args in regs -}
569 AbsCNop {- no pending assignments -}
570 Nothing {- not a let-no-escape -}
571 False {- node doesn't point -}
574 %************************************************************************
576 \subsection[doSimAssts]{@doSimAssts@}
578 %************************************************************************
580 @doSimAssts@ happens at the end of every block of code.
581 They are separate because we sometimes do some jiggery-pokery in between.
584 doSimAssts :: AbstractC -> Code
587 = absC (CSimultaneous sim_assts)
590 %************************************************************************
592 \subsection[retAddr]{@Return Addresses@}
594 %************************************************************************
596 We always push the return address just before performing a tail call
597 or return. The reason we leave it until then is because the stack
598 slot that the return address is to go into might contain something
601 If the end of block info is CaseAlts, then we're in the scrutinee of a
602 case expression and the return address is still to be pushed.
604 There are cases where it doesn't look necessary to push the return
605 address: for example, just before doing a return to a known
606 continuation. However, the continuation will expect to find the
607 return address on the stack in case it needs to do a heap check.
610 pushReturnAddress :: EndOfBlockInfo -> Code
611 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts amode _)) =
612 getSpRelOffset args_sp `thenFC` \ sp_rel ->
613 absC (CAssign (CVal sp_rel RetRep) amode)
614 pushReturnAddress (EndOfBlockInfo args_sp sequel@(SeqFrame amode _)) =
615 pushSeqFrame args_sp `thenFC` \ ret_sp ->
616 getSpRelOffset ret_sp `thenFC` \ sp_rel ->
617 absC (CAssign (CVal sp_rel RetRep) amode)
618 pushReturnAddress _ = nopC