compiler/codeGen/StgCmmExpr.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Stg to C-- code generation: expressions
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module StgCmmExpr ( cgExpr ) where
  10
  11 #define FAST_STRING_NOT_NEEDED
  12 #include "HsVersions.h"
  13
  14 import {-# SOURCE #-} StgCmmBind ( cgBind )
  15
  16 import StgCmmMonad
  17 import StgCmmHeap
  18 import StgCmmEnv
  19 import StgCmmCon
  20 import StgCmmProf
  21 import StgCmmLayout
  22 import StgCmmPrim
  23 import StgCmmHpc
  24 import StgCmmTicky
  25 import StgCmmUtils
  26 import StgCmmClosure
  27
  28 import StgSyn
  29
  30 import MkZipCfgCmm
  31 import BlockId
  32 import Cmm()
  33 import CmmExpr
  34 import CoreSyn
  35 import DataCon
  36 import ForeignCall
  37 import Id
  38 import PrimOp
  39 import TyCon
  40 import CostCentre       ( CostCentreStack, currentCCS )
  41 import Maybes
  42 import Util
  43 import FastString
  44 import Outputable
  45 import UniqSupply
  46
  47 ------------------------------------------------------------------------
  48 --              cgExpr: the main function
  49 ------------------------------------------------------------------------
  50
  51 cgExpr  :: StgExpr -> FCode ()
  52
  53 cgExpr (StgApp fun args)     = cgIdApp fun args
  54 cgExpr (StgOpApp op args ty) = cgOpApp op args ty
  55 cgExpr (StgConApp con args)  = cgConApp con args
  56 cgExpr (StgSCC cc expr)   = do { emitSetCCC cc; cgExpr expr }
  57 cgExpr (StgTick m n expr) = do { emit (mkTickBox m n); cgExpr expr }
  58 cgExpr (StgLit lit)       = do cmm_lit <- cgLit lit
  59                                emitReturn [CmmLit cmm_lit]
  60
  61 cgExpr (StgLet binds expr)             = do { cgBind binds;     cgExpr expr }
  62 cgExpr (StgLetNoEscape _ _ binds expr) =
  63   do { us <- newUniqSupply
  64      ; let join_id = mkBlockId (uniqFromSupply us)
  65      ; cgLneBinds join_id binds
  66      ; cgExpr expr
  67      ; emit $ mkLabel join_id}
  68
  69 cgExpr (StgCase expr _live_vars _save_vars bndr srt alt_type alts) =
  70   cgCase expr bndr srt alt_type alts
  71
  72 cgExpr (StgLam {}) = panic "cgExpr: StgLam"
  73
  74 ------------------------------------------------------------------------
  75 --              Let no escape
  76 ------------------------------------------------------------------------
  77
  78 {- Generating code for a let-no-escape binding, aka join point is very
  79 very similar to what we do for a case expression.  The duality is
  80 between
  81         let-no-escape x = b
  82         in e
  83 and
  84         case e of ... -> b
  85
  86 That is, the RHS of 'x' (ie 'b') will execute *later*, just like
  87 the alternative of the case; it needs to be compiled in an environment
  88 in which all volatile bindings are forgotten, and the free vars are
  89 bound only to stable things like stack locations..  The 'e' part will
  90 execute *next*, just like the scrutinee of a case. -}
  91
  92 -------------------------
  93 cgLneBinds :: BlockId -> StgBinding -> FCode ()
  94 cgLneBinds join_id (StgNonRec bndr rhs)
  95   = do  { local_cc <- saveCurrentCostCentre
  96                 -- See Note [Saving the current cost centre]
  97         ; info <- cgLetNoEscapeRhs join_id local_cc bndr rhs
  98         ; addBindC (cg_id info) info }
  99
 100 cgLneBinds join_id (StgRec pairs)
 101   = do  { local_cc <- saveCurrentCostCentre
 102         ; new_bindings <- fixC (\ new_bindings -> do
 103                 { addBindsC new_bindings
 104                 ; listFCs [ cgLetNoEscapeRhs join_id local_cc b e
 105                           | (b,e) <- pairs ] })
 106         ; addBindsC new_bindings }
 107
 108
 109 -------------------------
 110 cgLetNoEscapeRhs
 111     :: BlockId          -- join point for successor of let-no-escape
 112     -> Maybe LocalReg   -- Saved cost centre
 113     -> Id
 114     -> StgRhs
 115     -> FCode CgIdInfo
 116
 117 cgLetNoEscapeRhs join_id local_cc bndr rhs =
 118   do { (info, rhs_body) <- getCodeR $ cgLetNoEscapeRhsBody local_cc bndr rhs
 119      ; let (bid, _) = expectJust "cgLetNoEscapeRhs" $ maybeLetNoEscape info
 120      ; emit (outOfLine $ mkLabel bid <*> rhs_body <*> mkBranch join_id)
 121      ; return info
 122      }
 123
 124 cgLetNoEscapeRhsBody
 125     :: Maybe LocalReg   -- Saved cost centre
 126     -> Id
 127     -> StgRhs
 128     -> FCode CgIdInfo
 129 cgLetNoEscapeRhsBody local_cc bndr (StgRhsClosure cc _bi _ _upd _ args body)
 130   = cgLetNoEscapeClosure bndr local_cc cc (nonVoidIds args) body
 131 cgLetNoEscapeRhsBody local_cc bndr (StgRhsCon cc con args)
 132   = cgLetNoEscapeClosure bndr local_cc cc [] (StgConApp con args)
 133         -- For a constructor RHS we want to generate a single chunk of
 134         -- code which can be jumped to from many places, which will
 135         -- return the constructor. It's easy; just behave as if it
 136         -- was an StgRhsClosure with a ConApp inside!
 137
 138 -------------------------
 139 cgLetNoEscapeClosure
 140         :: Id                   -- binder
 141         -> Maybe LocalReg       -- Slot for saved current cost centre
 142         -> CostCentreStack      -- XXX: *** NOT USED *** why not?
 143         -> [NonVoid Id]         -- Args (as in \ args -> body)
 144         -> StgExpr              -- Body (as in above)
 145         -> FCode CgIdInfo
 146
 147 cgLetNoEscapeClosure bndr cc_slot _unused_cc args body
 148   = do  { arg_regs <- forkProc $ do
 149                 { restoreCurrentCostCentre cc_slot
 150                 ; arg_regs <- bindArgsToRegs args
 151                 ; altHeapCheck arg_regs (cgExpr body)
 152                         -- Using altHeapCheck just reduces
 153                         -- instructions to save on stack
 154                 ; return arg_regs }
 155         ; return $ lneIdInfo bndr arg_regs}
 156
 157
 158 ------------------------------------------------------------------------
 159 --              Case expressions
 160 ------------------------------------------------------------------------
 161
 162 {- Note [Compiling case expressions]
 163 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 164 It is quite interesting to decide whether to put a heap-check at the
 165 start of each alternative.  Of course we certainly have to do so if
 166 the case forces an evaluation, or if there is a primitive op which can
 167 trigger GC.
 168
 169 A more interesting situation is this (a Plan-B situation)
 170
 171         !P!;
 172         ...P...
 173         case x# of
 174           0#      -> !Q!; ...Q...
 175           default -> !R!; ...R...
 176
 177 where !x! indicates a possible heap-check point. The heap checks
 178 in the alternatives *can* be omitted, in which case the topmost
 179 heapcheck will take their worst case into account.
 180
 181 In favour of omitting !Q!, !R!:
 182
 183  - *May* save a heap overflow test,
 184    if ...P... allocates anything.
 185
 186  - We can use relative addressing from a single Hp to
 187    get at all the closures so allocated.
 188
 189  - No need to save volatile vars etc across heap checks
 190    in !Q!, !R!
 191
 192 Against omitting !Q!, !R!
 193
 194   - May put a heap-check into the inner loop.  Suppose
 195         the main loop is P -> R -> P -> R...
 196         Q is the loop exit, and only it does allocation.
 197     This only hurts us if P does no allocation.  If P allocates,
 198     then there is a heap check in the inner loop anyway.
 199
 200   - May do more allocation than reqd.  This sometimes bites us
 201     badly.  For example, nfib (ha!) allocates about 30\% more space if the
 202     worst-casing is done, because many many calls to nfib are leaf calls
 203     which don't need to allocate anything.
 204
 205     We can un-allocate, but that costs an instruction
 206
 207 Neither problem hurts us if there is only one alternative.
 208
 209 Suppose the inner loop is P->R->P->R etc.  Then here is
 210 how many heap checks we get in the *inner loop* under various
 211 conditions
 212
 213   Alooc   Heap check in branches (!Q!, !R!)?
 214   P Q R      yes     no (absorb to !P!)
 215 --------------------------------------
 216   n n n      0          0
 217   n y n      0          1
 218   n . y      1          1
 219   y . y      2          1
 220   y . n      1          1
 221
 222 Best choices: absorb heap checks from Q and R into !P! iff
 223   a) P itself does some allocation
 224 or
 225   b) P does allocation, or there is exactly one alternative
 226
 227 We adopt (b) because that is more likely to put the heap check at the
 228 entry to a function, when not many things are live.  After a bunch of
 229 single-branch cases, we may have lots of things live
 230
 231 Hence: two basic plans for
 232
 233         case e of r { alts }
 234
 235 ------ Plan A: the general case ---------
 236
 237         ...save current cost centre...
 238
 239         ...code for e,
 240            with sequel (SetLocals r)
 241
 242         ...restore current cost centre...
 243         ...code for alts...
 244         ...alts do their own heap checks
 245
 246 ------ Plan B: special case when ---------
 247   (i)  e does not allocate or call GC
 248   (ii) either upstream code performs allocation
 249        or there is just one alternative
 250
 251   Then heap allocation in the (single) case branch
 252   is absorbed by the upstream check.
 253   Very common example: primops on unboxed values
 254
 255         ...code for e,
 256            with sequel (SetLocals r)...
 257
 258         ...code for alts...
 259         ...no heap check...
 260 -}
 261
 262
 263
 264 -------------------------------------
 265 data GcPlan
 266   = GcInAlts            -- Put a GC check at the start the case alternatives,
 267         [LocalReg]      -- which binds these registers
 268         SRT             -- using this SRT
 269   | NoGcInAlts          -- The scrutinee is a primitive value, or a call to a
 270                         -- primitive op which does no GC.  Absorb the allocation
 271                         -- of the case alternative(s) into the upstream check
 272
 273 -------------------------------------
 274 -- See Note [case on Bool]
 275 cgCase :: StgExpr -> Id -> SRT -> AltType -> [StgAlt] -> FCode ()
 276 {-
 277 cgCase (OpApp ) bndr srt AlgAlt [(DataAlt flase, a2]
 278   | isBoolTy (idType bndr)
 279   , isDeadBndr bndr
 280   =
 281 -}
 282
 283 cgCase scrut bndr srt alt_type alts
 284   = do  { up_hp_usg <- getVirtHp        -- Upstream heap usage
 285         ; let ret_bndrs = chooseReturnBndrs bndr alt_type alts
 286               alt_regs  = map idToReg ret_bndrs
 287               simple_scrut = isSimpleScrut scrut alt_type
 288               gcInAlts | not simple_scrut = True
 289                        | isSingleton alts = False
 290                        | up_hp_usg > 0    = False
 291                        | otherwise        = True
 292               gc_plan = if gcInAlts then GcInAlts alt_regs srt else NoGcInAlts
 293
 294         ; mb_cc <- maybeSaveCostCentre simple_scrut
 295         ; withSequel (AssignTo alt_regs gcInAlts) (cgExpr scrut)
 296         ; restoreCurrentCostCentre mb_cc
 297
 298   -- JD: We need Note: [Better Alt Heap Checks]
 299         ; _ <- bindArgsToRegs ret_bndrs
 300         ; cgAlts gc_plan (NonVoid bndr) alt_type alts }
 301
 302 -----------------
 303 maybeSaveCostCentre :: Bool -> FCode (Maybe LocalReg)
 304 maybeSaveCostCentre simple_scrut
 305   | simple_scrut = saveCurrentCostCentre
 306   | otherwise    = return Nothing
 307
 308
 309 -----------------
 310 isSimpleScrut :: StgExpr -> AltType -> Bool
 311 -- Simple scrutinee, does not block or allocate; hence safe to amalgamate
 312 -- heap usage from alternatives into the stuff before the case
 313 -- NB: if you get this wrong, and claim that the expression doesn't allocate
 314 --     when it does, you'll deeply mess up allocation
 315 isSimpleScrut (StgOpApp op _ _) _          = isSimpleOp op
 316 isSimpleScrut (StgLit _)       _           = True       -- case 1# of { 0# -> ..; ... }
 317 isSimpleScrut (StgApp _ [])    (PrimAlt _) = True       -- case x# of { 0# -> ..; ... }
 318 isSimpleScrut _                _           = False
 319
 320 isSimpleOp :: StgOp -> Bool
 321 -- True iff the op cannot block or allocate
 322 isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) = not (playSafe safe)
 323 isSimpleOp (StgFCallOp (DNCall _) _)                   = False         -- Safe!
 324 isSimpleOp (StgPrimOp op)                              = not (primOpOutOfLine op)
 325 isSimpleOp (StgPrimCallOp _)                           = False
 326
 327 -----------------
 328 chooseReturnBndrs :: Id -> AltType -> [StgAlt] -> [NonVoid Id]
 329 -- These are the binders of a case that are assigned
 330 -- by the evaluation of the scrutinee
 331 -- Only non-void ones come back
 332 chooseReturnBndrs bndr (PrimAlt _) _alts
 333   = nonVoidIds [bndr]
 334
 335 chooseReturnBndrs _bndr (UbxTupAlt _) [(_, ids, _, _)]
 336   = nonVoidIds ids      -- 'bndr' is not assigned!
 337
 338 chooseReturnBndrs bndr (AlgAlt _) _alts
 339   = nonVoidIds [bndr]   -- Only 'bndr' is assigned
 340
 341 chooseReturnBndrs bndr PolyAlt _alts
 342   = nonVoidIds [bndr]   -- Only 'bndr' is assigned
 343
 344 chooseReturnBndrs _ _ _ = panic "chooseReturnBndrs"
 345         -- UbxTupALt has only one alternative
 346
 347 -------------------------------------
 348 cgAlts :: GcPlan -> NonVoid Id -> AltType -> [StgAlt] -> FCode ()
 349 -- At this point the result of the case are in the binders
 350 cgAlts gc_plan _bndr PolyAlt [(_, _, _, rhs)]
 351   = maybeAltHeapCheck gc_plan (cgExpr rhs)
 352
 353 cgAlts gc_plan _bndr (UbxTupAlt _) [(_, _, _, rhs)]
 354   = maybeAltHeapCheck gc_plan (cgExpr rhs)
 355         -- Here bndrs are *already* in scope, so don't rebind them
 356
 357 cgAlts gc_plan bndr (PrimAlt _) alts
 358   = do  { tagged_cmms <- cgAltRhss gc_plan bndr alts
 359
 360         ; let bndr_reg = CmmLocal (idToReg bndr)
 361               (DEFAULT,deflt) = head tagged_cmms
 362                 -- PrimAlts always have a DEFAULT case
 363                 -- and it always comes first
 364
 365               tagged_cmms' = [(lit,code)
 366                              | (LitAlt lit, code) <- tagged_cmms]
 367         ; emit (mkCmmLitSwitch (CmmReg bndr_reg) tagged_cmms' deflt) }
 368
 369 cgAlts gc_plan bndr (AlgAlt tycon) alts
 370   = do  { tagged_cmms <- cgAltRhss gc_plan bndr alts
 371
 372         ; let fam_sz   = tyConFamilySize tycon
 373               bndr_reg = CmmLocal (idToReg bndr)
 374               mb_deflt = case tagged_cmms of
 375                            ((DEFAULT,rhs) : _) -> Just rhs
 376                            _other              -> Nothing
 377                 -- DEFAULT is always first, if present
 378
 379               branches = [ (dataConTagZ con, cmm)
 380                          | (DataAlt con, cmm) <- tagged_cmms ]
 381
 382                     -- Is the constructor tag in the node reg?
 383         ; if isSmallFamily fam_sz
 384           then let      -- Yes, bndr_reg has constr. tag in ls bits
 385                    tag_expr = cmmConstrTag1 (CmmReg bndr_reg)
 386                    branches' = [(tag+1,branch) | (tag,branch) <- branches]
 387                 in
 388                 emitSwitch tag_expr branches' mb_deflt 1 fam_sz
 389
 390            else         -- No, get tag from info table
 391                 let -- Note that ptr _always_ has tag 1
 392                     -- when the family size is big enough
 393                     untagged_ptr = cmmRegOffB bndr_reg (-1)
 394                     tag_expr = getConstrTag (untagged_ptr)
 395                  in
 396                  emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1) }
 397
 398 cgAlts _ _ _ _ = panic "cgAlts"
 399         -- UbxTupAlt and PolyAlt have only one alternative
 400
 401 -------------------
 402 cgAltRhss :: GcPlan -> NonVoid Id -> [StgAlt] -> FCode [(AltCon, CmmAGraph)]
 403 cgAltRhss gc_plan bndr alts
 404   = forkAlts (map cg_alt alts)
 405   where
 406     base_reg = idToReg bndr
 407     cg_alt :: StgAlt -> FCode (AltCon, CmmAGraph)
 408     cg_alt (con, bndrs, _uses, rhs)
 409       = getCodeR                  $
 410         maybeAltHeapCheck gc_plan $
 411         do { _ <- bindConArgs con base_reg bndrs
 412            ; cgExpr rhs
 413            ; return con }
 414
 415 maybeAltHeapCheck :: GcPlan -> FCode a -> FCode a
 416 maybeAltHeapCheck NoGcInAlts code
 417   = code
 418 maybeAltHeapCheck (GcInAlts regs _) code
 419   = altHeapCheck regs code
 420
 421 -----------------------------------------------------------------------------
 422 --      Tail calls
 423 -----------------------------------------------------------------------------
 424
 425 cgConApp :: DataCon -> [StgArg] -> FCode ()
 426 cgConApp con stg_args
 427   | isUnboxedTupleCon con       -- Unboxed tuple: assign and return
 428   = do { arg_exprs <- getNonVoidArgAmodes stg_args
 429        ; tickyUnboxedTupleReturn (length arg_exprs)
 430        ; emitReturn arg_exprs }
 431
 432   | otherwise   --  Boxed constructors; allocate and return
 433   = ASSERT( stg_args `lengthIs` dataConRepArity con )
 434     do  { (idinfo, init) <- buildDynCon (dataConWorkId con) currentCCS con stg_args
 435                 -- The first "con" says that the name bound to this closure is
 436                 -- is "con", which is a bit of a fudge, but it only affects profiling
 437
 438         ; emit init
 439         ; emitReturn [idInfoToAmode idinfo] }
 440
 441
 442 cgIdApp :: Id -> [StgArg] -> FCode ()
 443 cgIdApp fun_id [] | isVoidId fun_id = emitReturn []
 444 cgIdApp fun_id args
 445   = do  { fun_info <- getCgIdInfo fun_id
 446         ; case maybeLetNoEscape fun_info of
 447             Just (blk_id, lne_regs) -> cgLneJump blk_id lne_regs args
 448             Nothing -> cgTailCall fun_id fun_info args }
 449
 450 cgLneJump :: BlockId -> [LocalReg] -> [StgArg] -> FCode ()
 451 cgLneJump blk_id lne_regs args  -- Join point; discard sequel
 452   = do  { cmm_args <- getNonVoidArgAmodes args
 453         ; emit (mkMultiAssign lne_regs cmm_args
 454                 <*> mkBranch blk_id) }
 455
 456 cgTailCall :: Id -> CgIdInfo -> [StgArg] -> FCode ()
 457 cgTailCall fun_id fun_info args = do
 458     dflags <- getDynFlags
 459     case (getCallMethod dflags fun_name (idCafInfo fun_id) lf_info (length args)) of
 460
 461             -- A value in WHNF, so we can just return it.
 462         ReturnIt -> emitReturn [fun]    -- ToDo: does ReturnIt guarantee tagged?
 463
 464         EnterIt -> ASSERT( null args )  -- Discarding arguments
 465                 do { let fun' = CmmLoad fun (cmmExprType fun)
 466                    ; [ret,call] <- forkAlts [
 467                         getCode $ emitReturn [fun],     -- Is tagged; no need to untag
 468                         getCode $ do -- emit (mkAssign nodeReg fun)
 469                          emitCall (NativeNodeCall, NativeReturn)
 470                                   (entryCode fun') [fun]]  -- Not tagged
 471                    ; emit (mkCmmIfThenElse (cmmIsTagged fun) ret call) }
 472
 473         SlowCall -> do      -- A slow function call via the RTS apply routines
 474                 { tickySlowCall lf_info args
 475                 ; emit $ mkComment $ mkFastString "slowCall"
 476                 ; slowCall fun args }
 477
 478         -- A direct function call (possibly with some left-over arguments)
 479         DirectEntry lbl arity -> do
 480                 { tickyDirectCall arity args
 481                 ; if node_points then
 482                     do emit $ mkComment $ mkFastString "directEntry"
 483                        emit (mkAssign nodeReg fun)
 484                        directCall lbl arity args
 485                   else do emit $ mkComment $ mkFastString "directEntry else"
 486                           directCall lbl arity args }
 487
 488         JumpToIt {} -> panic "cgTailCall"       -- ???
 489
 490   where
 491     fun_name    = idName            fun_id
 492     fun         = idInfoToAmode     fun_info
 493     lf_info     = cgIdInfoLF        fun_info
 494     node_points = nodeMustPointToIt lf_info
 495
 496
 497 {- Note [case on Bool]
 498    ~~~~~~~~~~~~~~~~~~~
 499 A case on a Boolean value does two things:
 500   1. It looks up the Boolean in a closure table and assigns the
 501      result to the binder.
 502   2. It branches to the True or False case through analysis
 503      of the closure assigned to the binder.
 504 But the indirection through the closure table is unnecessary
 505 if the assignment to the binder will be dead code (use isDeadBndr).
 506
 507 The following example illustrates how badly the code turns out:
 508   STG:
 509     case <=## [ww_s7Hx y_s7HD] of wild2_sbH8 {
 510       GHC.Bool.False -> <true  code> // sbH8 dead
 511       GHC.Bool.True  -> <false code> // sbH8 dead
 512     };
 513   Cmm:
 514     _s7HD::F64 = F64[_sbH7::I64 + 7];  // MidAssign
 515     _ccsW::I64 = %MO_F_Le_W64(_s7Hx::F64, _s7HD::F64);  // MidAssign
 516     // emitReturn  // MidComment
 517     _sbH8::I64 = I64[ghczmprim_GHCziBool_Bool_closure_tbl + (_ccsW::I64 << 3)];  // MidAssign
 518     _ccsX::I64 = _sbH8::I64 & 7;  // MidAssign
 519     if (_ccsX::I64 >= 2) goto ccsH; else goto ccsI;  // LastCondBranch
 520
 521 The assignments to _sbH8 and _ccsX are completely unnecessary.
 522 Instead, we should branch based on the value of _ccsW.
 523 -}
 524
 525 {- Note [Better Alt Heap Checks]
 526 If two function calls can share a return point, then they will also
 527 get the same info table. Therefore, it's worth our effort to make
 528 those opportunities appear as frequently as possible.
 529
 530 Here are a few examples of how it should work:
 531
 532   STG:
 533     case f x of
 534       True  -> <True code -- including allocation>
 535       False -> <False code>
 536   Cmm:
 537       r = call f(x) returns to L;
 538    L:
 539       if r & 7 >= 2 goto L1 else goto L2;
 540    L1:
 541       if Hp > HpLim then
 542         r = gc(r);
 543         goto L;
 544       <True code -- including allocation>
 545    L2:
 546       <False code>
 547 Note that the code following both the call to f(x) and the code to gc(r)
 548 should be the same, which will allow the common blockifier to discover
 549 that they are the same. Therefore, both function calls will return to the same
 550 block, and they will use the same info table.
 551
 552 Here's an example of the Cmm code we want from a primOp.
 553 The primOp doesn't produce an info table for us to reuse, but that's okay:
 554 we should still generate the same code:
 555   STG:
 556     case f x of
 557       0 -> <0-case code -- including allocation>
 558       _ -> <default-case code>
 559   Cmm:
 560       r = a +# b;
 561    L:
 562       if r == 0 then goto L1 else goto L2;
 563    L1:
 564       if Hp > HpLim then
 565         r = gc(r);
 566         goto L;
 567       <0-case code -- including allocation>
 568    L2:
 569       <default-case code>
 570 -}