module ByteCode.Type( -- * Data Types -- ** Top-level bytecode declarations BCModule(..) , BCDecl(..) -- ** Constant tables , ConstTable , ConstItem(..) , GType(..) , CRef -- ** Code representations , Code(..) , GraphNode(..) , Graph , Jumpers , GLabel(..) , Write(..) , Ins(..) , PrimOp(..) , Tag , Label -- ** Use sets , UseSet(..) , emptyUS , UseIns -- * Constants , xFlNone , xFlVoid , fNone, fInvisible, fLambda, intFlags , frameSize , calcHeapExtra , splitQualified ) where import Prim(PrimOp(..)) import qualified Data.Map as Map import qualified Data.Set as Set import Util.Extra(Pos) import Syntax(CallConv) import NT import PosCode(LambdaFlags(..)) import Flags(Flags, sHat) -- | A bytecode program data BCModule = BCModule { bcmModule :: String, bcmDecls :: [BCDecl] } -- | A Declaration is a top level bcode entry data BCDecl = Fun { fName :: String, fPos :: Pos, fArity :: Int, fArgs :: [String], fCode :: Code, fConsts :: ConstTable, fIsPrim :: Bool, fStack :: Int, fNumDictArgs :: Int, fFlags :: [LambdaFlags] } | Con { cName :: String, cPos :: Pos, cSize :: Int, cTag :: Int } | Prim { pName :: String, pPos :: Pos } | External { xName :: String, xPos :: Pos, xArity :: Int, xCName :: String, xCallConv :: String, xArgsTypes :: [String] } fNone, fInvisible, fLambda :: Int fNone = 0x00 fInvisible = 0x01 fLambda = 0x02 intFlags :: [LambdaFlags] -> Int intFlags lfs = sum (map f lfs) where f LamFLNone = fNone f LamFLIntro = fInvisible f LamFLLambda = fLambda xFlNone, xFlVoid :: Int xFlNone = 0x00 xFlVoid = 0x01 -- | A constant table maps constant references to constant items type ConstTable = Map.Map CRef ConstItem type CRef = Int -- | A constant in the constant table data ConstItem = CGlobal String GType {- CAF, FUN, FUN0, CON, ZCON -} | CInt Int | CInteger Integer | CFloat Float | CDouble Double | CString String | CPos Pos | CVarDesc String Pos deriving (Eq, Ord, Show) -- | Common applicative form, function info, node for non-CAF, constructor info, -- node for zero arity constructor, primitive function info data GType = GCAF | GFUN | GFUN0 | GCON | GZCON | GPRIM | GEXT deriving (Eq, Ord, Show) -- | Code can be several things; -- either a simple list of instructions or a code flow graph data Code = CLinear [(Ins,UseSet)] | CGraph GLabel Graph Jumpers | CWrites [Write] -- | A graph associates labels with graph nodes type Graph = Map.Map GLabel GraphNode -- | Jumpers lists for each label all the graph nodes that might jump to it type Jumpers = Map.Map GLabel (Set.Set GLabel) -- | a graph node is either: -- -- * @ GLinear is eval next -- is = the linear sequence of instructions -- eval = whether this block has an EVAL at the end -- next = the label of the next block -- @ -- -- * @ GCase int alts default -- int = true if this is a case over integers -- alts = the alternatives of the case -- default = the default branch of the case, if any -- @ -- -- * @ GIf true false -- true = the true label of the if -- false = the false label of the if -- @ -- -- * @ GReturn -- terminal node in the graph -- @ data GraphNode = GLinear [UseIns] Bool GLabel | GCase Bool [(Tag,GLabel)] (Maybe GLabel) | GIf GLabel GLabel | GReturn | GDead -- | A graph label, just wraps a label, helps with typechecking and we can sort the other way round data GLabel = GLabel Label deriving Eq -- | It's most useful to have these sorted in increasing order, so labels -- are compared in the reverse order as labels instance Ord GLabel where compare (GLabel x) (GLabel y) = case compare x y of LT -> GT EQ -> EQ GT -> LT instance Show GLabel where show (GLabel l) = "L_" ++ show l -- | A write is a data section that should be written to the final bytecode file, Label is used as a placeholder data Write = WUByte Int | WUShort Int | WLabel Int Label | WByte Int | WShort Int -- | The use set for an instruction lists the variables that the instructions 'gives' -- as well as those that it needs, from this we can calculate what should be zapped. data UseSet = UseSet { useDepth :: Int, useGive :: [String], useNeed :: Set.Set String } -- | Create an empty use set emptyUS :: UseSet emptyUS = UseSet 0 [] Set.empty -- | A bytecode instruction paired with its use set type UseIns = (Ins,UseSet) -- a block is a unflattened section of BCode -- BLinear is - linear block of instructions, this originally corresponds to an -- uninterruptable linear sequence of instructions. Later it's flattened. -- BCase int tags - a case statement block, 'int' is true if the case is over integers -- tags is the list of (tag,code) pairs. -- BIf true false - if block with true and false code -- BFatBar esc code fail - a 'fat bar' is used as an internal way to collect together defaults for cases -- 'esc' is true if the failure can escape. -- BWrite writes - a code block that has been converted into a series of bytes and shorts -- (i.e. assembled). This makes it easier to fix labels to jump addresses -- BFail - go to the 'nearest' fatbar handler. {- data Block = BLinear [(Ins, UseSet)] | BCase Bool [(Tag,Code)] | BIf Code Code | BFatBar Bool Code Code | BWrite [Write] | BFail -} {- data Block = BLinear Label [(Ins,UseSet)] (Maybe Label) | BCase Label Bool [(Tag,Label)] (Maybe Label) | BIf Label Label Label -} type Tag = Int -- | The instructions data Ins = END_CODE | START_FUN -- ^ never appears just used in zap analysis | NEED_STACK Int | NEED_HEAP Int | PUSH Int | PUSH_ZAP Int | ZAP_STACK Int | PUSH_ARG Int -- ^ is this supposed to be an 'Int' or an 'Id'? [SamB] -- ^ Int, first argument = 0, second = 1, etc [TomS] | PUSH_ZAP_ARG Int | ZAP_ARG Int | PUSH_INT Int | PUSH_CHAR Int | PUSH_CONST CRef | MK_AP CRef Int | MK_PAP CRef Int | MK_CON CRef Int | APPLY Int | UNPACK Int | SLIDE Int | POP Int | ALLOC Int | UPDATE Int | RETURN | EVAL | RETURN_EVAL | NOP | P_ADD PrimOp | P_SUB PrimOp | P_MUL PrimOp | P_DIV PrimOp | P_MOD PrimOp | P_CMP_EQ PrimOp | P_CMP_NE PrimOp | P_CMP_LE PrimOp | P_CMP_LT PrimOp | P_CMP_GE PrimOp | P_CMP_GT PrimOp | P_NEG PrimOp | P_STRING | P_FROM_ENUM | CASE Bool [(Tag,Label)] (Maybe Label) | STOP | TABLE_SWITCH [Label] | LOOKUP_SWITCH [(Tag,Label)] Label | INT_SWITCH [(Tag,Label)] Label | JUMP_FALSE Label | JUMP Label | LABEL Label | PRIMITIVE | EXTERNAL | SELECTOR_EVAL | SELECT Int | TAP CRef | TCON CRef | TPRIMCON CRef | TAPPLY CRef Int | TIF CRef | TGUARD CRef | TCASE CRef | TRETURN | TPRIMAP CRef Int | TPRIMRESULT CRef | TPUSH | TPUSHVAR CRef | TPROJECT CRef | COMMENT String deriving (Eq,Ord,Show) type Label = Int frameSize :: Int frameSize = 3 calcHeapExtra :: Flags -> Int calcHeapExtra flags = if sHat flags then 2 else 0 -- | split a qualified name into (module,item) splitQualified :: String -> (String,String) splitQualified s = case break (==';') s of (mod,[]) -> (mod,[]) (mod,i:is) -> (mod,is)