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