ghc/compiler/codeGen/CgTailCall.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CgTailCall.lhs,v 1.22 1999/06/22 08:00:00 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, mkAbsCStmts, 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(..),
  45                           LambdaFormInfo
  46                         )
  47 import CmdLineOpts      ( opt_DoSemiTagging )
  48 import Id               ( Id, idType, idName )
  49 import DataCon          ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
  50 import Const            ( mkMachInt )
  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 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           -- Function
 325                 -> [StgArg]     -- Args
 326                 -> Code
 327
 328 performTailCall fun args
 329   =     -- Get all the info we have about the function and args and go on to
 330         -- the business end
 331     getCAddrModeAndInfo fun     `thenFC` \ (fun_amode, lf_info) ->
 332     getArgAmodes args           `thenFC` \ arg_amodes ->
 333
 334     tailCallFun
 335                 fun fun_amode lf_info arg_amodes
 336                 AbsCNop {- No pending assignments -}
 337
 338
 339 -- generating code for a tail call to a function (or closure)
 340
 341 tailCallFun :: Id -> CAddrMode  -- Function and its amode
 342                  -> LambdaFormInfo      -- Info about the function
 343                  -> [CAddrMode]         -- Arguments
 344
 345                  -> AbstractC           -- Pending simultaneous assignments
 346                                         -- *** GUARANTEED to contain only stack
 347                                         -- assignments.
 348
 349                                         -- In ptic, we don't need to look in
 350                                         -- here to discover all live regs
 351
 352                  -> Code
 353
 354 tailCallFun fun fun_amode lf_info arg_amodes pending_assts
 355   = nodeMustPointToIt lf_info                   `thenFC` \ node_points ->
 356     getEntryConvention (idName fun) lf_info
 357         (map getAmodeRep arg_amodes)            `thenFC` \ entry_conv ->
 358     let
 359         node_asst
 360           = if node_points then
 361                 CAssign (CReg node) fun_amode
 362             else
 363                 AbsCNop
 364
 365         (arg_regs, finish_code, arity)
 366           = case entry_conv of
 367               ViaNode ->
 368                 ([],
 369                      profCtrC SLIT("TICK_ENT_VIA_NODE") [] `thenC`
 370                      absC (CJump (CMacroExpr CodePtrRep ENTRY_CODE
 371                                 [CVal (nodeRel 0) DataPtrRep]))
 372                      , 0)
 373               StdEntry lbl -> ([], absC (CJump (CLbl lbl CodePtrRep)), 0)
 374               DirectEntry lbl arity regs  ->
 375                 (regs,   absC (CJump (CLbl lbl CodePtrRep)),
 376                  arity - length regs)
 377
 378         -- set up for a let-no-escape if necessary
 379         join_sp = case fun_amode of
 380                         CJoinPoint sp -> Just sp
 381                         other         -> Nothing
 382     in
 383     doTailCall arg_amodes arg_regs (const finish_code) arity
 384                 (mkAbstractCs [node_asst,pending_assts]) join_sp node_points
 385
 386
 387 -- this generic tail call code is used for both function calls and returns.
 388
 389 doTailCall
 390         :: [CAddrMode]                  -- args to pass to function
 391         -> [MagicId]                    -- registers to use
 392         -> (Sequel->Code)               -- code to perform jump
 393         -> Int                          -- number of "fast" stack arguments
 394         -> AbstractC                    -- pending assignments
 395         -> Maybe VirtualSpOffset        -- sp offset to trim stack to:
 396                                         -- USED iff destination is a let-no-escape
 397         -> Bool                         -- node points to the closure to enter
 398         -> Code
 399
 400 doTailCall arg_amodes arg_regs finish_code arity pending_assts
 401                 maybe_join_sp node_points
 402   = getEndOfBlockInfo   `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
 403
 404     let
 405         no_of_args = length arg_amodes
 406
 407         (reg_arg_amodes, stk_arg_amodes) = splitAt (length arg_regs) arg_amodes
 408             -- We get some stk_arg_amodes if (a) no regs, or
 409             --                               (b) args beyond arity
 410
 411         reg_arg_assts
 412           = mkAbstractCs (zipWithEqual "assign_to_reg2"
 413                                 assign_to_reg arg_regs reg_arg_amodes)
 414
 415         assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
 416
 417         join_sp = case maybe_join_sp of
 418                         Just sp -> ASSERT(not (args_sp > sp)) sp
 419               -- If ASSERTion fails: Oops: the join point has *lower*
 420               -- stack ptrs than the continuation Note that we take
 421               -- the Sp point without the return address here.   The
 422               -- return address is put on by the let-no-escapey thing
 423               -- when it finishes.
 424                         Nothing -> args_sp
 425
 426         (fast_stk_amodes, tagged_stk_amodes) =
 427                 splitAt arity stk_arg_amodes
 428     in
 429         -- We can omit tags on the arguments passed to the fast entry point,
 430         -- but we have to be careful to fill in the tags on any *extra*
 431         -- arguments we're about to push on the stack.
 432
 433         mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
 434                             \ (fast_sp, tagged_arg_assts, tag_assts) ->
 435
 436         mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
 437                             \ (final_sp, fast_arg_assts, _) ->
 438
 439         -- adjust the high-water mark if necessary
 440         adjustStackHW final_sp  `thenC`
 441
 442                 -- The stack space for the pushed return addess,
 443                 -- with any args pushed on top, is recorded in final_sp.
 444
 445                 -- Do the simultaneous assignments,
 446         doSimAssts (mkAbstractCs [pending_assts,
 447                                   reg_arg_assts,
 448                                   fast_arg_assts,
 449                                   tagged_arg_assts,
 450                                   tag_assts])   `thenC`
 451
 452                 -- push a return address if necessary
 453                 -- (after the assignments above, in case we clobber a live
 454                 --  stack location)
 455
 456                 -- DONT push the return address when we're about
 457                 -- to jump to a let-no-escape: the final tail call
 458                 -- in the let-no-escape will do this.
 459         (if (maybeToBool maybe_join_sp)
 460                 then nopC
 461                 else pushReturnAddress eob)             `thenC`
 462
 463                 -- Final adjustment of Sp/Hp
 464         adjustSpAndHp final_sp          `thenC`
 465
 466                 -- Now decide about semi-tagging
 467         let
 468                 semi_tagging_on = opt_DoSemiTagging
 469         in
 470         case (semi_tagging_on, arg_amodes, node_points, sequel) of
 471
 472         --
 473         -- *************** The semi-tagging case ***************
 474         --
 475         {- XXX leave this out for now.
 476               (   True,            [],          True,        CaseAlts _ (Just (st_alts, maybe_deflt_join_details))) ->
 477
 478                 -- Whoppee!  Semi-tagging rules OK!
 479                 -- (a) semi-tagging is switched on
 480                 -- (b) there are no arguments,
 481                 -- (c) Node points to the closure
 482                 -- (d) we have a case-alternative sequel with
 483                 --      some visible alternatives
 484
 485                 -- Why is test (c) necessary?
 486                 -- Usually Node will point to it at this point, because we're
 487                 -- scrutinsing something which is either a thunk or a
 488                 -- constructor.
 489                 -- But not always!  The example I came across is when we have
 490                 -- a top-level Double:
 491                 --      lit.3 = D# 3.000
 492                 --      ... (case lit.3 of ...) ...
 493                 -- Here, lit.3 is built as a re-entrant thing, which you must enter.
 494                 -- (OK, the simplifier should have eliminated this, but it's
 495                 --  easy to deal with the case anyway.)
 496                 let
 497                     join_details_to_code (load_regs_and_profiling_code, join_lbl)
 498                         = load_regs_and_profiling_code          `mkAbsCStmts`
 499                           CJump (CLbl join_lbl CodePtrRep)
 500
 501                     semi_tagged_alts = [ (mkMachInt (fromInt (tag - fIRST_TAG)),
 502                                           join_details_to_code join_details)
 503                                        | (tag, join_details) <- st_alts
 504                                        ]
 505
 506                     enter_jump
 507                       -- Enter Node (we know infoptr will have the info ptr in it)!
 508                       = mkAbstractCs [
 509                         CCallProfCtrMacro SLIT("RET_SEMI_FAILED")
 510                                         [CMacroExpr IntRep INFO_TAG [CReg infoptr]],
 511                         CJump (CMacroExpr CodePtrRep ENTRY_CODE [CReg infoptr]) ]
 512                 in
 513                         -- Final switch
 514                 absC (mkAbstractCs [
 515                             CAssign (CReg infoptr)
 516                                     (CVal (NodeRel zeroOff) DataPtrRep),
 517
 518                             case maybe_deflt_join_details of
 519                                 Nothing ->
 520                                     CSwitch (CMacroExpr IntRep INFO_TAG [CReg infoptr])
 521                                         (semi_tagged_alts)
 522                                         (enter_jump)
 523                                 Just (_, details) ->
 524                                     CSwitch (CMacroExpr IntRep EVAL_TAG [CReg infoptr])
 525                                      [(mkMachInt 0, enter_jump)]
 526                                      (CSwitch
 527                                          (CMacroExpr IntRep INFO_TAG [CReg infoptr])
 528                                          (semi_tagged_alts)
 529                                          (join_details_to_code details))
 530                 ])
 531                 -}
 532
 533         --
 534         -- *************** The non-semi-tagging case ***************
 535         --
 536               other -> finish_code sequel
 537 \end{code}
 538
 539 %************************************************************************
 540 %*                                                                      *
 541 \subsection[tailCallPrimOp]{@tailCallPrimOp@}
 542 %*                                                                      *
 543 %************************************************************************
 544
 545 \begin{code}
 546 tailCallPrimOp :: PrimOp -> [StgArg] -> Code
 547 tailCallPrimOp op args =
 548     -- we're going to perform a normal-looking tail call,
 549     -- except that *all* the arguments will be in registers.
 550     getArgAmodes args           `thenFC` \ arg_amodes ->
 551     let (arg_regs, leftovers) = assignAllRegs [] (map getAmodeRep arg_amodes)
 552     in
 553     ASSERT(null leftovers) -- no stack-resident args
 554     doTailCall arg_amodes arg_regs
 555         (const (absC (CJump (CLbl (mkRtsPrimOpLabel op) CodePtrRep))))
 556         0       {- arity shouldn't matter, all args in regs -}
 557         AbsCNop {- no pending assignments -}
 558         Nothing {- not a let-no-escape -}
 559         False   {- node doesn't point -}
 560 \end{code}
 561
 562 %************************************************************************
 563 %*                                                                      *
 564 \subsection[doSimAssts]{@doSimAssts@}
 565 %*                                                                      *
 566 %************************************************************************
 567
 568 @doSimAssts@ happens at the end of every block of code.
 569 They are separate because we sometimes do some jiggery-pokery in between.
 570
 571 \begin{code}
 572 doSimAssts :: AbstractC -> Code
 573
 574 doSimAssts sim_assts
 575   = absC (CSimultaneous sim_assts)
 576 \end{code}
 577
 578 %************************************************************************
 579 %*                                                                      *
 580 \subsection[retAddr]{@Return Addresses@}
 581 %*                                                                      *
 582 %************************************************************************
 583
 584 We always push the return address just before performing a tail call
 585 or return.  The reason we leave it until then is because the stack
 586 slot that the return address is to go into might contain something
 587 useful.
 588
 589 If the end of block info is CaseAlts, then we're in the scrutinee of a
 590 case expression and the return address is still to be pushed.
 591
 592 There are cases where it doesn't look necessary to push the return
 593 address: for example, just before doing a return to a known
 594 continuation.  However, the continuation will expect to find the
 595 return address on the stack in case it needs to do a heap check.
 596
 597 \begin{code}
 598 pushReturnAddress :: EndOfBlockInfo -> Code
 599 pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts amode _)) =
 600     getSpRelOffset args_sp                       `thenFC` \ sp_rel ->
 601     absC (CAssign (CVal sp_rel RetRep) amode)
 602 pushReturnAddress (EndOfBlockInfo args_sp sequel@(SeqFrame amode _)) =
 603     pushSeqFrame args_sp                         `thenFC` \ ret_sp ->
 604     getSpRelOffset ret_sp                        `thenFC` \ sp_rel ->
 605     absC (CAssign (CVal sp_rel RetRep) amode)
 606 pushReturnAddress _ = nopC
 607 \end{code}