Use OPTIONS rather than OPTIONS_GHC for pragmas
[ghc-hetmet.git] / compiler / ghci / ByteCodeInstr.lhs
index 7bd4408..3c2d10d 100644 (file)
@@ -1,28 +1,45 @@
 %
-% (c) The University of Glasgow 2000
+% (c) The University of Glasgow 2000-2006
 %
-\section[ByteCodeInstrs]{Bytecode instruction definitions}
+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/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            ( Name )
-import Id              ( Id )
+import Name
+import Id
 import CoreSyn
-import PprCore         ( pprCoreExpr, pprCoreAlt )
-import Literal         ( Literal )
-import DataCon         ( DataCon )
-import VarSet          ( VarSet )
-import PrimOp          ( PrimOp )
-import SMRep           ( StgWord, CgRep )
+import PprCore
+import Literal
+import DataCon
+import VarSet
+import PrimOp
+import SMRep
+
 import GHC.Ptr
 
+import Module (Module)
+import GHC.Prim
+
+
 -- ----------------------------------------------------------------------------
 -- Bytecode instructions
 
@@ -37,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
@@ -47,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
@@ -87,12 +104,12 @@ 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_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
@@ -126,6 +143,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
 
@@ -170,6 +205,8 @@ instance Outputable BCInstr where
    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"
+   ppr (MKPAP offset sz)     = text "MKPAP   " <+> int sz <+> text "words,"
+                                               <+> int offset <+> text "stkoff"
    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
@@ -181,16 +218,17 @@ instance Outputable BCInstr where
    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
-   ppr (JMP lab)             = text "JMP"      <+> int lab
    ppr CASEFAIL              = text "CASEFAIL"
-   ppr ENTER                 = text "ENTER"
-   ppr RETURN               = text "RETURN"
-   ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
+   ppr (JMP lab)             = text "JMP"      <+> int lab
    ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off 
                                                <+> text "marshall code at" 
                                                <+> text (show marshall_addr)
    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff 
                                                <+> text "by" <+> int n 
+   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
@@ -246,6 +284,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.