2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgTailCall.lhs,v 1.29 2000/12/06 13:19:49 simonmar 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(..), LambdaFormInfo
47 import CmdLineOpts ( opt_DoSemiTagging )
48 import Id ( Id, idType, idName )
49 import DataCon ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
50 import Maybes ( maybeToBool )
51 import PrimRep ( PrimRep(..) )
52 import StgSyn ( StgArg )
53 import Type ( isUnLiftedType )
54 import TyCon ( TyCon )
55 import PrimOp ( PrimOp )
56 import Util ( zipWithEqual )
57 import ListSetOps ( assocMaybe )
59 import Panic ( panic, assertPanic )
62 %************************************************************************
64 \subsection[tailcall-doc]{Documentation}
66 %************************************************************************
69 cgTailCall :: Id -> [StgArg] -> Code
72 Here's the code we generate for a tail call. (NB there may be no
73 arguments, in which case this boils down to just entering a variable.)
76 \item Adjust the stack ptr to \tr{tailSp + #args}.
77 \item Put args in the top locations of the resulting stack.
78 \item Make Node point to the function closure.
79 \item Enter the function closure.
82 Things to be careful about:
84 \item Don't overwrite stack locations before you have finished with
85 them (remember you need the function and the as-yet-unmoved
87 \item Preferably, generate no code to replace x by x on the stack (a
88 common situation in tail-recursion).
89 \item Adjust the stack high water mark appropriately.
92 Treat unboxed locals exactly like literals (above) except use the addr
93 mode for the local instead of (CLit lit) in the assignment.
95 Case for unboxed @Ids@ first:
98 | isUnLiftedType (idType fun)
99 = getCAddrMode fun `thenFC` \ amode ->
100 performPrimReturn (ppr fun) amode
103 The general case (@fun@ is boxed):
105 cgTailCall fun args = performTailCall fun args
108 %************************************************************************
110 \subsection[return-and-tail-call]{Return and tail call}
112 %************************************************************************
115 performPrimReturn :: SDoc -- Just for debugging (sigh)
116 -> CAddrMode -- The thing to return
119 performPrimReturn doc amode
121 kind = getAmodeRep amode
122 ret_reg = WARN( case kind of { PtrRep -> True; other -> False }, text "primRet" <+> doc <+> pprAmode amode )
123 dataReturnConvPrim kind
125 assign_possibly = case kind of
127 kind -> (CAssign (CReg ret_reg) amode)
129 performReturn assign_possibly (mkPrimReturnCode doc)
131 mkPrimReturnCode :: SDoc -- Debugging only
134 mkPrimReturnCode doc UpdateCode = pprPanic "mkPrimReturnCode: Upd" doc
135 mkPrimReturnCode doc sequel = sequelToAmode sequel `thenFC` \ dest_amode ->
136 absC (CReturn dest_amode DirectReturn)
137 -- Direct, no vectoring
139 -- Constructor is built on the heap; Node is set.
140 -- All that remains is
141 -- (a) to set TagReg, if necessary
142 -- (c) to do the right sort of jump.
144 mkStaticAlgReturnCode :: DataCon -- The constructor
145 -> Sequel -- where to return to
148 mkStaticAlgReturnCode con sequel
149 = -- Generate profiling code if necessary
150 (case return_convention of
151 VectoredReturn sz -> profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz]
155 -- Set tag if necessary
156 -- This is done by a macro, because if we are short of registers
157 -- we don't set TagReg; instead the continuation gets the tag
158 -- by indexing off the info ptr
159 (case return_convention of
161 UnvectoredReturn no_of_constrs
163 -> absC (CMacroStmt SET_TAG [mkIntCLit zero_indexed_tag])
168 -- Generate the right jump or return
170 UpdateCode -> -- Ha! We can go direct to the update code,
171 -- (making sure to jump to the *correct* update
173 absC (CReturn (CLbl mkUpdInfoLabel CodePtrRep)
176 CaseAlts _ (Just (alts, _)) -> -- Ho! We know the constructor so
177 -- we can go right to the alternative
179 case assocMaybe alts tag of
180 Just (alt_absC, join_lbl) ->
181 absC (CJump (CLbl join_lbl CodePtrRep))
182 Nothing -> panic "mkStaticAlgReturnCode: default"
183 -- The Nothing case should never happen;
184 -- it's the subject of a wad of special-case
185 -- code in cgReturnCon
187 -- can't be a SeqFrame, because we're returning a constructor
189 other -> -- OnStack, or (CaseAlts ret_amode Nothing)
190 sequelToAmode sequel `thenFC` \ ret_amode ->
191 absC (CReturn ret_amode return_info)
196 tycon = dataConTyCon con
197 return_convention = ctrlReturnConvAlg tycon
198 zero_indexed_tag = tag - fIRST_TAG -- Adjust tag to be zero-indexed
199 -- cf AbsCUtils.mkAlgAltsCSwitch
202 case return_convention of
203 UnvectoredReturn _ -> DirectReturn
204 VectoredReturn _ -> StaticVectoredReturn zero_indexed_tag
206 mkUnboxedTupleReturnCode :: Sequel -> Code
207 mkUnboxedTupleReturnCode sequel
209 -- can't update with an unboxed tuple!
210 UpdateCode -> panic "mkUnboxedTupleReturnCode"
212 CaseAlts _ (Just ([(_,(alt_absC,join_lbl))], _)) ->
213 absC (CJump (CLbl join_lbl CodePtrRep))
215 -- can't be a SeqFrame
217 other -> -- OnStack, or (CaseAlts ret_amode something)
218 sequelToAmode sequel `thenFC` \ ret_amode ->
219 absC (CReturn ret_amode DirectReturn)
221 -- This function is used by PrimOps that return enumerated types (i.e.
222 -- all the comparison operators).
224 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
226 mkDynamicAlgReturnCode tycon dyn_tag sequel
227 = case ctrlReturnConvAlg tycon of
230 profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
231 sequelToAmode sequel `thenFC` \ ret_addr ->
232 absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
234 UnvectoredReturn no_of_constrs ->
236 -- Set tag if necessary
237 -- This is done by a macro, because if we are short of registers
238 -- we don't set TagReg; instead the continuation gets the tag
239 -- by indexing off the info ptr
240 (if no_of_constrs > 1 then
241 absC (CMacroStmt SET_TAG [dyn_tag])
247 sequelToAmode sequel `thenFC` \ ret_addr ->
248 -- Generate the right jump or return
249 absC (CReturn ret_addr DirectReturn)
253 performReturn :: AbstractC -- Simultaneous assignments to perform
254 -> (Sequel -> Code) -- The code to execute to actually do
255 -- the return, given an addressing mode
256 -- for the return address
259 -- this is just a special case of doTailCall, later.
260 performReturn sim_assts finish_code
261 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
263 -- Do the simultaneous assignments,
264 doSimAssts sim_assts `thenC`
266 -- push a return address if necessary
267 -- (after the assignments above, in case we clobber a live
269 pushReturnAddress eob `thenC`
272 adjustSpAndHp args_sp `thenC`
275 finish_code sequel -- "sequel" is `robust' in that it doesn't
276 -- depend on stk-ptr values
279 Returning unboxed tuples. This is mainly to support _ccall_GC_, where
280 we want to do things in a slightly different order to normal:
282 - push return address
283 - adjust stack pointer
285 - assign regs for unboxed tuple (usually just R1 = r)
286 - return to continuation
288 The return address (i.e. stack frame) must be on the stack before
289 doing the call in case the call ends up in the garbage collector.
291 Sadly, the information about the continuation is lost after we push it
292 (in order to avoid pushing it again), so we end up doing a needless
293 indirect jump (ToDo).
296 returnUnboxedTuple :: [CAddrMode] -> Code -> Code
297 returnUnboxedTuple amodes before_jump
298 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
300 -- push a return address if necessary
301 pushReturnAddress eob `thenC`
302 setEndOfBlockInfo (EndOfBlockInfo args_sp (OnStack args_sp)) (
305 adjustSpAndHp args_sp `thenC`
309 let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
312 profCtrC SLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
314 doTailCall amodes ret_regs
315 mkUnboxedTupleReturnCode
316 (length leftovers) {- fast args arity -}
317 AbsCNop {-no pending assigments-}
318 Nothing {-not a let-no-escape-}
319 False {-node doesn't point-}
324 performTailCall :: Id -> [StgArg] -> Code
325 performTailCall fun args
326 = getCAddrModeAndInfo fun `thenFC` \ (fun', fun_amode, lf_info) ->
327 getArgAmodes args `thenFC` \ arg_amodes ->
328 tailCallFun fun' fun_amode lf_info arg_amodes AbsCNop{- No pending assignments -}
331 Generating code for a tail call to a function (or closure)
338 -> [CAddrMode] -- Arguments
339 -> AbstractC -- Pending simultaneous assignments
340 -- *** GUARANTEED to contain only stack
342 -- In ptic, we don't need to look in
343 -- here to discover all live regs
346 tailCallFun fun fun_amode lf_info arg_amodes pending_assts
347 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
348 -- we use the name of fun', the Id from the environment, rather than
349 -- fun from the STG tree, in case it is a top-level name that we globalised
350 -- (see cgTopRhsClosure).
351 getEntryConvention (idName fun) lf_info
352 (map getAmodeRep arg_amodes) `thenFC` \ entry_conv ->
355 = if node_points then
356 CAssign (CReg node) fun_amode
360 (arg_regs, finish_code, arity)
364 profCtrC SLIT("TICK_ENT_VIA_NODE") [] `thenC`
365 absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
366 [CVal (nodeRel 0) DataPtrRep]))
368 StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
369 DirectEntry lbl arity regs ->
370 (regs, absC (CJump (CLbl lbl CodePtrRep)),
373 -- set up for a let-no-escape if necessary
374 join_sp = case fun_amode of
375 CJoinPoint sp -> Just sp
378 doTailCall arg_amodes arg_regs (const finish_code) arity
379 (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
382 -- this generic tail call code is used for both function calls and returns.
385 :: [CAddrMode] -- args to pass to function
386 -> [MagicId] -- registers to use
387 -> (Sequel->Code) -- code to perform jump
388 -> Int -- number of "fast" stack arguments
389 -> AbstractC -- pending assignments
390 -> Maybe VirtualSpOffset -- sp offset to trim stack to:
391 -- USED iff destination is a let-no-escape
392 -> Bool -- node points to the closure to enter
395 doTailCall arg_amodes arg_regs finish_code arity pending_assts
396 maybe_join_sp node_points
397 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
400 (reg_arg_amodes, stk_arg_amodes) = splitAt (length arg_regs) arg_amodes
401 -- We get some stk_arg_amodes if (a) no regs, or
402 -- (b) args beyond arity
405 = mkAbstractCs (zipWithEqual "assign_to_reg2"
406 assign_to_reg arg_regs reg_arg_amodes)
408 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
410 join_sp = case maybe_join_sp of
411 Just sp -> ASSERT(not (args_sp > sp)) sp
412 -- If ASSERTion fails: Oops: the join point has *lower*
413 -- stack ptrs than the continuation Note that we take
414 -- the Sp point without the return address here. The
415 -- return address is put on by the let-no-escapey thing
419 (fast_stk_amodes, tagged_stk_amodes) =
420 splitAt arity stk_arg_amodes
422 -- eager blackholing, at the end of the basic block.
423 (r1_tmp_asst, bh_asst)
426 -- no: UpdateCode doesn't tell us that we're in a thunk's entry code.
427 -- we might be in a case continuation later down the line. Also,
428 -- we might have pushed a return address on the stack, if we're in
429 -- a case scrut, and still be in the thunk's entry code.
431 (CAssign node_save nodeReg,
432 CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
434 (CLbl mkBlackHoleInfoTableLabel DataPtrRep))
436 node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
438 _ -> (AbsCNop, AbsCNop)
440 -- We can omit tags on the arguments passed to the fast entry point,
441 -- but we have to be careful to fill in the tags on any *extra*
442 -- arguments we're about to push on the stack.
444 mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
445 \ (fast_sp, tagged_arg_assts, tag_assts) ->
447 mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
448 \ (final_sp, fast_arg_assts, _) ->
450 -- adjust the high-water mark if necessary
451 adjustStackHW final_sp `thenC`
453 -- The stack space for the pushed return addess,
454 -- with any args pushed on top, is recorded in final_sp.
456 -- Do the simultaneous assignments,
457 doSimAssts (mkAbstractCs [r1_tmp_asst,
465 -- push a return address if necessary
466 -- (after the assignments above, in case we clobber a live
469 -- DONT push the return address when we're about
470 -- to jump to a let-no-escape: the final tail call
471 -- in the let-no-escape will do this.
472 (if (maybeToBool maybe_join_sp)
474 else pushReturnAddress eob) `thenC`
476 -- Final adjustment of Sp/Hp
477 adjustSpAndHp final_sp `thenC`
479 -- Now decide about semi-tagging
481 semi_tagging_on = opt_DoSemiTagging
483 case (semi_tagging_on, arg_amodes, node_points, sequel) of
486 -- *************** The semi-tagging case ***************
488 {- XXX leave this out for now.
489 ( True, [], True, CaseAlts _ (Just (st_alts, maybe_deflt_join_details))) ->
491 -- Whoppee! Semi-tagging rules OK!
492 -- (a) semi-tagging is switched on
493 -- (b) there are no arguments,
494 -- (c) Node points to the closure
495 -- (d) we have a case-alternative sequel with
496 -- some visible alternatives
498 -- Why is test (c) necessary?
499 -- Usually Node will point to it at this point, because we're
500 -- scrutinsing something which is either a thunk or a
502 -- But not always! The example I came across is when we have
503 -- a top-level Double:
505 -- ... (case lit.3 of ...) ...
506 -- Here, lit.3 is built as a re-entrant thing, which you must enter.
507 -- (OK, the simplifier should have eliminated this, but it's
508 -- easy to deal with the case anyway.)
510 join_details_to_code (load_regs_and_profiling_code, join_lbl)
511 = load_regs_and_profiling_code `mkAbsCStmts`
512 CJump (CLbl join_lbl CodePtrRep)
514 semi_tagged_alts = [ (mkMachInt (fromInt (tag - fIRST_TAG)),
515 join_details_to_code join_details)
516 | (tag, join_details) <- st_alts
520 -- Enter Node (we know infoptr will have the info ptr in it)!
522 CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
523 [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
524 CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
528 CAssign (CReg infoptr)
529 (CVal (NodeRel zeroOff) DataPtrRep),
531 case maybe_deflt_join_details of
533 CSwitch (CMacroExpr IntRep INFO_TAG [CReg infoptr])
537 CSwitch (CMacroExpr IntRep EVAL_TAG [CReg infoptr])
538 [(mkMachInt 0, enter_jump)]
540 (CMacroExpr IntRep INFO_TAG [CReg infoptr])
542 (join_details_to_code details))
547 -- *************** The non-semi-tagging case ***************
549 other -> finish_code sequel
552 %************************************************************************
554 \subsection[tailCallPrimOp]{@tailCallPrimOp@}
556 %************************************************************************
559 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
560 tailCallPrimOp op args =
561 -- we're going to perform a normal-looking tail call,
562 -- except that *all* the arguments will be in registers.
563 getArgAmodes args `thenFC` \ arg_amodes ->
564 let (arg_regs, leftovers) = assignAllRegs [] (map getAmodeRep arg_amodes)
566 ASSERT(null leftovers) -- no stack-resident args
567 doTailCall arg_amodes arg_regs
568 (const (absC (CJump (CLbl (mkRtsPrimOpLabel op) CodePtrRep))))
569 0 {- arity shouldn't matter, all args in regs -}
570 AbsCNop {- no pending assignments -}
571 Nothing {- not a let-no-escape -}
572 False {- node doesn't point -}
575 %************************************************************************
577 \subsection[doSimAssts]{@doSimAssts@}
579 %************************************************************************
581 @doSimAssts@ happens at the end of every block of code.
582 They are separate because we sometimes do some jiggery-pokery in between.
585 doSimAssts :: AbstractC -> Code
588 = absC (CSimultaneous sim_assts)
591 %************************************************************************
593 \subsection[retAddr]{@Return Addresses@}
595 %************************************************************************
597 We always push the return address just before performing a tail call
598 or return. The reason we leave it until then is because the stack
599 slot that the return address is to go into might contain something
602 If the end of block info is CaseAlts, then we're in the scrutinee of a
603 case expression and the return address is still to be pushed.
605 There are cases where it doesn't look necessary to push the return
606 address: for example, just before doing a return to a known
607 continuation. However, the continuation will expect to find the
608 return address on the stack in case it needs to do a heap check.
611 pushReturnAddress :: EndOfBlockInfo -> Code
612 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts amode _)) =
613 getSpRelOffset args_sp `thenFC` \ sp_rel ->
614 absC (CAssign (CVal sp_rel RetRep) amode)
615 pushReturnAddress (EndOfBlockInfo args_sp sequel@(SeqFrame amode _)) =
616 pushSeqFrame args_sp `thenFC` \ ret_sp ->
617 getSpRelOffset ret_sp `thenFC` \ sp_rel ->
618 absC (CAssign (CVal sp_rel RetRep) amode)
619 pushReturnAddress _ = nopC