ghc/compiler/codeGen/CgTailCall.lhs

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