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
  72 data TrapCause
  73   = StaticMethod TrapPatcher -- for static calls
  74   | VirtualCall Bool MethodInfo (IO NativeWord) -- for invoke{interface,virtual}
  75   | InstanceOf TrapPatcherEax
  76   | NewObject TrapPatcher
  77   | StaticField StaticFieldInfo
  78   | ObjectField TrapPatcher
  79
  80 data StaticFieldInfo = StaticFieldInfo {
  81   sfiClassName :: B.ByteString,
  82   sfiFieldName :: B.ByteString } deriving Show
  83
  84
  85
  86 -- B.ByteString = name of method
  87 -- NativeWord = entrypoint of method
  88 type MethodMap = M.Map MethodInfo NativeWord
  89
  90 data MethodInfo = MethodInfo {
  91   methName :: B.ByteString,
  92   methClassName :: B.ByteString,
  93   methSignature :: MethodSignature
  94   } deriving (Eq, Ord)
  95
  96 instance Show MethodInfo where
  97   show (MethodInfo method c sig) =
  98     toString c ++ "." ++ toString method ++ "." ++ show sig
  99
 100
 101
 102 -- store information of loaded classes
 103 type ClassMap = M.Map B.ByteString ClassInfo
 104
 105 data ClassInfo = ClassInfo {
 106   ciName :: B.ByteString,
 107   ciFile :: Class Direct,
 108   ciStaticMap  :: FieldMap,
 109   ciFieldMap :: FieldMap,
 110   ciMethodMap :: FieldMap,
 111   ciMethodBase :: NativeWord,
 112   ciInitDone :: Bool }
 113
 114
 115 -- store field offsets in a map
 116 type FieldMap = M.Map B.ByteString Int32
 117
 118
 119 -- java strings are allocated only once, therefore we
 120 -- use a hashmap to store the address for a String
 121 type StringMap = M.Map B.ByteString NativeWord
 122
 123
 124 -- map "methodtable addr" to "classname"
 125 -- we need that to identify the actual type
 126 -- on the invokevirtual insn
 127 type VirtualMap = M.Map NativeWord B.ByteString
 128
 129
 130 -- store each parsed Interface upon first loading
 131 type InterfaceMap = M.Map B.ByteString (Class Direct)
 132
 133 -- store offset for each <Interface><Method><Signature> pair
 134 type InterfaceMethodMap = M.Map B.ByteString NativeWord
 135
 136
 137 {-
 138 toString :: B.ByteString -> String
 139 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
 140 -}
 141
 142
 143 data MateCtx = MateCtx {
 144   ctxMethodMap :: MethodMap,
 145   ctxTrapMap :: TrapMap,
 146   ctxClassMap :: ClassMap,
 147   ctxVirtualMap :: VirtualMap,
 148   ctxStringMap :: StringMap,
 149   ctxInterfaceMap :: InterfaceMap,
 150   ctxInterfaceMethodMap :: InterfaceMethodMap }
 151
 152 emptyMateCtx :: MateCtx
 153 emptyMateCtx = MateCtx M.empty M.empty M.empty M.empty M.empty M.empty M.empty
 154
 155 mateCtx :: IORef MateCtx
 156 {-# NOINLINE mateCtx #-}
 157 mateCtx = unsafePerformIO $ newIORef emptyMateCtx
 158
 159 setMap :: (MateCtx -> MateCtx) -> IO ()
 160 setMap recordupdate = recordupdate <$> readIORef mateCtx >>= writeIORef mateCtx
 161
 162 setMethodMap :: MethodMap -> IO ()
 163 setMethodMap m = setMap (\x -> x {ctxMethodMap = m})
 164
 165 getMethodMap :: IO MethodMap
 166 getMethodMap = ctxMethodMap <$> readIORef mateCtx
 167
 168 setTrapMap :: TrapMap -> IO ()
 169 setTrapMap m = setMap (\x -> x {ctxTrapMap = m})
 170
 171 getTrapMap :: IO TrapMap
 172 getTrapMap = ctxTrapMap <$> readIORef mateCtx
 173
 174 setClassMap :: ClassMap -> IO ()
 175 setClassMap m = setMap (\x -> x {ctxClassMap = m})
 176
 177 getClassMap :: IO ClassMap
 178 getClassMap = ctxClassMap <$> readIORef mateCtx
 179
 180 setVirtualMap :: VirtualMap -> IO ()
 181 setVirtualMap m = setMap (\x -> x {ctxVirtualMap = m})
 182
 183 getVirtualMap :: IO VirtualMap
 184 getVirtualMap = ctxVirtualMap <$> readIORef mateCtx
 185
 186 setStringMap :: StringMap -> IO ()
 187 setStringMap m = setMap (\x -> x {ctxStringMap = m})
 188
 189 getStringMap :: IO StringMap
 190 getStringMap = ctxStringMap <$> readIORef mateCtx
 191
 192 setInterfaceMap :: InterfaceMap -> IO ()
 193 setInterfaceMap m = setMap (\x -> x {ctxInterfaceMap = m})
 194
 195 getInterfaceMap :: IO InterfaceMap
 196 getInterfaceMap = ctxInterfaceMap <$> readIORef mateCtx
 197
 198 setInterfaceMethodMap :: InterfaceMethodMap -> IO ()
 199 setInterfaceMethodMap m = setMap (\x -> x {ctxInterfaceMethodMap = m})
 200
 201 getInterfaceMethodMap :: IO InterfaceMethodMap
 202 getInterfaceMethodMap = ctxInterfaceMethodMap <$> readIORef mateCtx