Mate/Types.hs

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