Mate/Types.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE CPP #-}
   3 module Mate.Types where
   4
   5 import Data.Int
   6 import qualified Data.Map as M
   7 import qualified Data.ByteString.Lazy as B
   8
   9 import Data.IORef
  10 import System.IO.Unsafe
  11
  12 import JVM.ClassFile
  13 import JVM.Assembler
  14
  15 import Mate.NativeSizes
  16
  17
  18 type BlockID = Int
  19 -- Represents a CFG node
  20 data BasicBlock = BasicBlock {
  21   code :: [Instruction],
  22   successor :: BBEnd }
  23
  24 -- describes (leaving) edges of a CFG node
  25 data BBEnd
  26   = Return
  27   | FallThrough BlockID
  28   | OneTarget BlockID
  29   | TwoTarget BlockID BlockID
  30   deriving Show
  31
  32 type MapBB = M.Map BlockID BasicBlock
  33
  34 data RawMethod = RawMethod {
  35   rawMapBB :: MapBB,
  36   rawLocals :: Int,
  37   rawStackSize :: Int,
  38   rawArgCount :: NativeWord,
  39   rawCodeLength :: NativeWord }
  40
  41
  42 -- NativeWord = point of method call in generated code
  43 -- MethodInfo = relevant information about callee
  44 type TrapMap = M.Map NativeWord TrapCause
  45
  46 data TrapCause
  47   = StaticMethod MethodInfo -- for static calls
  48   | VirtualCall Bool MethodInfo (IO NativeWord) -- for invoke{interface,virtual}
  49   | InstanceOf B.ByteString -- class name
  50   | NewObject B.ByteString -- class name
  51   | StaticField StaticFieldInfo
  52
  53 data StaticFieldInfo = StaticFieldInfo {
  54   sfiClassName :: B.ByteString,
  55   sfiFieldName :: B.ByteString } deriving Show
  56
  57
  58
  59 -- B.ByteString = name of method
  60 -- NativeWord = entrypoint of method
  61 type MethodMap = M.Map MethodInfo NativeWord
  62
  63 data MethodInfo = MethodInfo {
  64   methName :: B.ByteString,
  65   methClassName :: B.ByteString,
  66   methSignature :: MethodSignature
  67   } deriving (Eq, Ord)
  68
  69 instance Show MethodInfo where
  70   show (MethodInfo method c sig) =
  71     toString c ++ "." ++ toString method ++ "." ++ show sig
  72
  73
  74
  75 -- store information of loaded classes
  76 type ClassMap = M.Map B.ByteString ClassInfo
  77
  78 data ClassInfo = ClassInfo {
  79   ciName :: B.ByteString,
  80   ciFile :: Class Direct,
  81   ciStaticMap  :: FieldMap,
  82   ciFieldMap :: FieldMap,
  83   ciMethodMap :: FieldMap,
  84   ciMethodBase :: NativeWord,
  85   ciInitDone :: Bool }
  86
  87
  88 -- store field offsets in a map
  89 type FieldMap = M.Map B.ByteString Int32
  90
  91
  92 -- java strings are allocated only once, therefore we
  93 -- use a hashmap to store the address for a String
  94 type StringMap = M.Map B.ByteString NativeWord
  95
  96
  97 -- map "methodtable addr" to "classname"
  98 -- we need that to identify the actual type
  99 -- on the invokevirtual insn
 100 type VirtualMap = M.Map NativeWord B.ByteString
 101
 102
 103 -- store each parsed Interface upon first loading
 104 type InterfaceMap = M.Map B.ByteString (Class Direct)
 105
 106 -- store offset for each <Interface><Method><Signature> pair
 107 type InterfaceMethodMap = M.Map B.ByteString NativeWord
 108
 109
 110 {-
 111 toString :: B.ByteString -> String
 112 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
 113 -}
 114
 115 -- better solutions for a global map hack are welcome! (typeclasses, TH, ...?)
 116
 117 data MateCtx = MateCtx {
 118   ctxMethodMap :: MethodMap,
 119   ctxTrapMap :: TrapMap,
 120   ctxClassMap :: ClassMap,
 121   ctxVirtualMap :: VirtualMap,
 122   ctxStringMap :: StringMap,
 123   ctxInterfaceMap :: InterfaceMap,
 124   ctxInterfaceMethodMap :: InterfaceMethodMap }
 125
 126 emptyMateCtx :: MateCtx
 127 emptyMateCtx = MateCtx M.empty M.empty M.empty M.empty M.empty M.empty M.empty
 128
 129 mateCtx :: IORef MateCtx
 130 {-# NOINLINE mateCtx #-}
 131 mateCtx = unsafePerformIO $ newIORef emptyMateCtx
 132
 133 -- TODO(bernhard): if we ever have thread support, don't forget MVars
 134 #define SETMAP(name) set##name :: name -> IO (); \
 135   set##name m = do ctx <- readIORef mateCtx; \
 136   writeIORef mateCtx $ ctx { ctx##name = m };
 137
 138 #define GETMAP(name) get##name :: IO name ; \
 139   get##name = do ctx <- readIORef mateCtx; \
 140   return $ ctx##name ctx;
 141
 142 SETMAP(MethodMap);
 143 GETMAP(MethodMap)
 144
 145 SETMAP(TrapMap)
 146 GETMAP(TrapMap)
 147
 148 SETMAP(ClassMap)
 149 GETMAP(ClassMap)
 150
 151 SETMAP(VirtualMap)
 152 GETMAP(VirtualMap)
 153
 154 SETMAP(StringMap)
 155 GETMAP(StringMap)
 156
 157 SETMAP(InterfaceMap)
 158 GETMAP(InterfaceMap)
 159
 160 SETMAP(InterfaceMethodMap)
 161 GETMAP(InterfaceMethodMap)