X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeInstr.lhs;h=5c9c295e4571807f91b2e5861bf819b65dd3fbb2;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hp=7bd4408fff66895ef648332df7649ac74a236a9b;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs index 7bd4408..5c9c295 100644 --- a/compiler/ghci/ByteCodeInstr.lhs +++ b/compiler/ghci/ByteCodeInstr.lhs @@ -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/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.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 "" <+> 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.