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