Mate/Types.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Mate.Types where
   3
   4 import Data.Int
   5 import qualified Data.Map as M
   6 import qualified Data.ByteString.Lazy as B
   7
   8 import Data.IORef
   9 import System.IO.Unsafe
  10
  11 import JVM.ClassFile
  12 import JVM.Assembler
  13
  14 import Mate.NativeSizes
  15
  16
  17 type BlockID = Int
  18 -- Represents a CFG node
  19 data BasicBlock = BasicBlock {
  20   code :: [Instruction],
  21   successor :: BBEnd }
  22
  23 -- describes (leaving) edges of a CFG node
  24 data BBEnd
  25   = Return
  26   | FallThrough BlockID
  27   | OneTarget BlockID
  28   | TwoTarget BlockID BlockID
  29   deriving Show
  30
  31 type MapBB = M.Map BlockID BasicBlock
  32
  33 data RawMethod = RawMethod {
  34   rawMapBB :: MapBB,
  35   rawLocals :: Int,
  36   rawStackSize :: Int,
  37   rawArgCount :: NativeWord,
  38   rawCodeLength :: NativeWord }
  39
  40
  41 -- NativeWord = point of method call in generated code
  42 -- MethodInfo = relevant information about callee
  43 type TrapMap = M.Map NativeWord TrapCause
  44
  45 data TrapCause
  46   = StaticMethod MethodInfo -- for static calls
  47   | VirtualCall Bool MethodInfo (IO NativeWord) -- for invoke{interface,virtual}
  48   | InstanceOf B.ByteString -- class name
  49   | NewObject B.ByteString -- class name
  50   | StaticField StaticFieldInfo
  51
  52 data StaticFieldInfo = StaticFieldInfo {
  53   sfiClassName :: B.ByteString,
  54   sfiFieldName :: B.ByteString } deriving Show
  55
  56
  57
  58 -- B.ByteString = name of method
  59 -- NativeWord = entrypoint of method
  60 type MethodMap = M.Map MethodInfo NativeWord
  61
  62 data MethodInfo = MethodInfo {
  63   methName :: B.ByteString,
  64   methClassName :: B.ByteString,
  65   methSignature :: MethodSignature
  66   } deriving (Eq, Ord)
  67
  68 instance Show MethodInfo where
  69   show (MethodInfo method c sig) =
  70     toString c ++ "." ++ toString method ++ "." ++ show sig
  71
  72
  73
  74 -- store information of loaded classes
  75 type ClassMap = M.Map B.ByteString ClassInfo
  76
  77 data ClassInfo = ClassInfo {
  78   ciName :: B.ByteString,
  79   ciFile :: Class Direct,
  80   ciStaticMap  :: FieldMap,
  81   ciFieldMap :: FieldMap,
  82   ciMethodMap :: FieldMap,
  83   ciMethodBase :: NativeWord,
  84   ciInitDone :: Bool }
  85
  86
  87 -- store field offsets in a map
  88 type FieldMap = M.Map B.ByteString Int32
  89
  90
  91 -- java strings are allocated only once, therefore we
  92 -- use a hashmap to store the address for a String
  93 type StringMap = M.Map B.ByteString NativeWord
  94
  95
  96 -- map "methodtable addr" to "classname"
  97 -- we need that to identify the actual type
  98 -- on the invokevirtual insn
  99 type VirtualMap = M.Map NativeWord B.ByteString
 100
 101
 102 -- store each parsed Interface upon first loading
 103 type InterfaceMap = M.Map B.ByteString (Class Direct)
 104
 105 -- store offset for each <Interface><Method><Signature> pair
 106 type InterfaceMethodMap = M.Map B.ByteString NativeWord
 107
 108
 109 {-
 110 toString :: B.ByteString -> String
 111 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
 112 -}
 113
 114
 115 data MateCtx = MateCtx {
 116   ctxMethodMap :: MethodMap,
 117   ctxTrapMap :: TrapMap,
 118   ctxClassMap :: ClassMap,
 119   ctxVirtualMap :: VirtualMap,
 120   ctxStringMap :: StringMap,
 121   ctxInterfaceMap :: InterfaceMap,
 122   ctxInterfaceMethodMap :: InterfaceMethodMap }
 123
 124 emptyMateCtx :: MateCtx
 125 emptyMateCtx = MateCtx M.empty M.empty M.empty M.empty M.empty M.empty M.empty
 126
 127 mateCtx :: IORef MateCtx
 128 {-# NOINLINE mateCtx #-}
 129 mateCtx = unsafePerformIO $ newIORef emptyMateCtx
 130
 131
 132 setMethodMap :: MethodMap -> IO ()
 133 setMethodMap m = do
 134   ctx <- readIORef mateCtx
 135   writeIORef mateCtx $ ctx { ctxMethodMap = m }
 136
 137 getMethodMap :: IO MethodMap
 138 getMethodMap = do
 139   ctx <- readIORef mateCtx
 140   return $ ctxMethodMap ctx
 141
 142
 143 setTrapMap :: TrapMap -> IO ()
 144 setTrapMap m = do
 145   ctx <- readIORef mateCtx
 146   writeIORef mateCtx $ ctx { ctxTrapMap = m }
 147
 148 getTrapMap :: IO TrapMap
 149 getTrapMap = do
 150   ctx <- readIORef mateCtx
 151   return $ ctxTrapMap ctx
 152
 153
 154 setClassMap :: ClassMap -> IO ()
 155 setClassMap m = do
 156   ctx <- readIORef mateCtx
 157   writeIORef mateCtx $ ctx { ctxClassMap = m }
 158
 159 getClassMap :: IO ClassMap
 160 getClassMap = do
 161   ctx <- readIORef mateCtx
 162   return $ ctxClassMap ctx
 163
 164
 165 setVirtualMap :: VirtualMap -> IO ()
 166 setVirtualMap m = do
 167   ctx <- readIORef mateCtx
 168   writeIORef mateCtx $ ctx { ctxVirtualMap = m }
 169
 170 getVirtualMap :: IO VirtualMap
 171 getVirtualMap = do
 172   ctx <- readIORef mateCtx
 173   return $ ctxVirtualMap ctx
 174
 175
 176 setStringMap :: StringMap -> IO ()
 177 setStringMap m = do
 178   ctx <- readIORef mateCtx
 179   writeIORef mateCtx $ ctx { ctxStringMap = m }
 180
 181 getStringMap :: IO StringMap
 182 getStringMap = do
 183   ctx <- readIORef mateCtx
 184   return $ ctxStringMap ctx
 185
 186
 187 setInterfaceMap :: InterfaceMap -> IO ()
 188 setInterfaceMap m = do
 189   ctx <- readIORef mateCtx
 190   writeIORef mateCtx $ ctx { ctxInterfaceMap = m }
 191
 192 getInterfaceMap :: IO InterfaceMap
 193 getInterfaceMap = do
 194   ctx <- readIORef mateCtx
 195   return $ ctxInterfaceMap ctx
 196
 197
 198 setInterfaceMethodMap :: InterfaceMethodMap -> IO ()
 199 setInterfaceMethodMap m = do
 200   ctx <- readIORef mateCtx
 201   writeIORef mateCtx $ ctx { ctxInterfaceMethodMap = m }
 202
 203 getInterfaceMethodMap :: IO InterfaceMethodMap
 204 getInterfaceMethodMap = do
 205   ctx <- readIORef mateCtx
 206   return $ ctxInterfaceMethodMap ctx