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