Mate/Types.hs

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