X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=846737e0a6a6ef75a124a6d918a2cdda295b48ff;hb=a07a463449d54855f19c160ed0f0a3853663db5f;hp=479d35d51b35b94dd45f0396fdebe03118b37587;hpb=26b80e2f7ae773c33067b7f259e2b83bfb08d6b6;p=ghc-hetmet.git

diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 479d35d..846737e 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -5,6 +5,13 @@
 ByteCodeGen: Generate bytecode from Core
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
 
 #include "HsVersions.h"
@@ -171,17 +178,19 @@ mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_bloc
         -- (hopefully rare) cases when the (overestimated) stack use
         -- exceeds iNTERP_STACK_CHECK_THRESH.
         maybe_with_stack_check
-	   | is_ret = peep_d
-		-- don't do stack checks at return points;
+	   | is_ret && stack_usage < aP_STACK_SPLIM = peep_d
+		-- don't do stack checks at return points,
 		-- everything is aggregated up to the top BCO
-		-- (which must be a function)
-           | stack_overest >= iNTERP_STACK_CHECK_THRESH
-           = STKCHECK stack_overest : peep_d
+		-- (which must be a function).
+                -- That is, unless the stack usage is >= AP_STACK_SPLIM,
+                -- see bug #1466.
+           | stack_usage >= iNTERP_STACK_CHECK_THRESH
+           = STKCHECK stack_usage : peep_d
            | otherwise
            = peep_d	-- the supposedly common case
              
         -- We assume that this sum doesn't wrap
-        stack_overest = sum (map bciStackUse peep_d)
+        stack_usage = sum (map bciStackUse peep_d)
 
         -- Merge local pushes
         peep_d = peep (fromOL instrs_ordlist)