X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeInstr.lhs;h=d44a00bc1415971888c7944c11c200ade791ddc3;hp=ffd7c71937f8d3f39bcfd5ca9590f55536c29f32;hb=83d563cb9ede0ba792836e529b1e2929db926355;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs index ffd7c71..d44a00b 100644 --- a/compiler/ghci/ByteCodeInstr.lhs +++ b/compiler/ghci/ByteCodeInstr.lhs @@ -6,13 +6,6 @@ ByteCodeInstrs: Bytecode instruction definitions \begin{code} {-# OPTIONS_GHC -funbox-strict-fields #-} -{-# OPTIONS_GHC -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/WorkingConventions#Warnings --- for details - module ByteCodeInstr ( BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..) ) where @@ -34,11 +27,9 @@ import VarSet import PrimOp import SMRep -import GHC.Ptr - import Module (Module) -import GHC.Prim - +import GHC.Exts +import Data.Word -- ---------------------------------------------------------------------------- -- Bytecode instructions @@ -49,7 +40,7 @@ data ProtoBCO a protoBCOInstrs :: [BCInstr], -- instrs -- arity and GC info protoBCOBitmap :: [StgWord], - protoBCOBitmapSize :: Int, + protoBCOBitmapSize :: Word16, protoBCOArity :: Int, -- what the BCO came from protoBCOExpr :: Either [AnnAlt Id VarSet] (AnnExpr Id VarSet), @@ -57,16 +48,16 @@ data ProtoBCO a protoBCOPtrs :: [Either ItblPtr (Ptr ())] } -type LocalLabel = Int +type LocalLabel = Word16 data BCInstr -- Messing with the stack - = STKCHECK Int + = STKCHECK Word -- 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 !Word16{-offset-} + | PUSH_LL !Word16 !Word16{-2 offsets-} + | PUSH_LLL !Word16 !Word16 !Word16{-3 offsets-} -- Push a ptr (these all map to PUSH_G really) | PUSH_G Name @@ -78,8 +69,8 @@ data BCInstr | PUSH_ALTS_UNLIFTED (ProtoBCO Name) CgRep -- Pushing literals - | PUSH_UBX (Either Literal (Ptr ())) Int - -- push this int/float/double/addr, on the stack. Int + | PUSH_UBX (Either Literal (Ptr ())) Word16 + -- push this int/float/double/addr, on the stack. Word16 -- is # of words to copy from literal pool. Eitherness reflects -- the difficulty of dealing with MachAddr here, mostly due to -- the excessive (and unnecessary) restrictions imposed by the @@ -101,42 +92,48 @@ data BCInstr | PUSH_APPLY_PPPPP | PUSH_APPLY_PPPPPP - | SLIDE Int{-this many-} Int{-down by this much-} + | SLIDE Word16{-this many-} Word16{-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 !Word16 -- make an AP with this many payload words + | ALLOC_AP_NOUPD !Word16 -- make an AP_NOUPD with this many payload words + | ALLOC_PAP !Word16 !Word16 -- make a PAP with this arity / payload words + | MKAP !Word16{-ptr to AP is this far down stack-} !Word16{-number of words-} + | MKPAP !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-} + | UNPACK !Word16 -- unpack N words from t.o.s Constr + | PACK DataCon !Word16 -- after assembly, the DataCon is an index into the -- itbl array -- For doing case trees | LABEL LocalLabel | TESTLT_I Int LocalLabel | TESTEQ_I Int LocalLabel + | TESTLT_W Word LocalLabel + | TESTEQ_W Word LocalLabel | TESTLT_F Float LocalLabel | TESTEQ_F Float LocalLabel | TESTLT_D Double LocalLabel | TESTEQ_D Double LocalLabel - -- The Int value is a constructor number and therefore + -- The Word16 value is a constructor number and therefore -- stored in the insn stream rather than as an offset into -- the literal pool. - | TESTLT_P Int LocalLabel - | TESTEQ_P Int LocalLabel + | TESTLT_P Word16 LocalLabel + | TESTEQ_P Word16 LocalLabel | CASEFAIL | JMP LocalLabel - -- For doing calls to C (via glue code generated by ByteCodeFFI) - | CCALL Int -- stack frame size - (Ptr ()) -- addr of the glue code + -- For doing calls to C (via glue code generated by ByteCodeFFI, or libffi) + | CCALL Word16 -- stack frame size + (Ptr ()) -- addr of the glue code + Word16 -- whether or not the call is interruptible + -- (XXX: inefficient, but I don't know + -- what the alignment constraints are.) -- For doing magic ByteArray passing to foreign calls - | SWIZZLE Int -- to the ptr N words down the stack, - Int -- add M (interpreted as a signed 16-bit entity) + | SWIZZLE Word16 -- to the ptr N words down the stack, + Word16 -- add M (interpreted as a signed 16-bit entity) -- To Infinity And Beyond | ENTER @@ -144,13 +141,13 @@ data BCInstr | RETURN_UBX CgRep -- return an unlifted value, here's its rep -- Breakpoints - | BRK_FUN (MutableByteArray# RealWorld) Int BreakInfo + | BRK_FUN (MutableByteArray# RealWorld) Word16 BreakInfo data BreakInfo = BreakInfo { breakInfo_module :: Module , breakInfo_number :: {-# UNPACK #-} !Int - , breakInfo_vars :: [(Id,Int)] + , breakInfo_vars :: [(Id,Word16)] , breakInfo_resty :: Type } @@ -175,10 +172,10 @@ instance Outputable a => Outputable (ProtoBCO a) where Right rhs -> pprCoreExpr (deAnnotate rhs) instance Outputable BCInstr where - ppr (STKCHECK n) = text "STKCHECK" <+> int n - ppr (PUSH_L offset) = text "PUSH_L " <+> int offset - ppr (PUSH_LL o1 o2) = text "PUSH_LL " <+> int o1 <+> int o2 - ppr (PUSH_LLL o1 o2 o3) = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3 + ppr (STKCHECK n) = text "STKCHECK" <+> ppr n + ppr (PUSH_L offset) = text "PUSH_L " <+> ppr offset + ppr (PUSH_LL o1 o2) = text "PUSH_LL " <+> ppr o1 <+> ppr o2 + ppr (PUSH_LLL o1 o2 o3) = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3 ppr (PUSH_G nm) = text "PUSH_G " <+> ppr nm ppr (PUSH_PRIMOP op) = text "PUSH_G " <+> text "GHC.PrimopWrappers." <> ppr op @@ -186,8 +183,8 @@ instance Outputable BCInstr where ppr (PUSH_ALTS bco) = text "PUSH_ALTS " <+> ppr bco ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco - ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit - ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa) + ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit + ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> text (show aa) ppr PUSH_APPLY_N = text "PUSH_APPLY_N" ppr PUSH_APPLY_V = text "PUSH_APPLY_V" ppr PUSH_APPLY_F = text "PUSH_APPLY_F" @@ -200,35 +197,41 @@ instance Outputable BCInstr where ppr PUSH_APPLY_PPPPP = text "PUSH_APPLY_PPPPP" ppr PUSH_APPLY_PPPPPP = text "PUSH_APPLY_PPPPPP" - ppr (SLIDE n d) = text "SLIDE " <+> int n <+> int d - ppr (ALLOC_AP sz) = text "ALLOC_AP " <+> 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 (SLIDE n d) = text "SLIDE " <+> ppr n <+> ppr d + ppr (ALLOC_AP sz) = text "ALLOC_AP " <+> ppr sz + ppr (ALLOC_AP_NOUPD sz) = text "ALLOC_AP_NOUPD " <+> ppr sz + ppr (ALLOC_PAP arity sz) = text "ALLOC_PAP " <+> ppr arity <+> ppr sz + ppr (MKAP offset sz) = text "MKAP " <+> ppr sz <+> text "words," + <+> ppr offset <+> text "stkoff" + ppr (MKPAP offset sz) = text "MKPAP " <+> ppr sz <+> text "words," + <+> ppr offset <+> text "stkoff" + ppr (UNPACK sz) = text "UNPACK " <+> ppr sz ppr (PACK dcon sz) = text "PACK " <+> ppr dcon <+> ppr sz - ppr (LABEL lab) = text "__" <> int lab <> colon - ppr (TESTLT_I i lab) = text "TESTLT_I" <+> int i <+> text "__" <> int lab - ppr (TESTEQ_I i lab) = text "TESTEQ_I" <+> int i <+> text "__" <> int lab - ppr (TESTLT_F f lab) = text "TESTLT_F" <+> float f <+> text "__" <> int lab - ppr (TESTEQ_F f lab) = text "TESTEQ_F" <+> float f <+> text "__" <> int lab - ppr (TESTLT_D d lab) = text "TESTLT_D" <+> double d <+> text "__" <> int lab - 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 (LABEL lab) = text "__" <> ppr lab <> colon + ppr (TESTLT_I i lab) = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab + ppr (TESTEQ_I i lab) = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab + ppr (TESTLT_W i lab) = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab + ppr (TESTEQ_W i lab) = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab + ppr (TESTLT_F f lab) = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab + ppr (TESTEQ_F f lab) = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab + ppr (TESTLT_D d lab) = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab + ppr (TESTEQ_D d lab) = text "TESTEQ_D" <+> double d <+> text "__" <> ppr lab + ppr (TESTLT_P i lab) = text "TESTLT_P" <+> ppr i <+> text "__" <> ppr lab + ppr (TESTEQ_P i lab) = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab ppr CASEFAIL = text "CASEFAIL" - ppr (JMP lab) = text "JMP" <+> int lab - ppr (CCALL off marshall_addr) = text "CCALL " <+> int off + ppr (JMP lab) = text "JMP" <+> ppr lab + ppr (CCALL off marshall_addr int) = text "CCALL " <+> ppr off <+> text "marshall code at" <+> text (show marshall_addr) - ppr (SWIZZLE stkoff n) = text "SWIZZLE " <+> text "stkoff" <+> int stkoff - <+> text "by" <+> int n + <+> (if int == 1 + then text "(interruptible)" + else empty) + ppr (SWIZZLE stkoff n) = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff + <+> text "by" <+> ppr 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 "" <+> int index <+> ppr info + ppr (BRK_FUN _breakArray index info) = text "BRK_FUN" <+> text "" <+> ppr index <+> ppr info -- ----------------------------------------------------------------------------- -- The stack use, in words, of each bytecode insn. These _must_ be @@ -240,10 +243,10 @@ instance Outputable BCInstr where -- 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 :: ProtoBCO a -> Word protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco)) -bciStackUse :: BCInstr -> Int +bciStackUse :: BCInstr -> Word bciStackUse STKCHECK{} = 0 bciStackUse PUSH_L{} = 1 bciStackUse PUSH_LL{} = 2 @@ -253,7 +256,7 @@ bciStackUse PUSH_PRIMOP{} = 1 bciStackUse PUSH_BCO{} = 1 bciStackUse (PUSH_ALTS bco) = 2 + protoBCOStackUse bco bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco -bciStackUse (PUSH_UBX _ nw) = nw +bciStackUse (PUSH_UBX _ nw) = fromIntegral nw bciStackUse PUSH_APPLY_N{} = 1 bciStackUse PUSH_APPLY_V{} = 1 bciStackUse PUSH_APPLY_F{} = 1 @@ -266,11 +269,14 @@ 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 (UNPACK sz) = fromIntegral sz bciStackUse LABEL{} = 0 bciStackUse TESTLT_I{} = 0 bciStackUse TESTEQ_I{} = 0 +bciStackUse TESTLT_W{} = 0 +bciStackUse TESTEQ_W{} = 0 bciStackUse TESTLT_F{} = 0 bciStackUse TESTEQ_F{} = 0 bciStackUse TESTLT_D{} = 0