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