2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgTailCall.lhs,v 1.34 2002/09/11 10:14:32 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 = dataReturnConvPrim kind
123 assign_possibly = case kind of
125 kind -> (CAssign (CReg ret_reg) amode)
127 performReturn assign_possibly (mkPrimReturnCode doc)
129 mkPrimReturnCode :: SDoc -- Debugging only
132 mkPrimReturnCode doc UpdateCode = pprPanic "mkPrimReturnCode: Upd" doc
133 mkPrimReturnCode doc sequel = sequelToAmode sequel `thenFC` \ dest_amode ->
134 absC (CReturn dest_amode DirectReturn)
135 -- Direct, no vectoring
137 -- Constructor is built on the heap; Node is set.
138 -- All that remains is
139 -- (a) to set TagReg, if necessary
140 -- (c) to do the right sort of jump.
142 mkStaticAlgReturnCode :: DataCon -- The constructor
143 -> Sequel -- where to return to
146 mkStaticAlgReturnCode con sequel
147 = -- Generate profiling code if necessary
148 (case return_convention of
149 VectoredReturn sz -> profCtrC FSLIT("TICK_VEC_RETURN") [mkIntCLit sz]
153 -- Set tag if necessary
154 -- This is done by a macro, because if we are short of registers
155 -- we don't set TagReg; instead the continuation gets the tag
156 -- by indexing off the info ptr
157 (case return_convention of
159 UnvectoredReturn no_of_constrs
161 -> absC (CMacroStmt SET_TAG [mkIntCLit zero_indexed_tag])
166 -- Generate the right jump or return
168 UpdateCode -> -- Ha! We can go direct to the update code,
169 -- (making sure to jump to the *correct* update
171 absC (CReturn (CLbl mkUpdInfoLabel CodePtrRep)
174 CaseAlts _ (Just (alts, _)) -> -- Ho! We know the constructor so
175 -- we can go right to the alternative
177 case assocMaybe alts tag of
178 Just (alt_absC, join_lbl) ->
179 absC (CJump (CLbl join_lbl CodePtrRep))
180 Nothing -> panic "mkStaticAlgReturnCode: default"
181 -- The Nothing case should never happen;
182 -- it's the subject of a wad of special-case
183 -- code in cgReturnCon
185 -- can't be a SeqFrame, because we're returning a constructor
187 other -> -- OnStack, or (CaseAlts ret_amode Nothing)
188 sequelToAmode sequel `thenFC` \ ret_amode ->
189 absC (CReturn ret_amode return_info)
194 tycon = dataConTyCon con
195 return_convention = ctrlReturnConvAlg tycon
196 zero_indexed_tag = tag - fIRST_TAG -- Adjust tag to be zero-indexed
197 -- cf AbsCUtils.mkAlgAltsCSwitch
200 case return_convention of
201 UnvectoredReturn _ -> DirectReturn
202 VectoredReturn _ -> StaticVectoredReturn zero_indexed_tag
204 mkUnboxedTupleReturnCode :: Sequel -> Code
205 mkUnboxedTupleReturnCode sequel
207 -- can't update with an unboxed tuple!
208 UpdateCode -> panic "mkUnboxedTupleReturnCode"
210 CaseAlts _ (Just ([(_,(alt_absC,join_lbl))], _)) ->
211 absC (CJump (CLbl join_lbl CodePtrRep))
213 -- can't be a SeqFrame
215 other -> -- OnStack, or (CaseAlts ret_amode something)
216 sequelToAmode sequel `thenFC` \ ret_amode ->
217 absC (CReturn ret_amode DirectReturn)
219 -- This function is used by PrimOps that return enumerated types (i.e.
220 -- all the comparison operators).
222 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
224 mkDynamicAlgReturnCode tycon dyn_tag sequel
225 = case ctrlReturnConvAlg tycon of
228 profCtrC FSLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
229 sequelToAmode sequel `thenFC` \ ret_addr ->
230 absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
232 UnvectoredReturn no_of_constrs ->
234 -- Set tag if necessary
235 -- This is done by a macro, because if we are short of registers
236 -- we don't set TagReg; instead the continuation gets the tag
237 -- by indexing off the info ptr
238 (if no_of_constrs > 1 then
239 absC (CMacroStmt SET_TAG [dyn_tag])
245 sequelToAmode sequel `thenFC` \ ret_addr ->
246 -- Generate the right jump or return
247 absC (CReturn ret_addr DirectReturn)
251 performReturn :: AbstractC -- Simultaneous assignments to perform
252 -> (Sequel -> Code) -- The code to execute to actually do
253 -- the return, given an addressing mode
254 -- for the return address
257 -- this is just a special case of doTailCall, later.
258 performReturn sim_assts finish_code
259 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
261 -- Do the simultaneous assignments,
262 doSimAssts sim_assts `thenC`
264 -- push a return address if necessary
265 -- (after the assignments above, in case we clobber a live
267 pushReturnAddress eob `thenC`
270 adjustSpAndHp args_sp `thenC`
273 finish_code sequel -- "sequel" is `robust' in that it doesn't
274 -- depend on stk-ptr values
277 Returning unboxed tuples. This is mainly to support _ccall_GC_, where
278 we want to do things in a slightly different order to normal:
280 - push return address
281 - adjust stack pointer
283 - assign regs for unboxed tuple (usually just R1 = r)
284 - return to continuation
286 The return address (i.e. stack frame) must be on the stack before
287 doing the call in case the call ends up in the garbage collector.
289 Sadly, the information about the continuation is lost after we push it
290 (in order to avoid pushing it again), so we end up doing a needless
291 indirect jump (ToDo).
294 returnUnboxedTuple :: [CAddrMode] -> Code -> Code
295 returnUnboxedTuple amodes before_jump
296 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
298 -- push a return address if necessary
299 pushReturnAddress eob `thenC`
300 setEndOfBlockInfo (EndOfBlockInfo args_sp (OnStack args_sp)) (
303 adjustSpAndHp args_sp `thenC`
307 let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
310 profCtrC FSLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
312 doTailCall amodes ret_regs
313 mkUnboxedTupleReturnCode
314 (length leftovers) {- fast args arity -}
315 AbsCNop {-no pending assigments-}
316 Nothing {-not a let-no-escape-}
317 False {-node doesn't point-}
322 performTailCall :: Id -> [StgArg] -> Code
323 performTailCall fun args
324 = getCAddrModeAndInfo fun `thenFC` \ (fun', fun_amode, lf_info) ->
325 getArgAmodes args `thenFC` \ arg_amodes ->
326 tailCallFun fun' fun_amode lf_info arg_amodes AbsCNop{- No pending assignments -}
329 Generating code for a tail call to a function (or closure)
336 -> [CAddrMode] -- Arguments
337 -> AbstractC -- Pending simultaneous assignments
338 -- *** GUARANTEED to contain only stack
340 -- In ptic, we don't need to look in
341 -- here to discover all live regs
344 tailCallFun fun fun_amode lf_info arg_amodes pending_assts
345 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
346 -- we use the name of fun', the Id from the environment, rather than
347 -- fun from the STG tree, in case it is a top-level name that we externalised
348 -- (see cgTopRhsClosure).
349 getEntryConvention (idName fun) lf_info
350 (map getAmodeRep arg_amodes) `thenFC` \ entry_conv ->
353 = if node_points then
354 CAssign (CReg node) fun_amode
358 (arg_regs, finish_code, arity)
362 profCtrC FSLIT("TICK_ENT_VIA_NODE") [] `thenC`
363 absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
364 [CVal (nodeRel 0) DataPtrRep]))
366 StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
367 DirectEntry lbl arity regs ->
368 (regs, absC (CJump (CLbl lbl CodePtrRep)),
371 -- set up for a let-no-escape if necessary
372 join_sp = case fun_amode of
373 CJoinPoint sp -> Just sp
376 doTailCall arg_amodes arg_regs (const finish_code) arity
377 (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
380 -- this generic tail call code is used for both function calls and returns.
383 :: [CAddrMode] -- args to pass to function
384 -> [MagicId] -- registers to use
385 -> (Sequel->Code) -- code to perform jump
386 -> Int -- number of "fast" stack arguments
387 -> AbstractC -- pending assignments
388 -> Maybe VirtualSpOffset -- sp offset to trim stack to:
389 -- USED iff destination is a let-no-escape
390 -> Bool -- node points to the closure to enter
393 doTailCall arg_amodes arg_regs finish_code arity pending_assts
394 maybe_join_sp node_points
395 = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
398 (reg_arg_amodes, stk_arg_amodes) = splitAtList arg_regs arg_amodes
399 -- We get some stk_arg_amodes if (a) no regs, or
400 -- (b) args beyond arity
403 = mkAbstractCs (zipWithEqual "assign_to_reg2"
404 assign_to_reg arg_regs reg_arg_amodes)
406 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
408 join_sp = case maybe_join_sp of
409 Just sp -> ASSERT(not (args_sp > sp)) sp
410 -- If ASSERTion fails: Oops: the join point has *lower*
411 -- stack ptrs than the continuation Note that we take
412 -- the Sp point without the return address here. The
413 -- return address is put on by the let-no-escapey thing
417 (fast_stk_amodes, tagged_stk_amodes) =
418 splitAt arity stk_arg_amodes
420 -- eager blackholing, at the end of the basic block.
421 (r1_tmp_asst, bh_asst)
424 -- no: UpdateCode doesn't tell us that we're in a thunk's entry code.
425 -- we might be in a case continuation later down the line. Also,
426 -- we might have pushed a return address on the stack, if we're in
427 -- a case scrut, and still be in the thunk's entry code.
429 (CAssign node_save nodeReg,
430 CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
432 (CLbl mkBlackHoleInfoTableLabel DataPtrRep))
434 node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
436 _ -> (AbsCNop, AbsCNop)
438 -- We can omit tags on the arguments passed to the fast entry point,
439 -- but we have to be careful to fill in the tags on any *extra*
440 -- arguments we're about to push on the stack.
442 mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
443 \ (fast_sp, tagged_arg_assts, tag_assts) ->
445 mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
446 \ (final_sp, fast_arg_assts, _) ->
448 -- adjust the high-water mark if necessary
449 adjustStackHW final_sp `thenC`
451 -- The stack space for the pushed return addess,
452 -- with any args pushed on top, is recorded in final_sp.
454 -- Do the simultaneous assignments,
455 doSimAssts (mkAbstractCs [r1_tmp_asst,
463 -- push a return address if necessary
464 -- (after the assignments above, in case we clobber a live
467 -- DONT push the return address when we're about
468 -- to jump to a let-no-escape: the final tail call
469 -- in the let-no-escape will do this.
470 (if (maybeToBool maybe_join_sp)
472 else pushReturnAddress eob) `thenC`
474 -- Final adjustment of Sp/Hp
475 adjustSpAndHp final_sp `thenC`
477 -- Now decide about semi-tagging
479 semi_tagging_on = opt_DoSemiTagging
481 case (semi_tagging_on, arg_amodes, node_points, sequel) of
484 -- *************** The semi-tagging case ***************
486 {- XXX leave this out for now.
487 ( True, [], True, CaseAlts _ (Just (st_alts, maybe_deflt_join_details))) ->
489 -- Whoppee! Semi-tagging rules OK!
490 -- (a) semi-tagging is switched on
491 -- (b) there are no arguments,
492 -- (c) Node points to the closure
493 -- (d) we have a case-alternative sequel with
494 -- some visible alternatives
496 -- Why is test (c) necessary?
497 -- Usually Node will point to it at this point, because we're
498 -- scrutinsing something which is either a thunk or a
500 -- But not always! The example I came across is when we have
501 -- a top-level Double:
503 -- ... (case lit.3 of ...) ...
504 -- Here, lit.3 is built as a re-entrant thing, which you must enter.
505 -- (OK, the simplifier should have eliminated this, but it's
506 -- easy to deal with the case anyway.)
508 join_details_to_code (load_regs_and_profiling_code, join_lbl)
509 = load_regs_and_profiling_code `mkAbsCStmts`
510 CJump (CLbl join_lbl CodePtrRep)
512 semi_tagged_alts = [ (mkMachInt (fromInt (tag - fIRST_TAG)),
513 join_details_to_code join_details)
514 | (tag, join_details) <- st_alts
518 -- Enter Node (we know infoptr will have the info ptr in it)!
520 CCallProfCtrMacro FSLIT("RET_SEMI_FAILED")
521 [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
522 CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
526 CAssign (CReg infoptr)
527 (CVal (NodeRel zeroOff) DataPtrRep),
529 case maybe_deflt_join_details of
531 CSwitch (CMacroExpr IntRep INFO_TAG [CReg infoptr])
535 CSwitch (CMacroExpr IntRep EVAL_TAG [CReg infoptr])
536 [(mkMachInt 0, enter_jump)]
538 (CMacroExpr IntRep INFO_TAG [CReg infoptr])
540 (join_details_to_code details))
545 -- *************** The non-semi-tagging case ***************
547 other -> finish_code sequel
550 %************************************************************************
552 \subsection[tailCallPrimOp]{@tailCallPrimOp@}
554 %************************************************************************
557 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
558 tailCallPrimOp op args =
559 -- we're going to perform a normal-looking tail call,
560 -- except that *all* the arguments will be in registers.
561 getArgAmodes args `thenFC` \ arg_amodes ->
562 let (arg_regs, leftovers) = assignAllRegs [] (map getAmodeRep arg_amodes)
564 ASSERT(null leftovers) -- no stack-resident args
565 doTailCall arg_amodes arg_regs
566 (const (absC (CJump (CLbl (mkRtsPrimOpLabel op) CodePtrRep))))
567 0 {- arity shouldn't matter, all args in regs -}
568 AbsCNop {- no pending assignments -}
569 Nothing {- not a let-no-escape -}
570 False {- node doesn't point -}
573 %************************************************************************
575 \subsection[doSimAssts]{@doSimAssts@}
577 %************************************************************************
579 @doSimAssts@ happens at the end of every block of code.
580 They are separate because we sometimes do some jiggery-pokery in between.
583 doSimAssts :: AbstractC -> Code
586 = absC (CSimultaneous sim_assts)
589 %************************************************************************
591 \subsection[retAddr]{@Return Addresses@}
593 %************************************************************************
595 We always push the return address just before performing a tail call
596 or return. The reason we leave it until then is because the stack
597 slot that the return address is to go into might contain something
600 If the end of block info is CaseAlts, then we're in the scrutinee of a
601 case expression and the return address is still to be pushed.
603 There are cases where it doesn't look necessary to push the return
604 address: for example, just before doing a return to a known
605 continuation. However, the continuation will expect to find the
606 return address on the stack in case it needs to do a heap check.
609 pushReturnAddress :: EndOfBlockInfo -> Code
610 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts amode _)) =
611 getSpRelOffset args_sp `thenFC` \ sp_rel ->
612 absC (CAssign (CVal sp_rel RetRep) amode)
613 pushReturnAddress (EndOfBlockInfo args_sp sequel@(SeqFrame amode _)) =
614 pushSeqFrame args_sp `thenFC` \ ret_sp ->
615 getSpRelOffset ret_sp `thenFC` \ sp_rel ->
616 absC (CAssign (CVal sp_rel RetRep) amode)
617 pushReturnAddress _ = nopC