%
-% (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/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 ( 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.Exts
+
+
-- ----------------------------------------------------------------------------
-- Bytecode instructions
-- 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
= 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
| 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
| 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
| 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
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"
+ 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
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
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
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.