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