2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
7 module CgCase ( cgCase, saveVolatileVarsAndRegs,
8 restoreCurrentCostCentre
11 #include "HsVersions.h"
13 import {-# SOURCE #-} CgExpr ( cgExpr )
45 import Control.Monad (when)
50 = GCMayHappen -- The scrutinee may involve GC, so everything must be
51 -- tidy before the code for the scrutinee.
53 | NoGC -- The scrutinee is a primitive value, or a call to a
54 -- primitive op which does no GC. Hence the case can
55 -- be done inline, without tidying up first.
58 It is quite interesting to decide whether to put a heap-check
59 at the start of each alternative. Of course we certainly have
60 to do so if the case forces an evaluation, or if there is a primitive
61 op which can trigger GC.
63 A more interesting situation is this:
70 default -> !C!; ...C...
73 where \tr{!x!} indicates a possible heap-check point. The heap checks
74 in the alternatives {\em can} be omitted, in which case the topmost
75 heapcheck will take their worst case into account.
77 In favour of omitting \tr{!B!}, \tr{!C!}:
79 - {\em May} save a heap overflow test,
80 if ...A... allocates anything. The other advantage
81 of this is that we can use relative addressing
82 from a single Hp to get at all the closures so allocated.
84 - No need to save volatile vars etc across the case
88 - May do more allocation than reqd. This sometimes bites us
89 badly. For example, nfib (ha!) allocates about 30\% more space if the
90 worst-casing is done, because many many calls to nfib are leaf calls
91 which don't need to allocate anything.
93 This never hurts us if there is only one alternative.
105 Special case #1: case of literal.
108 cgCase (StgLit lit) _live_in_whole_case _live_in_alts bndr
109 alt_type@(PrimAlt _) alts
110 = do { tmp_reg <- bindNewToTemp bndr
111 ; cm_lit <- cgLit lit
112 ; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))
113 ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
116 Special case #2: scrutinising a primitive-typed variable. No
117 evaluation required. We don't save volatile variables, nor do we do a
118 heap-check in the alternatives. Instead, the heap usage of the
119 alternatives is worst-cased and passed upstream. This can result in
120 allocating more heap than strictly necessary, but it will sometimes
121 eliminate a heap check altogether.
124 cgCase (StgApp v []) _live_in_whole_case _live_in_alts bndr
125 alt_type@(PrimAlt _) alts
126 -- Note [ticket #3132]: we might be looking at a case of a lifted Id
127 -- that was cast to an unlifted type. The Id will always be bottom,
128 -- but we don't want the code generator to fall over here. If we
129 -- just emit an assignment here, the assignment will be
130 -- type-incorrect Cmm. Hence we check that the types match, and if
131 -- they don't we'll fall through and emit the usual enter/return
132 -- code. Test case: codeGen/should_compile/3132.hs
133 | isUnLiftedType (idType v)
135 -- However, we also want to allow an assignment to be generated
136 -- in the case when the types are compatible, because this allows
137 -- some slightly-dodgy but occasionally-useful casts to be used,
138 -- such as in RtClosureInspect where we cast an HValue to a MutVar#
139 -- so we can print out the contents of the MutVar#. If we generate
140 -- code that enters the HValue, then we'll get a runtime panic, because
141 -- the HValue really is a MutVar#. The types are compatible though,
142 -- so we can just generate an assignment.
145 do { -- Careful! we can't just bind the default binder to the same thing
146 -- as the scrutinee, since it might be a stack location, and having
147 -- two bindings pointing at the same stack locn doesn't work (it
148 -- confuses nukeDeadBindings). Hence, use a new temp.
149 when (not reps_compatible) $
150 panic "cgCase: reps do not match, perhaps a dodgy unsafeCoerce?"
151 ; v_info <- getCgIdInfo v
152 ; amode <- idInfoToAmode v_info
153 ; tmp_reg <- bindNewToTemp bndr
154 ; stmtC (CmmAssign (CmmLocal tmp_reg) amode)
155 ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
157 reps_compatible = idCgRep v == idCgRep bndr
160 Special case #3: inline PrimOps and foreign calls.
163 cgCase (StgOpApp (StgPrimOp primop) args _)
164 _live_in_whole_case live_in_alts bndr alt_type alts
165 | not (primOpOutOfLine primop)
166 = cgInlinePrimOp primop args bndr alt_type live_in_alts alts
169 TODO: Case-of-case of primop can probably be done inline too (but
170 maybe better to translate it out beforehand). See
171 ghc/lib/misc/PackedString.lhs for examples where this crops up (with
174 Special case #4: inline foreign calls: an unsafe foreign call can be done
175 right here, just like an inline primop.
178 cgCase (StgOpApp (StgFCallOp fcall _) args _)
179 _live_in_whole_case live_in_alts _bndr _alt_type alts
180 | unsafe_foreign_call
181 = ASSERT( isSingleton alts )
182 do -- *must* be an unboxed tuple alt.
183 -- exactly like the cgInlinePrimOp case for unboxed tuple alts..
184 { res_tmps <- mapFCs bindNewToTemp non_void_res_ids
185 ; let res_hints = map (typeForeignHint.idType) non_void_res_ids
186 ; cgForeignCall (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts
189 (_, res_ids, _, rhs) = head alts
190 non_void_res_ids = filter (nonVoidArg . idCgRep) res_ids
194 CCall (CCallSpec _ _ s) -> not (playSafe s)
198 Special case: scrutinising a non-primitive variable.
199 This can be done a little better than the general case, because
200 we can reuse/trim the stack slot holding the variable (if it is in one).
203 cgCase (StgApp fun args)
204 _live_in_whole_case live_in_alts bndr alt_type alts
205 = do { fun_info <- getCgIdInfo fun
206 ; arg_amodes <- getArgAmodes args
208 -- Nuking dead bindings *before* calculating the saves is the
209 -- value-add here. We might end up freeing up some slots currently
210 -- occupied by variables only required for the call.
211 -- NOTE: we need to look up the variables used in the call before
212 -- doing this, because some of them may not be in the environment
214 ; nukeDeadBindings live_in_alts
215 ; (save_assts, alts_eob_info, maybe_cc_slot)
216 <- saveVolatileVarsAndRegs live_in_alts
219 <- forkEval alts_eob_info
220 (allocStackTop retAddrSizeW >> nopC)
221 (do { deAllocStackTop retAddrSizeW
222 ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
224 ; setEndOfBlockInfo scrut_eob_info
225 (performTailCall fun_info arg_amodes save_assts) }
228 Note about return addresses: we *always* push a return address, even
229 if because of an optimisation we end up jumping direct to the return
230 code (not through the address itself). The alternatives always assume
231 that the return address is on the stack. The return address is
232 required in case the alternative performs a heap check, since it
233 encodes the liveness of the slots in the activation record.
235 On entry to the case alternative, we can re-use the slot containing
236 the return address immediately after the heap check. That's what the
237 deAllocStackTop call is doing above.
239 Finally, here is the general case.
242 cgCase expr live_in_whole_case live_in_alts bndr alt_type alts
243 = do { -- Figure out what volatile variables to save
244 nukeDeadBindings live_in_whole_case
246 ; (save_assts, alts_eob_info, maybe_cc_slot)
247 <- saveVolatileVarsAndRegs live_in_alts
249 -- Save those variables right now!
250 ; emitStmts save_assts
252 -- generate code for the alts
254 <- forkEval alts_eob_info
255 (do { nukeDeadBindings live_in_alts
256 ; allocStackTop retAddrSizeW -- space for retn address
258 (do { deAllocStackTop retAddrSizeW
259 ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
261 ; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
265 There's a lot of machinery going on behind the scenes to manage the
266 stack pointer here. forkEval takes the virtual Sp and free list from
267 the first argument, and turns that into the *real* Sp for the second
268 argument. It also uses this virtual Sp as the args-Sp in the EOB info
269 returned, so that the scrutinee will trim the real Sp back to the
270 right place before doing whatever it does.
271 --SDM (who just spent an hour figuring this out, and didn't want to
274 Why don't we push the return address just before evaluating the
275 scrutinee? Because the slot reserved for the return address might
276 contain something useful, so we wait until performing a tail call or
277 return before pushing the return address (see
278 CgTailCall.pushReturnAddress).
280 This also means that the environment doesn't need to know about the
281 free stack slot for the return address (for generating bitmaps),
282 because we don't reserve it until just before the eval.
284 TODO!! Problem: however, we have to save the current cost centre
285 stack somewhere, because at the eval point the current CCS might be
286 different. So we pick a free stack slot and save CCCS in it. One
287 consequence of this is that activation records on the stack don't
288 follow the layout of closures when we're profiling. The CCS could be
289 anywhere within the record).
291 %************************************************************************
295 %************************************************************************
298 cgInlinePrimOp :: PrimOp -> [StgArg] -> Id -> AltType -> StgLiveVars
299 -> [(AltCon, [Id], [Bool], StgExpr)]
301 cgInlinePrimOp primop args bndr (PrimAlt _) live_in_alts alts
302 | isVoidArg (idCgRep bndr)
303 = ASSERT( con == DEFAULT && isSingleton alts && null bs )
304 do { -- VOID RESULT; just sequencing,
305 -- so get in there and do it
306 cgPrimOp [] primop args live_in_alts
309 (con,bs,_,rhs) = head alts
311 cgInlinePrimOp primop args bndr (PrimAlt tycon) live_in_alts alts
312 = do { -- PRIMITIVE ALTS, with non-void result
313 tmp_reg <- bindNewToTemp bndr
314 ; cgPrimOp [tmp_reg] primop args live_in_alts
315 ; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
317 cgInlinePrimOp primop args _ (UbxTupAlt _) live_in_alts alts
318 = ASSERT( isSingleton alts )
319 do { -- UNBOXED TUPLE ALTS
320 -- No heap check, no yield, just get in there and do it.
321 -- NB: the case binder isn't bound to anything;
322 -- it has a unboxed tuple type
324 res_tmps <- mapFCs bindNewToTemp non_void_res_ids
325 ; cgPrimOp res_tmps primop args live_in_alts
328 (_, res_ids, _, rhs) = head alts
329 non_void_res_ids = filter (nonVoidArg . idCgRep) res_ids
331 cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
332 = do { -- ENUMERATION TYPE RETURN
333 -- Typical: case a ># b of { True -> ..; False -> .. }
334 -- The primop itself returns an index into the table of
335 -- closures for the enumeration type.
336 tag_amode <- ASSERT( isEnumerationTyCon tycon )
337 do_enum_primop primop
339 -- Bind the default binder if necessary
340 -- (avoiding it avoids the assignment)
341 -- The deadness info is set by StgVarInfo
342 ; whenC (not (isDeadBinder bndr))
343 (do { tmp_reg <- bindNewToTemp bndr
346 (tagToClosure tycon tag_amode)) })
349 ; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
353 ; emitSwitch tag_amode branches mb_deflt 0 (tyConFamilySize tycon - 1)
357 do_enum_primop :: PrimOp -> FCode CmmExpr -- Returns amode for result
358 do_enum_primop TagToEnumOp -- No code!
360 (_,e) <- getArgAmode arg
362 do_enum_primop primop
363 = do tmp <- newTemp bWord
364 cgPrimOp [tmp] primop args live_in_alts
365 returnFC (CmmReg (CmmLocal tmp))
367 cgInlinePrimOp _ _ bndr _ _ _
368 = pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
371 %************************************************************************
373 \subsection[CgCase-alts]{Alternatives}
375 %************************************************************************
377 @cgEvalAlts@ returns an addressing mode for a continuation for the
378 alternatives of a @case@, used in a context when there
379 is some evaluation to be done.
382 cgEvalAlts :: Maybe VirtualSpOffset -- Offset of cost-centre to be restored, if any
386 -> FCode Sequel -- Any addr modes inside are guaranteed
387 -- to be a label so that we can duplicate it
388 -- without risk of duplicating code
390 cgEvalAlts cc_slot bndr alt_type@(PrimAlt tycon) alts
391 = do { let rep = tyConCgRep tycon
392 reg = dataReturnConvPrim rep -- Bottom for voidRep
394 ; abs_c <- forkProc $ do
395 { -- Bind the case binder, except if it's void
396 -- (reg is bottom in that case)
397 whenC (nonVoidArg rep) $
398 bindNewToReg bndr reg (mkLFArgument bndr)
399 ; restoreCurrentCostCentre cc_slot True
400 ; cgPrimAlts GCMayHappen alt_type reg alts }
402 ; lbl <- emitReturnTarget (idName bndr) abs_c
403 ; returnFC (CaseAlts lbl Nothing bndr) }
405 cgEvalAlts cc_slot bndr (UbxTupAlt _) [(con,args,_,rhs)]
406 = -- Unboxed tuple case
407 -- By now, the simplifier should have have turned it
408 -- into case e of (# a,b #) -> e
409 -- There shouldn't be a
410 -- case e of DEFAULT -> e
411 ASSERT2( case con of { DataAlt _ -> True; _ -> False },
412 text "cgEvalAlts: dodgy case of unboxed tuple type" )
413 do { -- forkAbsC for the RHS, so that the envt is
414 -- not changed for the emitReturn call
415 abs_c <- forkProc $ do
416 { (live_regs, ptrs, nptrs, _) <- bindUnboxedTupleComponents args
417 -- Restore the CC *after* binding the tuple components,
418 -- so that we get the stack offset of the saved CC right.
419 ; restoreCurrentCostCentre cc_slot True
420 -- Generate a heap check if necessary
421 -- and finally the code for the alternative
422 ; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
424 ; lbl <- emitReturnTarget (idName bndr) abs_c
425 ; returnFC (CaseAlts lbl Nothing bndr) }
427 cgEvalAlts cc_slot bndr alt_type alts
428 = -- Algebraic and polymorphic case
429 do { -- Bind the default binder
430 bindNewToReg bndr nodeReg (mkLFArgument bndr)
432 -- Generate sequel info for use downstream
433 -- At the moment, we only do it if the type is vector-returnable.
434 -- Reason: if not, then it costs extra to label the
435 -- alternatives, because we'd get return code like:
437 -- switch TagReg { 0 : JMP(alt_1); 1 : JMP(alt_2) ..etc }
439 -- which is worse than having the alt code in the switch statement
441 ; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
443 ; (lbl, branches) <- emitAlgReturnTarget (idName bndr)
446 ; returnFC (CaseAlts lbl branches bndr) }
448 fam_sz = case alt_type of
449 AlgAlt tc -> tyConFamilySize tc
451 PrimAlt _ -> panic "cgEvalAlts: PrimAlt"
452 UbxTupAlt _ -> panic "cgEvalAlts: UbxTupAlt"
456 HWL comment on {\em GrAnSim\/} (adding GRAN_YIELDs for context switch): If
457 we do an inlining of the case no separate functions for returning are
458 created, so we don't have to generate a GRAN_YIELD in that case. This info
459 must be propagated to cgAlgAltRhs (where the GRAN_YIELD macro might be
460 emitted). Hence, the new Bool arg to cgAlgAltRhs.
462 %************************************************************************
464 \subsection[CgCase-alg-alts]{Algebraic alternatives}
466 %************************************************************************
468 In @cgAlgAlts@, none of the binders in the alternatives are
469 assumed to be yet bound.
471 HWL comment on {\em GrAnSim\/} (adding GRAN_YIELDs for context switch): The
472 last arg of cgAlgAlts indicates if we want a context switch at the
473 beginning of each alternative. Normally we want that. The only exception
474 are inlined alternatives.
478 -> Maybe VirtualSpOffset
479 -> AltType -- ** AlgAlt or PolyAlt only **
480 -> [StgAlt] -- The alternatives
481 -> FCode ( [(ConTagZ, CgStmts)], -- The branches
482 Maybe CgStmts ) -- The default case
484 cgAlgAlts gc_flag cc_slot alt_type alts
485 = do alts <- forkAlts [ cgAlgAlt gc_flag cc_slot alt_type alt | alt <- alts]
487 mb_deflt = case alts of -- DEFAULT is always first, if present
488 ((DEFAULT,blks) : _) -> Just blks
491 branches = [(dataConTagZ con, blks)
492 | (DataAlt con, blks) <- alts]
494 return (branches, mb_deflt)
498 -> Maybe VirtualSpOffset -- Turgid state
499 -> AltType -- ** AlgAlt or PolyAlt only **
501 -> FCode (AltCon, CgStmts)
503 cgAlgAlt gc_flag cc_slot alt_type (con, args, _use_mask, rhs)
504 = do { abs_c <- getCgStmts $ do
505 { bind_con_args con args
506 ; restoreCurrentCostCentre cc_slot True
507 ; maybeAltHeapCheck gc_flag alt_type (cgExpr rhs) }
508 ; return (con, abs_c) }
510 bind_con_args DEFAULT _ = nopC
511 bind_con_args (DataAlt dc) args = bindConArgs dc args
512 bind_con_args (LitAlt _) _ = panic "cgAlgAlt: LitAlt"
516 %************************************************************************
518 \subsection[CgCase-prim-alts]{Primitive alternatives}
520 %************************************************************************
522 @cgPrimAlts@ generates suitable a @CSwitch@
523 for dealing with the alternatives of a primitive @case@, given an
524 addressing mode for the thing to scrutinise. It also keeps track of
525 the maximum stack depth encountered down any branch.
527 As usual, no binders in the alternatives are yet bound.
531 -> AltType -- Always PrimAlt, but passed to maybeAltHeapCheck
532 -> CmmReg -- Scrutinee
533 -> [StgAlt] -- Alternatives
535 -- NB: cgPrimAlts emits code that does the case analysis.
536 -- It's often used in inline situations, rather than to genearte
537 -- a labelled return point. That's why its interface is a little
538 -- different to cgAlgAlts
540 -- INVARIANT: the default binder is already bound
541 cgPrimAlts gc_flag alt_type scrutinee alts
542 = do { tagged_absCs <- forkAlts (map (cgPrimAlt gc_flag alt_type) alts)
543 ; let ((DEFAULT, deflt_absC) : others) = tagged_absCs -- There is always a default
544 alt_absCs = [(lit,rhs) | (LitAlt lit, rhs) <- others]
545 ; emitLitSwitch (CmmReg scrutinee) alt_absCs deflt_absC }
549 -> StgAlt -- The alternative
550 -> FCode (AltCon, CgStmts) -- Its compiled form
552 cgPrimAlt gc_flag alt_type (con, [], [], rhs)
553 = ASSERT( case con of { DEFAULT -> True; LitAlt _ -> True; _ -> False } )
554 do { abs_c <- getCgStmts (maybeAltHeapCheck gc_flag alt_type (cgExpr rhs))
555 ; returnFC (con, abs_c) }
556 cgPrimAlt _ _ _ = panic "cgPrimAlt: non-empty lists"
560 %************************************************************************
562 \subsection[CgCase-tidy]{Code for tidying up prior to an eval}
564 %************************************************************************
569 -> AltType -- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
570 -> Code -- Continuation
572 maybeAltHeapCheck NoGC _ code = code
573 maybeAltHeapCheck GCMayHappen alt_type code = altHeapCheck alt_type code
575 saveVolatileVarsAndRegs
576 :: StgLiveVars -- Vars which should be made safe
577 -> FCode (CmmStmts, -- Assignments to do the saves
578 EndOfBlockInfo, -- sequel for the alts
579 Maybe VirtualSpOffset) -- Slot for current cost centre
581 saveVolatileVarsAndRegs vars
582 = do { var_saves <- saveVolatileVars vars
583 ; (maybe_cc_slot, cc_save) <- saveCurrentCostCentre
584 ; eob_info <- getEndOfBlockInfo
585 ; returnFC (var_saves `plusStmts` cc_save,
590 saveVolatileVars :: StgLiveVars -- Vars which should be made safe
591 -> FCode CmmStmts -- Assignments to to the saves
593 saveVolatileVars vars
594 = do { stmts_s <- mapFCs save_it (varSetElems vars)
595 ; return (foldr plusStmts noStmts stmts_s) }
598 = do { v <- getCAddrModeIfVolatile var
600 Nothing -> return noStmts -- Non-volatile
601 Just vol_amode -> save_var var vol_amode -- Aha! It's volatile
604 save_var var vol_amode
605 = do { slot <- allocPrimStack (idCgRep var)
606 ; rebindToStack var slot
607 ; sp_rel <- getSpRelOffset slot
608 ; returnFC (oneStmt (CmmStore sp_rel vol_amode)) }
611 ---------------------------------------------------------------------------
613 When we save the current cost centre (which is done for lexical
614 scoping), we allocate a free stack location, and return (a)~the
615 virtual offset of the location, to pass on to the alternatives, and
616 (b)~the assignment to do the save (just as for @saveVolatileVars@).
619 saveCurrentCostCentre ::
620 FCode (Maybe VirtualSpOffset, -- Where we decide to store it
621 CmmStmts) -- Assignment to save it
623 saveCurrentCostCentre
624 | not opt_SccProfilingOn
625 = returnFC (Nothing, noStmts)
627 = do { slot <- allocPrimStack PtrArg
628 ; sp_rel <- getSpRelOffset slot
629 ; returnFC (Just slot,
630 oneStmt (CmmStore sp_rel curCCS)) }
632 -- Sometimes we don't free the slot containing the cost centre after restoring it
633 -- (see CgLetNoEscape.cgLetNoEscapeBody).
634 restoreCurrentCostCentre :: Maybe VirtualSpOffset -> Bool -> Code
635 restoreCurrentCostCentre Nothing _freeit = nopC
636 restoreCurrentCostCentre (Just slot) freeit
637 = do { sp_rel <- getSpRelOffset slot
638 ; whenC freeit (freeStackSlots [slot])
639 ; stmtC (CmmStore curCCSAddr (CmmLoad sp_rel bWord)) }