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