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