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