X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeInstr.lhs;h=1d629c0643b7bbf6a70722f69c4d19ba98443e5c;hb=44884d1311285851377de5079bbc85050fe30108;hp=c1aafc95cf3888305ef545cc3b1af0bd8437f891;hpb=04ed4bf79faffd0170030b963c7883be95d75376;p=ghc-hetmet.git

diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs
index c1aafc9..1d629c0 100644
--- a/compiler/ghci/ByteCodeInstr.lhs
+++ b/compiler/ghci/ByteCodeInstr.lhs
@@ -4,13 +4,25 @@
 ByteCodeInstrs: Bytecode instruction definitions
 
 \begin{code}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+{-# 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 ByteCodeInstr ( 
- 	BCInstr(..), ProtoBCO(..), bciStackUse
+ 	BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..) 
   ) where
 
 #include "HsVersions.h"
 #include "../includes/MachDeps.h"
 
+import ByteCodeItbls	( ItblPtr )
+
+import Type
 import Outputable
 import Name
 import Id
@@ -24,6 +36,10 @@ import SMRep
 
 import GHC.Ptr
 
+import Module (Module)
+import GHC.Exts
+
+
 -- ----------------------------------------------------------------------------
 -- Bytecode instructions
 
@@ -38,7 +54,7 @@ data ProtoBCO a
 	-- what the BCO came from
 	protoBCOExpr       :: Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet),
 	-- malloc'd pointers
-        protoBCOPtrs       :: [Ptr ()]
+        protoBCOPtrs       :: [Either ItblPtr (Ptr ())]
    }
 
 type LocalLabel = Int
@@ -48,9 +64,9 @@ data BCInstr
    = STKCHECK  Int
 
    -- Push locals (existing bits of the stack)
-   | PUSH_L    Int{-offset-}
-   | PUSH_LL   Int Int{-2 offsets-}
-   | PUSH_LLL  Int Int Int{-3 offsets-}
+   | PUSH_L    !Int{-offset-}
+   | PUSH_LL   !Int !Int{-2 offsets-}
+   | PUSH_LLL  !Int !Int !Int{-3 offsets-}
 
    -- Push a ptr  (these all map to PUSH_G really)
    | PUSH_G       Name
@@ -88,12 +104,13 @@ data BCInstr
    | 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 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
+   | ALLOC_AP  !Int	 -- make an AP with this many payload words
+   | ALLOC_AP_NOUPD !Int -- make an AP_NOUPD with this many payload words
+   | ALLOC_PAP !Int !Int -- make a PAP with this arity / payload 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
 			-- itbl array
    -- For doing case trees
@@ -114,7 +131,7 @@ data BCInstr
    | CASEFAIL
    | JMP              LocalLabel
 
-   -- For doing calls to C (via glue code generated by ByteCodeFFI)
+   -- For doing calls to C (via glue code generated by ByteCodeFFI, or libffi)
    | CCALL            Int 	-- stack frame size
 		      (Ptr ())  -- addr of the glue code
 
@@ -127,6 +144,24 @@ data BCInstr
    | RETURN		-- return a lifted value
    | RETURN_UBX CgRep -- return an unlifted value, here's its rep
 
+   -- Breakpoints 
+   | BRK_FUN          (MutableByteArray# RealWorld) Int BreakInfo
+
+data BreakInfo 
+   = BreakInfo
+   { breakInfo_module :: Module
+   , breakInfo_number :: {-# UNPACK #-} !Int
+   , breakInfo_vars   :: [(Id,Int)]
+   , breakInfo_resty  :: Type
+   }
+
+instance Outputable BreakInfo where
+   ppr info = text "BreakInfo" <+>
+              parens (ppr (breakInfo_module info) <+>
+                      ppr (breakInfo_number info) <+>
+                      ppr (breakInfo_vars info) <+>
+                      ppr (breakInfo_resty info))
+
 -- -----------------------------------------------------------------------------
 -- Printing bytecode instructions
 
@@ -168,6 +203,7 @@ instance Outputable BCInstr where
 
    ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
+   ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> int sz
    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> int arity <+> int sz
    ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words," 
                                                <+> int offset <+> text "stkoff"
@@ -194,6 +230,7 @@ instance Outputable BCInstr where
    ppr ENTER                 = text "ENTER"
    ppr RETURN		     = text "RETURN"
    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
+   ppr (BRK_FUN breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> int index <+> ppr info 
 
 -- -----------------------------------------------------------------------------
 -- The stack use, in words, of each bytecode insn.  These _must_ be
@@ -231,6 +268,7 @@ bciStackUse PUSH_APPLY_PPPP{}	  = 1
 bciStackUse PUSH_APPLY_PPPPP{}	  = 1
 bciStackUse PUSH_APPLY_PPPPPP{}	  = 1
 bciStackUse ALLOC_AP{}            = 1
+bciStackUse ALLOC_AP_NOUPD{}      = 1
 bciStackUse ALLOC_PAP{}           = 1
 bciStackUse (UNPACK sz)           = sz
 bciStackUse LABEL{}       	  = 0
@@ -249,6 +287,7 @@ bciStackUse RETURN{}		  = 0
 bciStackUse RETURN_UBX{}	  = 1
 bciStackUse CCALL{} 		  = 0
 bciStackUse SWIZZLE{}    	  = 0
+bciStackUse BRK_FUN{}    	  = 0
 
 -- These insns actually reduce stack use, but we need the high-tide level,
 -- so can't use this info.  Not that it matters much.