X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FByteCodeInstr.lhs;h=7bd4408fff66895ef648332df7649ac74a236a9b;hb=e6218fe7eff4e34e1a3c823cd4b7aebe09d2d4fb;hp=239c691af382feac3360957dfcd99fd1ad251c74;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/ByteCodeInstr.lhs b/ghc/compiler/ghci/ByteCodeInstr.lhs
index 239c691..7bd4408 100644
--- 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 )
@@ -17,24 +17,15 @@ import Id		( Id )
 import CoreSyn
 import PprCore		( pprCoreExpr, pprCoreAlt )
 import Literal		( Literal )
-import PrimRep		( PrimRep )
 import DataCon		( DataCon )
 import VarSet		( VarSet )
 import PrimOp		( PrimOp )
+import SMRep		( StgWord, CgRep )
 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
@@ -67,7 +58,7 @@ data BCInstr
 
    -- Push an alt continuation
    | PUSH_ALTS          (ProtoBCO Name)
-   | PUSH_ALTS_UNLIFTED (ProtoBCO Name) PrimRep
+   | PUSH_ALTS_UNLIFTED (ProtoBCO Name) CgRep
 
    -- Pushing literals
    | PUSH_UBX  (Either Literal (Ptr ())) Int
@@ -92,14 +83,14 @@ data BCInstr
    | PUSH_APPLY_PPPP
    | PUSH_APPLY_PPPPP
    | PUSH_APPLY_PPPPPP
-   | PUSH_APPLY_PPPPPPP
 
    | SLIDE     Int{-this many-} Int{-down by this much-}
 
    -- To do with the heap
    | ALLOC_AP  Int	-- make an AP with this many payload words
    | ALLOC_PAP Int Int	-- make a PAP with this arity / payload words
-   | MKAP      Int{-ptr to AP/PAP is this far down stack-} Int{-# words-}
+   | MKAP      Int{-ptr to AP is this far down stack-} Int{-# words-}
+   | MKPAP     Int{-ptr to PAP is this far down stack-} Int{-# words-}
    | UNPACK    Int	-- unpack N words from t.o.s Constr
    | PACK      DataCon Int
 			-- after assembly, the DataCon is an index into the
@@ -133,7 +124,7 @@ data BCInstr
    -- To Infinity And Beyond
    | ENTER
    | RETURN		-- return a lifted value
-   | RETURN_UBX PrimRep -- return an unlifted value, here's its rep
+   | RETURN_UBX CgRep -- return an unlifted value, here's its rep
 
 -- -----------------------------------------------------------------------------
 -- Printing bytecode instructions
@@ -173,7 +164,6 @@ instance Outputable BCInstr where
    ppr PUSH_APPLY_PPPP		= text "PUSH_APPLY_PPPP"
    ppr PUSH_APPLY_PPPPP		= text "PUSH_APPLY_PPPPP"
    ppr PUSH_APPLY_PPPPPP	= text "PUSH_APPLY_PPPPPP"
-   ppr PUSH_APPLY_PPPPPPP	= text "PUSH_APPLY_PPPPPPP"
 
    ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
@@ -206,6 +196,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 +213,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
@@ -228,7 +227,6 @@ bciStackUse PUSH_APPLY_PPP{}	  = 1
 bciStackUse PUSH_APPLY_PPPP{}	  = 1
 bciStackUse PUSH_APPLY_PPPPP{}	  = 1
 bciStackUse PUSH_APPLY_PPPPPP{}	  = 1
-bciStackUse PUSH_APPLY_PPPPPPP{}  = 1
 bciStackUse ALLOC_AP{}            = 1
 bciStackUse ALLOC_PAP{}           = 1
 bciStackUse (UNPACK sz)           = sz
@@ -253,5 +251,6 @@ bciStackUse SWIZZLE{}    	  = 0
 -- so can't use this info.  Not that it matters much.
 bciStackUse SLIDE{}		  = 0
 bciStackUse MKAP{}		  = 0
+bciStackUse MKPAP{}		  = 0
 bciStackUse PACK{}		  = 1 -- worst case is PACK 0 words
 \end{code}