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