ghc/compiler/codeGen/CgTailCall.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CgTailCall.lhs,v 1.29 2000/12/06 13:19:49 simonmar Exp $
   5 %
   6 %********************************************************
   7 %*                                                      *
   8 \section[CgTailCall]{Tail calls: converting @StgApps@}
   9 %*                                                      *
  10 %********************************************************
  11
  12 \begin{code}
  13 module CgTailCall (
  14         cgTailCall,
  15         performReturn, performPrimReturn,
  16         mkStaticAlgReturnCode, mkDynamicAlgReturnCode,
  17         mkUnboxedTupleReturnCode, returnUnboxedTuple,
  18         mkPrimReturnCode,
  19
  20         tailCallFun,
  21         tailCallPrimOp,
  22         doTailCall,
  23
  24         pushReturnAddress
  25     ) where
  26
  27 #include "HsVersions.h"
  28
  29 import CgMonad
  30 import AbsCSyn
  31 import PprAbsC          ( pprAmode )
  32
  33 import AbsCUtils        ( mkAbstractCs, getAmodeRep )
  34 import CgBindery        ( getArgAmodes, getCAddrMode, getCAddrModeAndInfo )
  35 import CgRetConv        ( dataReturnConvPrim,
  36                           ctrlReturnConvAlg, CtrlReturnConvention(..),
  37                           assignAllRegs, assignRegs
  38                         )
  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
  46                         )
  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 )
  58 import Outputable
  59 import Panic            ( panic, assertPanic )
  60 \end{code}
  61
  62 %************************************************************************
  63 %*                                                                      *
  64 \subsection[tailcall-doc]{Documentation}
  65 %*                                                                      *
  66 %************************************************************************
  67
  68 \begin{code}
  69 cgTailCall :: Id -> [StgArg] -> Code
  70 \end{code}
  71
  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.)
  74
  75 \begin{itemize}
  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.
  80 \end{itemize}
  81
  82 Things to be careful about:
  83 \begin{itemize}
  84 \item   Don't overwrite stack locations before you have finished with
  85         them (remember you need the function and the as-yet-unmoved
  86         arguments).
  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.
  90 \end{itemize}
  91
  92 Treat unboxed locals exactly like literals (above) except use the addr
  93 mode for the local instead of (CLit lit) in the assignment.
  94
  95 Case for unboxed @Ids@ first:
  96 \begin{code}
  97 cgTailCall fun []
  98   | isUnLiftedType (idType fun)
  99   = getCAddrMode fun            `thenFC` \ amode ->
 100     performPrimReturn (ppr fun) amode
 101 \end{code}
 102
 103 The general case (@fun@ is boxed):
 104 \begin{code}
 105 cgTailCall fun args = performTailCall fun args
 106 \end{code}
 107
 108 %************************************************************************
 109 %*                                                                      *
 110 \subsection[return-and-tail-call]{Return and tail call}
 111 %*                                                                      *
 112 %************************************************************************
 113
 114 \begin{code}
 115 performPrimReturn :: SDoc       -- Just for debugging (sigh)
 116                   -> CAddrMode  -- The thing to return
 117                   -> Code
 118
 119 performPrimReturn doc amode
 120   = let
 121         kind = getAmodeRep amode
 122         ret_reg = WARN( case kind of { PtrRep -> True; other -> False }, text "primRet" <+> doc <+> pprAmode amode )
 123                   dataReturnConvPrim kind
 124
 125         assign_possibly = case kind of
 126           VoidRep -> AbsCNop
 127           kind -> (CAssign (CReg ret_reg) amode)
 128     in
 129     performReturn assign_possibly (mkPrimReturnCode doc)
 130
 131 mkPrimReturnCode :: SDoc                -- Debugging only
 132                  -> Sequel
 133                  -> Code
 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
 138
 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.
 143
 144 mkStaticAlgReturnCode :: DataCon        -- The constructor
 145                       -> Sequel         -- where to return to
 146                       -> Code
 147
 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]
 152         other             -> nopC
 153     )                                   `thenC`
 154
 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
 160
 161         UnvectoredReturn no_of_constrs
 162          | no_of_constrs > 1
 163                 -> absC (CMacroStmt SET_TAG [mkIntCLit zero_indexed_tag])
 164
 165         other   -> nopC
 166     )                                   `thenC`
 167
 168         -- Generate the right jump or return
 169     (case sequel of
 170         UpdateCode ->   -- Ha!  We can go direct to the update code,
 171                         -- (making sure to jump to the *correct* update
 172                         --  code.)
 173                         absC (CReturn (CLbl mkUpdInfoLabel CodePtrRep)
 174                                       return_info)
 175
 176         CaseAlts _ (Just (alts, _)) ->  -- Ho! We know the constructor so
 177                                         -- we can go right to the alternative
 178
 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
 186
 187         -- can't be a SeqFrame, because we're returning a constructor
 188
 189         other ->        -- OnStack, or (CaseAlts ret_amode Nothing)
 190                     sequelToAmode sequel        `thenFC` \ ret_amode ->
 191                     absC (CReturn ret_amode return_info)
 192     )
 193
 194   where
 195     tag               = dataConTag   con
 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
 200
 201     return_info =
 202        case return_convention of
 203                 UnvectoredReturn _ -> DirectReturn
 204                 VectoredReturn _   -> StaticVectoredReturn zero_indexed_tag
 205
 206 mkUnboxedTupleReturnCode :: Sequel -> Code
 207 mkUnboxedTupleReturnCode sequel
 208     = case sequel of
 209         -- can't update with an unboxed tuple!
 210         UpdateCode -> panic "mkUnboxedTupleReturnCode"
 211
 212         CaseAlts _ (Just ([(_,(alt_absC,join_lbl))], _)) ->
 213                         absC (CJump (CLbl join_lbl CodePtrRep))
 214
 215         -- can't be a SeqFrame
 216
 217         other ->        -- OnStack, or (CaseAlts ret_amode something)
 218                     sequelToAmode sequel        `thenFC` \ ret_amode ->
 219                     absC (CReturn ret_amode DirectReturn)
 220
 221 -- This function is used by PrimOps that return enumerated types (i.e.
 222 -- all the comparison operators).
 223
 224 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
 225
 226 mkDynamicAlgReturnCode tycon dyn_tag sequel
 227   = case ctrlReturnConvAlg tycon of
 228         VectoredReturn sz ->
 229
 230                 profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
 231                 sequelToAmode sequel            `thenFC` \ ret_addr ->
 232                 absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
 233
 234         UnvectoredReturn no_of_constrs ->
 235
 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])
 242                 else
 243                         nopC
 244                 )                       `thenC`
 245
 246
 247                 sequelToAmode sequel            `thenFC` \ ret_addr ->
 248                 -- Generate the right jump or return
 249                 absC (CReturn ret_addr DirectReturn)
 250 \end{code}
 251
 252 \begin{code}
 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
 257               -> Code
 258
 259 -- this is just a special case of doTailCall, later.
 260 performReturn sim_assts finish_code
 261   = getEndOfBlockInfo   `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
 262
 263         -- Do the simultaneous assignments,
 264     doSimAssts sim_assts                `thenC`
 265
 266         -- push a return address if necessary
 267         -- (after the assignments above, in case we clobber a live
 268         --  stack location)
 269     pushReturnAddress eob               `thenC`
 270
 271         -- Adjust Sp/Hp
 272     adjustSpAndHp args_sp               `thenC`
 273
 274         -- Do the return
 275     finish_code sequel          -- "sequel" is `robust' in that it doesn't
 276                                 -- depend on stk-ptr values
 277 \end{code}
 278
 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:
 281
 282                 - push return address
 283                 - adjust stack pointer
 284                 - r = call(args...)
 285                 - assign regs for unboxed tuple (usually just R1 = r)
 286                 - return to continuation
 287
 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.
 290
 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).
 294
 295 \begin{code}
 296 returnUnboxedTuple :: [CAddrMode] -> Code -> Code
 297 returnUnboxedTuple amodes before_jump
 298   = getEndOfBlockInfo   `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
 299
 300         -- push a return address if necessary
 301     pushReturnAddress eob               `thenC`
 302     setEndOfBlockInfo (EndOfBlockInfo args_sp (OnStack args_sp)) (
 303
 304         -- Adjust Sp/Hp
 305     adjustSpAndHp args_sp               `thenC`
 306
 307     before_jump                         `thenC`
 308
 309     let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
 310     in
 311
 312     profCtrC SLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
 313
 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-}
 320      )
 321 \end{code}
 322
 323 \begin{code}
 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 -}
 329 \end{code}
 330
 331 Generating code for a tail call to a function (or closure)
 332
 333 \begin{code}
 334 tailCallFun
 335          :: Id                          -- Function
 336          -> CAddrMode
 337          -> LambdaFormInfo
 338          -> [CAddrMode]                 -- Arguments
 339          -> AbstractC                   -- Pending simultaneous assignments
 340                                           -- *** GUARANTEED to contain only stack
 341                                           -- assignments.
 342                                         -- In ptic, we don't need to look in
 343                                         -- here to discover all live regs
 344          -> Code
 345
 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 ->
 353     let
 354         node_asst
 355           = if node_points then
 356                 CAssign (CReg node) fun_amode
 357             else
 358                 AbsCNop
 359
 360         (arg_regs, finish_code, arity)
 361           = case entry_conv of
 362               ViaNode ->
 363                 ([],
 364                      profCtrC SLIT("TICK_ENT_VIA_NODE") [] `thenC`
 365                      absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
 366                                 [CVal (nodeRel 0) DataPtrRep]))
 367                      , 0)
 368               StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
 369               DirectEntry lbl arity regs  ->
 370                 (regs,   absC (CJump (CLbl lbl CodePtrRep)),
 371                  arity - length regs)
 372
 373         -- set up for a let-no-escape if necessary
 374         join_sp = case fun_amode of
 375                         CJoinPoint sp -> Just sp
 376                         other         -> Nothing
 377     in
 378     doTailCall arg_amodes arg_regs (const finish_code) arity
 379                 (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
 380
 381
 382 -- this generic tail call code is used for both function calls and returns.
 383
 384 doTailCall
 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
 393         -> Code
 394
 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) ->
 398
 399     let
 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
 403
 404         reg_arg_assts
 405           = mkAbstractCs (zipWithEqual "assign_to_reg2"
 406                                 assign_to_reg arg_regs reg_arg_amodes)
 407
 408         assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
 409
 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
 416               -- when it finishes.
 417                         Nothing -> args_sp
 418
 419         (fast_stk_amodes, tagged_stk_amodes) =
 420                 splitAt arity stk_arg_amodes
 421
 422         -- eager blackholing, at the end of the basic block.
 423         (r1_tmp_asst, bh_asst)
 424          = case sequel of
 425 #if 0
 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.
 430                 UpdateCode ->
 431                    (CAssign node_save nodeReg,
 432                     CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
 433                                   PtrRep)
 434                             (CLbl mkBlackHoleInfoTableLabel DataPtrRep))
 435                    where
 436                      node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
 437 #endif
 438                 _ -> (AbsCNop, AbsCNop)
 439     in
 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.
 443
 444         mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
 445                             \ (fast_sp, tagged_arg_assts, tag_assts) ->
 446
 447         mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
 448                             \ (final_sp, fast_arg_assts, _) ->
 449
 450         -- adjust the high-water mark if necessary
 451         adjustStackHW final_sp  `thenC`
 452
 453                 -- The stack space for the pushed return addess,
 454                 -- with any args pushed on top, is recorded in final_sp.
 455
 456                         -- Do the simultaneous assignments,
 457         doSimAssts (mkAbstractCs [r1_tmp_asst,
 458                                   pending_assts,
 459                                   reg_arg_assts,
 460                                   fast_arg_assts,
 461                                   tagged_arg_assts,
 462                                   tag_assts])   `thenC`
 463         absC bh_asst `thenC`
 464
 465                 -- push a return address if necessary
 466                 -- (after the assignments above, in case we clobber a live
 467                 --  stack location)
 468
 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)
 473                 then nopC
 474                 else pushReturnAddress eob)             `thenC`
 475
 476                 -- Final adjustment of Sp/Hp
 477         adjustSpAndHp final_sp          `thenC`
 478
 479                 -- Now decide about semi-tagging
 480         let
 481                 semi_tagging_on = opt_DoSemiTagging
 482         in
 483         case (semi_tagging_on, arg_amodes, node_points, sequel) of
 484
 485         --
 486         -- *************** The semi-tagging case ***************
 487         --
 488         {- XXX leave this out for now.
 489               (   True,            [],          True,        CaseAlts _ (Just (st_alts, maybe_deflt_join_details))) ->
 490
 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
 497
 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
 501                 -- constructor.
 502                 -- But not always!  The example I came across is when we have
 503                 -- a top-level Double:
 504                 --      lit.3 = D# 3.000
 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.)
 509                 let
 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)
 513
 514                     semi_tagged_alts = [ (mkMachInt (fromInt (tag - fIRST_TAG)),
 515                                           join_details_to_code join_details)
 516                                        | (tag, join_details) <- st_alts
 517                                        ]
 518
 519                     enter_jump
 520                       -- Enter Node (we know infoptr will have the info ptr in it)!
 521                       = mkAbstractCs [
 522                         CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
 523                                         [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
 524                         CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
 525                 in
 526                         -- Final switch
 527                 absC (mkAbstractCs [
 528                             CAssign (CReg infoptr)
 529                                     (CVal (NodeRel zeroOff) DataPtrRep),
 530
 531                             case maybe_deflt_join_details of
 532                                 Nothing ->
 533                                     CSwitch (CMacroExpr IntRep INFO_TAG [CReg infoptr])
 534                                         (semi_tagged_alts)
 535                                         (enter_jump)
 536                                 Just (_, details) ->
 537                                     CSwitch (CMacroExpr IntRep EVAL_TAG [CReg infoptr])
 538                                      [(mkMachInt 0, enter_jump)]
 539                                      (CSwitch
 540                                          (CMacroExpr IntRep INFO_TAG [CReg infoptr])
 541                                          (semi_tagged_alts)
 542                                          (join_details_to_code details))
 543                 ])
 544                 -}
 545
 546         --
 547         -- *************** The non-semi-tagging case ***************
 548         --
 549               other -> finish_code sequel
 550 \end{code}
 551
 552 %************************************************************************
 553 %*                                                                      *
 554 \subsection[tailCallPrimOp]{@tailCallPrimOp@}
 555 %*                                                                      *
 556 %************************************************************************
 557
 558 \begin{code}
 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)
 565     in
 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 -}
 573 \end{code}
 574
 575 %************************************************************************
 576 %*                                                                      *
 577 \subsection[doSimAssts]{@doSimAssts@}
 578 %*                                                                      *
 579 %************************************************************************
 580
 581 @doSimAssts@ happens at the end of every block of code.
 582 They are separate because we sometimes do some jiggery-pokery in between.
 583
 584 \begin{code}
 585 doSimAssts :: AbstractC -> Code
 586
 587 doSimAssts sim_assts
 588   = absC (CSimultaneous sim_assts)
 589 \end{code}
 590
 591 %************************************************************************
 592 %*                                                                      *
 593 \subsection[retAddr]{@Return Addresses@}
 594 %*                                                                      *
 595 %************************************************************************
 596
 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
 600 useful.
 601
 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.
 604
 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.
 609
 610 \begin{code}
 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
 620 \end{code}