Mate/Types.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE CPP #-}
   3 module Mate.Types where
   4
   5 import Data.Int
   6 import qualified Data.Map as M
   7 import qualified Data.ByteString.Lazy as B
   8
   9 import Data.IORef
  10 import System.IO.Unsafe
  11
  12 import JVM.ClassFile
  13 import JVM.Assembler
  14
  15 import Mate.NativeSizes
  16
  17
  18 type BlockID = Int
  19 -- Represents a CFG node
  20 data BasicBlock = BasicBlock {
  21   code :: [Instruction],
  22   successor :: BBEnd }
  23
  24 -- describes (leaving) edges of a CFG node
  25 data BBEnd = Return | FallThrough BlockID | OneTarget BlockID | TwoTarget BlockID BlockID deriving Show
  26
  27 type MapBB = M.Map BlockID BasicBlock
  28
  29 data RawMethod = RawMethod {
  30   rawMapBB :: MapBB,
  31   rawLocals :: Int,
  32   rawStackSize :: Int,
  33   rawArgCount :: NativeWord,
  34   rawCodeLength :: NativeWord }
  35
  36
  37 -- NativeWord = point of method call in generated code
  38 -- MethodInfo = relevant information about callee
  39 type TrapMap = M.Map NativeWord TrapCause
  40
  41 data TrapCause =
  42   StaticMethod MethodInfo | -- for static calls
  43   VirtualCall Bool MethodInfo (IO NativeWord) | -- for invoke{interface,virtual}
  44   InstanceOf B.ByteString | -- class name
  45   NewObject B.ByteString | -- class name
  46   StaticField StaticFieldInfo
  47
  48 data StaticFieldInfo = StaticFieldInfo {
  49   sfiClassName :: B.ByteString,
  50   sfiFieldName :: B.ByteString } deriving Show
  51
  52
  53
  54 -- B.ByteString = name of method
  55 -- NativeWord = entrypoint of method
  56 type MethodMap = M.Map MethodInfo NativeWord
  57
  58 data MethodInfo = MethodInfo {
  59   methName :: B.ByteString,
  60   methClassName :: B.ByteString,
  61   methSignature :: MethodSignature
  62   } deriving (Eq, Ord)
  63
  64 instance Show MethodInfo where
  65   show (MethodInfo method c sig) =
  66     toString c ++ "." ++ toString method ++ "." ++ show sig
  67
  68
  69
  70 -- store information of loaded classes
  71 type ClassMap = M.Map B.ByteString ClassInfo
  72
  73 data ClassInfo = ClassInfo {
  74   ciName :: B.ByteString,
  75   ciFile :: Class Direct,
  76   ciStaticMap  :: FieldMap,
  77   ciFieldMap :: FieldMap,
  78   ciMethodMap :: FieldMap,
  79   ciMethodBase :: NativeWord,
  80   ciInitDone :: Bool }
  81
  82
  83 -- store field offsets in a map
  84 type FieldMap = M.Map B.ByteString Int32
  85
  86
  87 -- java strings are allocated only once, therefore we
  88 -- use a hashmap to store the address for a String
  89 type StringMap = M.Map B.ByteString NativeWord
  90
  91
  92 -- map "methodtable addr" to "classname"
  93 -- we need that to identify the actual type
  94 -- on the invokevirtual insn
  95 type VirtualMap = M.Map NativeWord B.ByteString
  96
  97
  98 -- store each parsed Interface upon first loading
  99 type InterfaceMap = M.Map B.ByteString (Class Direct)
 100
 101 -- store offset for each <Interface><Method><Signature> pair
 102 type InterfaceMethodMap = M.Map B.ByteString NativeWord
 103
 104
 105 {-
 106 toString :: B.ByteString -> String
 107 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
 108 -}
 109
 110 -- better solutions for a global map hack are welcome! (typeclasses, TH, ...?)
 111
 112 data MateCtx = MateCtx {
 113   ctxMethodMap :: MethodMap,
 114   ctxTrapMap :: TrapMap,
 115   ctxClassMap :: ClassMap,
 116   ctxVirtualMap :: VirtualMap,
 117   ctxStringMap :: StringMap,
 118   ctxInterfaceMap :: InterfaceMap,
 119   ctxInterfaceMethodMap :: InterfaceMethodMap }
 120
 121 emptyMateCtx :: MateCtx
 122 emptyMateCtx = MateCtx M.empty M.empty M.empty M.empty M.empty M.empty M.empty
 123
 124 mateCtx :: IORef MateCtx
 125 {-# NOINLINE mateCtx #-}
 126 mateCtx = unsafePerformIO $ newIORef emptyMateCtx
 127
 128 -- TODO(bernhard): if we ever have thread support, don't forget MVars
 129 #define SETMAP(name) set##name :: name -> IO (); \
 130   set##name m = do ctx <- readIORef mateCtx; \
 131   writeIORef mateCtx $ ctx { ctx##name = m };
 132
 133 #define GETMAP(name) get##name :: IO name ; \
 134   get##name = do ctx <- readIORef mateCtx; \
 135   return $ ctx##name ctx;
 136
 137 SETMAP(MethodMap);
 138 GETMAP(MethodMap)
 139
 140 SETMAP(TrapMap)
 141 GETMAP(TrapMap)
 142
 143 SETMAP(ClassMap)
 144 GETMAP(ClassMap)
 145
 146 SETMAP(VirtualMap)
 147 GETMAP(VirtualMap)
 148
 149 SETMAP(StringMap)
 150 GETMAP(StringMap)
 151
 152 SETMAP(InterfaceMap)
 153 GETMAP(InterfaceMap)
 154
 155 SETMAP(InterfaceMethodMap)
 156 GETMAP(InterfaceMethodMap)