Don't adjust hp up when the case scrutinee won't allocate

If the case scrutinee can't allocate, we don't need to do a heap
check in the case alternatives. (A previous patch got that right.)
In that case, we had better not adjust the heap pointer to recover
unused stack space before evaluating the scrutinee -- because we
aren't going to reallocate for the case alternative.

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 379f1cd..dac7d67 100644 (file)
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -273,15 +273,15 @@ cgCase scrut bndr srt alt_type alts
        ; let ret_bndrs = chooseReturnBndrs bndr alt_type alts
              alt_regs  = map idToReg ret_bndrs
              simple_scrut = isSimpleScrut scrut alt_type
-             gc_plan | not simple_scrut = GcInAlts alt_regs srt
-                     | isSingleton alts = NoGcInAlts
-                     | up_hp_usg > 0    = NoGcInAlts
-                     | otherwise        = GcInAlts alt_regs srt
+             gcInAlts | not simple_scrut = True
+                      | isSingleton alts = False
+                      | up_hp_usg > 0    = False
+                      | otherwise        = True
+              gc_plan = if gcInAlts then GcInAlts alt_regs srt else NoGcInAlts
 
        ; mb_cc <- maybeSaveCostCentre simple_scrut
        ; c_srt <- getSRTInfo srt
-       ; withSequel (AssignTo alt_regs c_srt)
-                    (cgExpr scrut)
+       ; withSequel (AssignTo alt_regs gcInAlts) (cgExpr scrut)
        ; restoreCurrentCostCentre mb_cc
 
        ; bindArgsToRegs ret_bndrs

diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 1269897..33fd3e8 100644 (file)
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -77,14 +77,18 @@ emitReturn :: [CmmExpr] -> FCode ()
 --     return (x,y)
 -- If the sequel is AssignTo [p,q]
 --     p=x; q=y; 
-emitReturn results 
-  = do  { adjustHpBackwards
-       ; sequel    <- getSequel;
-       ; updfr_off <- getUpdFrameOff
-       ; case sequel of
-           Return _        -> emit (mkReturnSimple results updfr_off)
-           AssignTo regs _ -> emit (mkMultiAssign  regs results)
-    }
+emitReturn results
+  = do { sequel    <- getSequel;
+       ; updfr_off <- getUpdFrameOff
+       ; emit $ mkComment $ mkFastString "emitReturn"
+       ; case sequel of
+           Return _ ->
+             do { adjustHpBackwards
+                ; emit (mkReturnSimple results updfr_off) }
+           AssignTo regs adjust ->
+             do { if adjust then adjustHpBackwards else return ()
+                ; emit (mkMultiAssign  regs results) }
+       }
 
 emitCall :: Convention -> CmmExpr -> [CmmExpr] -> FCode ()
 -- (cgCall fun args) makes a call to the entry-code of 'fun', 
@@ -93,10 +97,10 @@ emitCall conv fun args
   = do { adjustHpBackwards
        ; sequel <- getSequel
        ; updfr_off <- getUpdFrameOff
-        ; emit $ mkComment $ mkFastString "emitcall"
+        ; emit $ mkComment $ mkFastString "emitCall"
        ; case sequel of
-           Return _              -> emit (mkForeignJump conv fun args updfr_off)
-           AssignTo res_regs srt -> emit (mkCall fun conv res_regs args updfr_off)
+           Return _            -> emit (mkForeignJump conv fun args updfr_off)
+           AssignTo res_regs _ -> emit (mkCall fun conv res_regs args updfr_off)
     }
 
 adjustHpBackwards :: FCode ()
@@ -165,7 +169,7 @@ direct_call caller lbl arity args reps
        ; let srt = pprTrace "Urk! SRT for over-sat call" 
                             (ppr lbl) NoC_SRT
                -- XXX: what if rest_args contains static refs?
-       ; withSequel (AssignTo [pap_id] srt)
+       ; withSequel (AssignTo [pap_id] True)
                     (emitCall Native target fast_args)
        ; slow_call (CmmReg (CmmLocal pap_id)) 
                    rest_args rest_reps }

diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index 2249a46..c1f743d 100644 (file)
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -209,12 +209,10 @@ data Sequel
   | AssignTo 
        [LocalReg]      -- Put result(s) in these regs and fall through
                        --      NB: no void arguments here
-       C_SRT           -- Here are the statics live in the continuation
-                       -- E.g.  case (case x# of 0# -> a; DEFAULT -> b) of {
-                       --          r -> <blah>
-                       -- When compiling the nested case, remember to put the
-                       -- result in r, and fall through  
-
+        Bool            -- Should we adjust the heap pointer back to recover
+                        -- space that's unused on this path?
+                        -- We need to do this only if the expression may
+                        -- allocate (e.g. it's a foreign call or allocating primOp)
 
 initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
 initCgInfoDown dflags mod