Mate/Types.hs

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