[project @ 2003-05-14 09:13:52 by simonmar]

[ghc-hetmet.git] / ghc / compiler / ghci / ByteCodeInstr.lhs

diff --git a/ghc/compiler/ghci/ByteCodeInstr.lhs b/ghc/compiler/ghci/ByteCodeInstr.lhs
index 239c691..05c4fe4 100644 (file)
--- a/ghc/compiler/ghci/ByteCodeInstr.lhs
+++ b/ghc/compiler/ghci/ByteCodeInstr.lhs
@@ -5,11 +5,11 @@
 
 \begin{code}
 module ByteCodeInstr ( 
-       BCInstr(..), ProtoBCO(..), StgWord, bciStackUse
+       BCInstr(..), ProtoBCO(..), bciStackUse
   ) where
 
 #include "HsVersions.h"
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
 
 import Outputable
 import Name            ( Name )
@@ -21,20 +21,12 @@ import PrimRep              ( PrimRep )
 import DataCon         ( DataCon )
 import VarSet          ( VarSet )
 import PrimOp          ( PrimOp )
+import SMRep           ( StgWord )
 import GHC.Ptr
 
-import Data.Word
-
 -- ----------------------------------------------------------------------------
 -- Bytecode instructions
 
--- The appropriate StgWord type for this platform (needed for bitmaps)
-#if SIZEOF_HSWORD == 4
-type StgWord = Word32
-#else
-type StgWord = Word64
-#endif
-
 data ProtoBCO a 
    = ProtoBCO { 
        protoBCOName       :: a,          -- name, in some sense
@@ -206,6 +198,15 @@ instance Outputable BCInstr where
 -- The stack use, in words, of each bytecode insn.  These _must_ be
 -- correct, or overestimates of reality, to be safe.
 
+-- NOTE: we aggregate the stack use from case alternatives too, so that
+-- we can do a single stack check at the beginning of a function only.
+
+-- This could all be made more accurate by keeping track of a proper
+-- stack high water mark, but it doesn't seem worth the hassle.
+
+protoBCOStackUse :: ProtoBCO a -> Int
+protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
+
 bciStackUse :: BCInstr -> Int
 bciStackUse STKCHECK{}            = 0
 bciStackUse PUSH_L{}             = 1
@@ -214,8 +215,8 @@ bciStackUse PUSH_LLL{}            = 3
 bciStackUse PUSH_G{}             = 1
 bciStackUse PUSH_PRIMOP{}         = 1
 bciStackUse PUSH_BCO{}           = 1
-bciStackUse PUSH_ALTS{}           = 2
-bciStackUse PUSH_ALTS_UNLIFTED{}  = 2
+bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
+bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
 bciStackUse (PUSH_UBX _ nw)       = nw
 bciStackUse PUSH_APPLY_N{}       = 1
 bciStackUse PUSH_APPLY_V{}       = 1