Mate/Types.hs

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