ghc/compiler/codeGen/CgTailCall.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CgTailCall.lhs,v 1.26 2000/07/14 08:14:53 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                           mkBlackHoleInfoTableLabel )
  44 import ClosureInfo      ( nodeMustPointToIt,
  45                           getEntryConvention, EntryConvention(..),
  46                           LambdaFormInfo
  47                         )
  48 import CmdLineOpts      ( opt_DoSemiTagging )
  49 import Id               ( Id, idType, idName )
  50 import DataCon          ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
  51 import Maybes           ( assocMaybe, maybeToBool )
  52 import PrimRep          ( PrimRep(..) )
  53 import StgSyn           ( StgArg, GenStgArg(..) )
  54 import Type             ( isUnLiftedType )
  55 import TyCon            ( TyCon )
  56 import PrimOp           ( PrimOp )
  57 import Util             ( zipWithEqual )
  58 import Unique           ( mkPseudoUnique1 )
  59 import Outputable
  60 import Panic            ( panic, assertPanic )
  61 \end{code}
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsection[tailcall-doc]{Documentation}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 \begin{code}
  70 cgTailCall :: Id -> [StgArg] -> Code
  71 \end{code}
  72
  73 Here's the code we generate for a tail call.  (NB there may be no
  74 arguments, in which case this boils down to just entering a variable.)
  75
  76 \begin{itemize}
  77 \item   Adjust the stack ptr to \tr{tailSp + #args}.
  78 \item   Put args in the top locations of the resulting stack.
  79 \item   Make Node point to the function closure.
  80 \item   Enter the function closure.
  81 \end{itemize}
  82
  83 Things to be careful about:
  84 \begin{itemize}
  85 \item   Don't overwrite stack locations before you have finished with
  86         them (remember you need the function and the as-yet-unmoved
  87         arguments).
  88 \item   Preferably, generate no code to replace x by x on the stack (a
  89         common situation in tail-recursion).
  90 \item   Adjust the stack high water mark appropriately.
  91 \end{itemize}
  92
  93 Treat unboxed locals exactly like literals (above) except use the addr
  94 mode for the local instead of (CLit lit) in the assignment.
  95
  96 Case for unboxed @Ids@ first:
  97 \begin{code}
  98 cgTailCall fun []
  99   | isUnLiftedType (idType fun)
 100   = getCAddrMode fun            `thenFC` \ amode ->
 101     performPrimReturn (ppr fun) amode
 102 \end{code}
 103
 104 The general case (@fun@ is boxed):
 105 \begin{code}
 106 cgTailCall fun args = performTailCall fun args
 107 \end{code}
 108
 109 %************************************************************************
 110 %*                                                                      *
 111 \subsection[return-and-tail-call]{Return and tail call}
 112 %*                                                                      *
 113 %************************************************************************
 114
 115 \begin{code}
 116 performPrimReturn :: SDoc       -- Just for debugging (sigh)
 117                   -> CAddrMode  -- The thing to return
 118                   -> Code
 119
 120 performPrimReturn doc amode
 121   = let
 122         kind = getAmodeRep amode
 123         ret_reg = WARN( case kind of { PtrRep -> True; other -> False }, text "primRet" <+> doc <+> pprAmode amode )
 124                   dataReturnConvPrim kind
 125
 126         assign_possibly = case kind of
 127           VoidRep -> AbsCNop
 128           kind -> (CAssign (CReg ret_reg) amode)
 129     in
 130     performReturn assign_possibly (mkPrimReturnCode doc)
 131
 132 mkPrimReturnCode :: SDoc                -- Debugging only
 133                  -> Sequel
 134                  -> Code
 135 mkPrimReturnCode doc UpdateCode = pprPanic "mkPrimReturnCode: Upd" doc
 136 mkPrimReturnCode doc sequel     = sequelToAmode sequel  `thenFC` \ dest_amode ->
 137                                   absC (CReturn dest_amode DirectReturn)
 138                                   -- Direct, no vectoring
 139
 140 -- Constructor is built on the heap; Node is set.
 141 -- All that remains is
 142 --      (a) to set TagReg, if necessary
 143 --      (c) to do the right sort of jump.
 144
 145 mkStaticAlgReturnCode :: DataCon        -- The constructor
 146                       -> Sequel         -- where to return to
 147                       -> Code
 148
 149 mkStaticAlgReturnCode con sequel
 150   =     -- Generate profiling code if necessary
 151     (case return_convention of
 152         VectoredReturn sz -> profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz]
 153         other             -> nopC
 154     )                                   `thenC`
 155
 156         -- Set tag if necessary
 157         -- This is done by a macro, because if we are short of registers
 158         -- we don't set TagReg; instead the continuation gets the tag
 159         -- by indexing off the info ptr
 160     (case return_convention of
 161
 162         UnvectoredReturn no_of_constrs
 163          | no_of_constrs > 1
 164                 -> absC (CMacroStmt SET_TAG [mkIntCLit zero_indexed_tag])
 165
 166         other   -> nopC
 167     )                                   `thenC`
 168
 169         -- Generate the right jump or return
 170     (case sequel of
 171         UpdateCode ->   -- Ha!  We can go direct to the update code,
 172                         -- (making sure to jump to the *correct* update
 173                         --  code.)
 174                         absC (CReturn (CLbl mkUpdInfoLabel CodePtrRep)
 175                                       return_info)
 176
 177         CaseAlts _ (Just (alts, _)) ->  -- Ho! We know the constructor so
 178                                         -- we can go right to the alternative
 179
 180                 case assocMaybe alts tag of
 181                    Just (alt_absC, join_lbl) ->
 182                         absC (CJump (CLbl join_lbl CodePtrRep))
 183                    Nothing -> panic "mkStaticAlgReturnCode: default"
 184                                 -- The Nothing case should never happen;
 185                                 -- it's the subject of a wad of special-case
 186                                 -- code in cgReturnCon
 187
 188         -- can't be a SeqFrame, because we're returning a constructor
 189
 190         other ->        -- OnStack, or (CaseAlts ret_amode Nothing)
 191                     sequelToAmode sequel        `thenFC` \ ret_amode ->
 192                     absC (CReturn ret_amode return_info)
 193     )
 194
 195   where
 196     tag               = dataConTag   con
 197     tycon             = dataConTyCon con
 198     return_convention = ctrlReturnConvAlg tycon
 199     zero_indexed_tag  = tag - fIRST_TAG       -- Adjust tag to be zero-indexed
 200                                               -- cf AbsCUtils.mkAlgAltsCSwitch
 201
 202     return_info =
 203        case return_convention of
 204                 UnvectoredReturn _ -> DirectReturn
 205                 VectoredReturn _   -> StaticVectoredReturn zero_indexed_tag
 206
 207 mkUnboxedTupleReturnCode :: Sequel -> Code
 208 mkUnboxedTupleReturnCode sequel
 209     = case sequel of
 210         -- can't update with an unboxed tuple!
 211         UpdateCode -> panic "mkUnboxedTupleReturnCode"
 212
 213         CaseAlts _ (Just ([(_,(alt_absC,join_lbl))], _)) ->
 214                         absC (CJump (CLbl join_lbl CodePtrRep))
 215
 216         -- can't be a SeqFrame
 217
 218         other ->        -- OnStack, or (CaseAlts ret_amode something)
 219                     sequelToAmode sequel        `thenFC` \ ret_amode ->
 220                     absC (CReturn ret_amode DirectReturn)
 221
 222 -- This function is used by PrimOps that return enumerated types (i.e.
 223 -- all the comparison operators).
 224
 225 mkDynamicAlgReturnCode :: TyCon -> CAddrMode -> Sequel -> Code
 226
 227 mkDynamicAlgReturnCode tycon dyn_tag sequel
 228   = case ctrlReturnConvAlg tycon of
 229         VectoredReturn sz ->
 230
 231                 profCtrC SLIT("TICK_VEC_RETURN") [mkIntCLit sz] `thenC`
 232                 sequelToAmode sequel            `thenFC` \ ret_addr ->
 233                 absC (CReturn ret_addr (DynamicVectoredReturn dyn_tag))
 234
 235         UnvectoredReturn no_of_constrs ->
 236
 237                 -- Set tag if necessary
 238                 -- This is done by a macro, because if we are short of registers
 239                 -- we don't set TagReg; instead the continuation gets the tag
 240                 -- by indexing off the info ptr
 241                 (if no_of_constrs > 1 then
 242                         absC (CMacroStmt SET_TAG [dyn_tag])
 243                 else
 244                         nopC
 245                 )                       `thenC`
 246
 247
 248                 sequelToAmode sequel            `thenFC` \ ret_addr ->
 249                 -- Generate the right jump or return
 250                 absC (CReturn ret_addr DirectReturn)
 251 \end{code}
 252
 253 \begin{code}
 254 performReturn :: AbstractC          -- Simultaneous assignments to perform
 255               -> (Sequel -> Code)   -- The code to execute to actually do
 256                                     -- the return, given an addressing mode
 257                                     -- for the return address
 258               -> Code
 259
 260 -- this is just a special case of doTailCall, later.
 261 performReturn sim_assts finish_code
 262   = getEndOfBlockInfo   `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
 263
 264         -- Do the simultaneous assignments,
 265     doSimAssts sim_assts                `thenC`
 266
 267         -- push a return address if necessary
 268         -- (after the assignments above, in case we clobber a live
 269         --  stack location)
 270     pushReturnAddress eob               `thenC`
 271
 272         -- Adjust Sp/Hp
 273     adjustSpAndHp args_sp               `thenC`
 274
 275         -- Do the return
 276     finish_code sequel          -- "sequel" is `robust' in that it doesn't
 277                                 -- depend on stk-ptr values
 278 \end{code}
 279
 280 Returning unboxed tuples.  This is mainly to support _ccall_GC_, where
 281 we want to do things in a slightly different order to normal:
 282
 283                 - push return address
 284                 - adjust stack pointer
 285                 - r = call(args...)
 286                 - assign regs for unboxed tuple (usually just R1 = r)
 287                 - return to continuation
 288
 289 The return address (i.e. stack frame) must be on the stack before
 290 doing the call in case the call ends up in the garbage collector.
 291
 292 Sadly, the information about the continuation is lost after we push it
 293 (in order to avoid pushing it again), so we end up doing a needless
 294 indirect jump (ToDo).
 295
 296 \begin{code}
 297 returnUnboxedTuple :: [CAddrMode] -> Code -> Code
 298 returnUnboxedTuple amodes before_jump
 299   = getEndOfBlockInfo   `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
 300
 301         -- push a return address if necessary
 302     pushReturnAddress eob               `thenC`
 303     setEndOfBlockInfo (EndOfBlockInfo args_sp (OnStack args_sp)) (
 304
 305         -- Adjust Sp/Hp
 306     adjustSpAndHp args_sp               `thenC`
 307
 308     before_jump                         `thenC`
 309
 310     let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
 311     in
 312
 313     profCtrC SLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
 314
 315     doTailCall amodes ret_regs
 316                 mkUnboxedTupleReturnCode
 317                 (length leftovers)  {- fast args arity -}
 318                 AbsCNop {-no pending assigments-}
 319                 Nothing {-not a let-no-escape-}
 320                 False   {-node doesn't point-}
 321      )
 322 \end{code}
 323
 324 \begin{code}
 325 performTailCall :: Id           -- Function
 326                 -> [StgArg]     -- Args
 327                 -> Code
 328
 329 performTailCall fun args
 330   =     -- Get all the info we have about the function and args and go on to
 331         -- the business end
 332     getCAddrModeAndInfo fun     `thenFC` \ (fun_amode, lf_info) ->
 333     getArgAmodes args           `thenFC` \ arg_amodes ->
 334
 335     tailCallFun
 336                 fun fun_amode lf_info arg_amodes
 337                 AbsCNop {- No pending assignments -}
 338
 339
 340 -- generating code for a tail call to a function (or closure)
 341
 342 tailCallFun :: Id -> CAddrMode  -- Function and its amode
 343                  -> LambdaFormInfo      -- Info about the function
 344                  -> [CAddrMode]         -- Arguments
 345
 346                  -> AbstractC           -- Pending simultaneous assignments
 347                                         -- *** GUARANTEED to contain only stack
 348                                         -- assignments.
 349
 350                                         -- In ptic, we don't need to look in
 351                                         -- here to discover all live regs
 352
 353                  -> Code
 354
 355 tailCallFun fun fun_amode lf_info arg_amodes pending_assts
 356   = nodeMustPointToIt lf_info                   `thenFC` \ node_points ->
 357     getEntryConvention (idName fun) lf_info
 358         (map getAmodeRep arg_amodes)            `thenFC` \ entry_conv ->
 359     let
 360         node_asst
 361           = if node_points then
 362                 CAssign (CReg node) fun_amode
 363             else
 364                 AbsCNop
 365
 366         (arg_regs, finish_code, arity)
 367           = case entry_conv of
 368               ViaNode ->
 369                 ([],
 370                      profCtrC SLIT("TICK_ENT_VIA_NODE") [] `thenC`
 371                      absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
 372                                 [CVal (nodeRel 0) DataPtrRep]))
 373                      , 0)
 374               StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
 375               DirectEntry lbl arity regs  ->
 376                 (regs,   absC (CJump (CLbl lbl CodePtrRep)),
 377                  arity - length regs)
 378
 379         -- set up for a let-no-escape if necessary
 380         join_sp = case fun_amode of
 381                         CJoinPoint sp -> Just sp
 382                         other         -> Nothing
 383     in
 384     doTailCall arg_amodes arg_regs (const finish_code) arity
 385                 (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
 386
 387
 388 -- this generic tail call code is used for both function calls and returns.
 389
 390 doTailCall
 391         :: [CAddrMode]                  -- args to pass to function
 392         -> [MagicId]                    -- registers to use
 393         -> (Sequel->Code)               -- code to perform jump
 394         -> Int                          -- number of "fast" stack arguments
 395         -> AbstractC                    -- pending assignments
 396         -> Maybe VirtualSpOffset        -- sp offset to trim stack to:
 397                                         -- USED iff destination is a let-no-escape
 398         -> Bool                         -- node points to the closure to enter
 399         -> Code
 400
 401 doTailCall arg_amodes arg_regs finish_code arity pending_assts
 402                 maybe_join_sp node_points
 403   = getEndOfBlockInfo   `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
 404
 405     let
 406         (reg_arg_amodes, stk_arg_amodes) = splitAt (length arg_regs) arg_amodes
 407             -- We get some stk_arg_amodes if (a) no regs, or
 408             --                               (b) args beyond arity
 409
 410         reg_arg_assts
 411           = mkAbstractCs (zipWithEqual "assign_to_reg2"
 412                                 assign_to_reg arg_regs reg_arg_amodes)
 413
 414         assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
 415
 416         join_sp = case maybe_join_sp of
 417                         Just sp -> ASSERT(not (args_sp > sp)) sp
 418               -- If ASSERTion fails: Oops: the join point has *lower*
 419               -- stack ptrs than the continuation Note that we take
 420               -- the Sp point without the return address here.   The
 421               -- return address is put on by the let-no-escapey thing
 422               -- when it finishes.
 423                         Nothing -> args_sp
 424
 425         (fast_stk_amodes, tagged_stk_amodes) =
 426                 splitAt arity stk_arg_amodes
 427
 428         -- eager blackholing, at the end of the basic block.
 429         (r1_tmp_asst, bh_asst)
 430          = case sequel of
 431 #if 0
 432         -- no: UpdateCode doesn't tell us that we're in a thunk's entry code.
 433         -- we might be in a case continuation later down the line.  Also,
 434         -- we might have pushed a return address on the stack, if we're in
 435         -- a case scrut, and still be in the thunk's entry code.
 436                 UpdateCode ->
 437                    (CAssign node_save nodeReg,
 438                     CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
 439                                   PtrRep)
 440                             (CLbl mkBlackHoleInfoTableLabel DataPtrRep))
 441                    where
 442                      node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
 443 #endif
 444                 _ -> (AbsCNop, AbsCNop)
 445     in
 446         -- We can omit tags on the arguments passed to the fast entry point,
 447         -- but we have to be careful to fill in the tags on any *extra*
 448         -- arguments we're about to push on the stack.
 449
 450         mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
 451                             \ (fast_sp, tagged_arg_assts, tag_assts) ->
 452
 453         mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
 454                             \ (final_sp, fast_arg_assts, _) ->
 455
 456         -- adjust the high-water mark if necessary
 457         adjustStackHW final_sp  `thenC`
 458
 459                 -- The stack space for the pushed return addess,
 460                 -- with any args pushed on top, is recorded in final_sp.
 461
 462                         -- Do the simultaneous assignments,
 463         doSimAssts (mkAbstractCs [r1_tmp_asst,
 464                                   pending_assts,
 465                                   reg_arg_assts,
 466                                   fast_arg_assts,
 467                                   tagged_arg_assts,
 468                                   tag_assts])   `thenC`
 469         absC bh_asst `thenC`
 470
 471                 -- push a return address if necessary
 472                 -- (after the assignments above, in case we clobber a live
 473                 --  stack location)
 474
 475                 -- DONT push the return address when we're about
 476                 -- to jump to a let-no-escape: the final tail call
 477                 -- in the let-no-escape will do this.
 478         (if (maybeToBool maybe_join_sp)
 479                 then nopC
 480                 else pushReturnAddress eob)             `thenC`
 481
 482                 -- Final adjustment of Sp/Hp
 483         adjustSpAndHp final_sp          `thenC`
 484
 485                 -- Now decide about semi-tagging
 486         let
 487                 semi_tagging_on = opt_DoSemiTagging
 488         in
 489         case (semi_tagging_on, arg_amodes, node_points, sequel) of
 490
 491         --
 492         -- *************** The semi-tagging case ***************
 493         --
 494         {- XXX leave this out for now.
 495               (   True,            [],          True,        CaseAlts _ (Just (st_alts, maybe_deflt_join_details))) ->
 496
 497                 -- Whoppee!  Semi-tagging rules OK!
 498                 -- (a) semi-tagging is switched on
 499                 -- (b) there are no arguments,
 500                 -- (c) Node points to the closure
 501                 -- (d) we have a case-alternative sequel with
 502                 --      some visible alternatives
 503
 504                 -- Why is test (c) necessary?
 505                 -- Usually Node will point to it at this point, because we're
 506                 -- scrutinsing something which is either a thunk or a
 507                 -- constructor.
 508                 -- But not always!  The example I came across is when we have
 509                 -- a top-level Double:
 510                 --      lit.3 = D# 3.000
 511                 --      ... (case lit.3 of ...) ...
 512                 -- Here, lit.3 is built as a re-entrant thing, which you must enter.
 513                 -- (OK, the simplifier should have eliminated this, but it's
 514                 --  easy to deal with the case anyway.)
 515                 let
 516                     join_details_to_code (load_regs_and_profiling_code, join_lbl)
 517                         = load_regs_and_profiling_code          `mkAbsCStmts`
 518                           CJump (CLbl join_lbl CodePtrRep)
 519
 520                     semi_tagged_alts = [ (mkMachInt (fromInt (tag - fIRST_TAG)),
 521                                           join_details_to_code join_details)
 522                                        | (tag, join_details) <- st_alts
 523                                        ]
 524
 525                     enter_jump
 526                       -- Enter Node (we know infoptr will have the info ptr in it)!
 527                       = mkAbstractCs [
 528                         CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
 529                                         [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
 530                         CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
 531                 in
 532                         -- Final switch
 533                 absC (mkAbstractCs [
 534                             CAssign (CReg infoptr)
 535                                     (CVal (NodeRel zeroOff) DataPtrRep),
 536
 537                             case maybe_deflt_join_details of
 538                                 Nothing ->
 539                                     CSwitch (CMacroExpr IntRep INFO_TAG [CReg infoptr])
 540                                         (semi_tagged_alts)
 541                                         (enter_jump)
 542                                 Just (_, details) ->
 543                                     CSwitch (CMacroExpr IntRep EVAL_TAG [CReg infoptr])
 544                                      [(mkMachInt 0, enter_jump)]
 545                                      (CSwitch
 546                                          (CMacroExpr IntRep INFO_TAG [CReg infoptr])
 547                                          (semi_tagged_alts)
 548                                          (join_details_to_code details))
 549                 ])
 550                 -}
 551
 552         --
 553         -- *************** The non-semi-tagging case ***************
 554         --
 555               other -> finish_code sequel
 556 \end{code}
 557
 558 %************************************************************************
 559 %*                                                                      *
 560 \subsection[tailCallPrimOp]{@tailCallPrimOp@}
 561 %*                                                                      *
 562 %************************************************************************
 563
 564 \begin{code}
 565 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
 566 tailCallPrimOp op args =
 567     -- we're going to perform a normal-looking tail call,
 568     -- except that *all* the arguments will be in registers.
 569     getArgAmodes args           `thenFC` \ arg_amodes ->
 570     let (arg_regs, leftovers) = assignAllRegs [] (map getAmodeRep arg_amodes)
 571     in
 572     ASSERT(null leftovers) -- no stack-resident args
 573     doTailCall arg_amodes arg_regs
 574         (const (absC (CJump (CLbl (mkRtsPrimOpLabel op) CodePtrRep))))
 575         0       {- arity shouldn't matter, all args in regs -}
 576         AbsCNop {- no pending assignments -}
 577         Nothing {- not a let-no-escape -}
 578         False   {- node doesn't point -}
 579 \end{code}
 580
 581 %************************************************************************
 582 %*                                                                      *
 583 \subsection[doSimAssts]{@doSimAssts@}
 584 %*                                                                      *
 585 %************************************************************************
 586
 587 @doSimAssts@ happens at the end of every block of code.
 588 They are separate because we sometimes do some jiggery-pokery in between.
 589
 590 \begin{code}
 591 doSimAssts :: AbstractC -> Code
 592
 593 doSimAssts sim_assts
 594   = absC (CSimultaneous sim_assts)
 595 \end{code}
 596
 597 %************************************************************************
 598 %*                                                                      *
 599 \subsection[retAddr]{@Return Addresses@}
 600 %*                                                                      *
 601 %************************************************************************
 602
 603 We always push the return address just before performing a tail call
 604 or return.  The reason we leave it until then is because the stack
 605 slot that the return address is to go into might contain something
 606 useful.
 607
 608 If the end of block info is CaseAlts, then we're in the scrutinee of a
 609 case expression and the return address is still to be pushed.
 610
 611 There are cases where it doesn't look necessary to push the return
 612 address: for example, just before doing a return to a known
 613 continuation.  However, the continuation will expect to find the
 614 return address on the stack in case it needs to do a heap check.
 615
 616 \begin{code}
 617 pushReturnAddress :: EndOfBlockInfo -> Code
 618 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts amode _)) =
 619     getSpRelOffset args_sp                       `thenFC` \ sp_rel ->
 620     absC (CAssign (CVal sp_rel RetRep) amode)
 621 pushReturnAddress (EndOfBlockInfo args_sp sequel@(SeqFrame amode _)) =
 622     pushSeqFrame args_sp                         `thenFC` \ ret_sp ->
 623     getSpRelOffset ret_sp                        `thenFC` \ sp_rel ->
 624     absC (CAssign (CVal sp_rel RetRep) amode)
 625 pushReturnAddress _ = nopC
 626 \end{code}