1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ForeignFunctionInterface #-}
3 module Mate.Types where
8 import qualified Data.Map as M
9 import qualified Data.ByteString.Lazy as B
10 import Codec.Binary.UTF8.String hiding (encode,decode)
13 import Foreign.StablePtr
20 -- Represents a CFG node
21 data BasicBlock = BasicBlock {
22 code :: [Instruction],
25 -- describes (leaving) edges of a CFG node
26 data BBEnd = Return | FallThrough BlockID | OneTarget BlockID | TwoTarget BlockID BlockID deriving Show
28 type MapBB = M.Map BlockID BasicBlock
32 -- Word32 = point of method call in generated code
33 -- MethodInfo = relevant information about callee
34 type TrapMap = M.Map Word32 TrapInfo
37 MI MethodInfo | -- for static calls
38 VI MethodInfo | -- for virtual calls
39 II MethodInfo | -- for interface calls
40 SFI StaticFieldInfo deriving Show
42 data StaticFieldInfo = StaticFieldInfo {
43 sfiClassName :: B.ByteString,
44 sfiFieldName :: B.ByteString } deriving Show
48 -- B.ByteString = name of method
49 -- Word32 = entrypoint of method
50 type MethodMap = M.Map MethodInfo Word32
52 data MethodInfo = MethodInfo {
53 methName :: B.ByteString,
54 methClassName :: B.ByteString,
55 methSignature :: MethodSignature
58 -- TODO(bernhard): not really efficient. also, outsource that to hs-java
59 -- deriving should be enough?
60 instance Ord MethodSignature where
61 compare (MethodSignature args_a ret_a) (MethodSignature args_b ret_b)
62 | cmp_args /= EQ = cmp_args
63 | otherwise = show ret_a `compare` show ret_b
64 where cmp_args = show args_a `compare` show args_b
66 instance Show MethodInfo where
67 show (MethodInfo method c sig) =
68 toString c ++ "." ++ toString method ++ "." ++ show sig
72 -- store information of loaded classes
73 type ClassMap = M.Map B.ByteString ClassInfo
75 data ClassInfo = ClassInfo {
76 ciName :: B.ByteString,
77 ciFile :: Class Resolved,
78 ciStaticMap :: FieldMap,
79 ciFieldMap :: FieldMap,
80 ciMethodMap :: FieldMap,
81 ciMethodBase :: Word32,
85 -- store field offsets in a map
86 type FieldMap = M.Map B.ByteString Int32
89 -- java strings are allocated only once, therefore we
90 -- use a hashmap to store the address for a String
91 type StringsMap = M.Map B.ByteString Word32
94 -- map "methodtable addr" to "classname"
95 -- we need that to identify the actual type
96 -- on the invokevirtual insn
97 type VirtualMap = M.Map Word32 B.ByteString
100 -- store each parsed Interface upon first loading
101 type InterfacesMap = M.Map B.ByteString (Class Resolved)
103 -- store offset for each <Interface><Method><Signature> pair
104 type InterfaceMethodMap = M.Map B.ByteString Word32
107 toString :: B.ByteString -> String
108 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
111 -- those functions are for the "global map hax"
112 -- TODO(bernhard): other solution please
113 foreign import ccall "get_trapmap"
114 get_trapmap :: IO (Ptr ())
116 foreign import ccall "set_trapmap"
117 set_trapmap :: Ptr () -> IO ()
119 foreign import ccall "get_methodmap"
120 get_methodmap :: IO (Ptr ())
122 foreign import ccall "set_methodmap"
123 set_methodmap :: Ptr () -> IO ()
125 foreign import ccall "get_classmap"
126 get_classmap :: IO (Ptr ())
128 foreign import ccall "set_classmap"
129 set_classmap :: Ptr () -> IO ()
131 foreign import ccall "get_virtualmap"
132 get_virtualmap :: IO (Ptr ())
134 foreign import ccall "set_virtualmap"
135 set_virtualmap :: Ptr () -> IO ()
137 foreign import ccall "get_stringsmap"
138 get_stringsmap :: IO (Ptr ())
140 foreign import ccall "set_stringsmap"
141 set_stringsmap :: Ptr () -> IO ()
143 foreign import ccall "get_interfacesmap"
144 get_interfacesmap :: IO (Ptr ())
146 foreign import ccall "set_interfacesmap"
147 set_interfacesmap :: Ptr () -> IO ()
149 foreign import ccall "get_interfacemethodmap"
150 get_interfacemethodmap :: IO (Ptr ())
152 foreign import ccall "set_interfacemethodmap"
153 set_interfacemethodmap :: Ptr () -> IO ()
155 -- TODO(bernhard): make some typeclass magic 'n stuff
156 -- or remove that sh**
157 methodmap2ptr :: MethodMap -> IO (Ptr ())
158 methodmap2ptr methodmap = do
159 ptr_methodmap <- newStablePtr methodmap
160 return $ castStablePtrToPtr ptr_methodmap
162 ptr2methodmap :: Ptr () -> IO MethodMap
163 ptr2methodmap methodmap = deRefStablePtr (castPtrToStablePtr methodmap :: StablePtr MethodMap)
165 trapmap2ptr :: TrapMap -> IO (Ptr ())
166 trapmap2ptr trapmap = do
167 ptr_trapmap <- newStablePtr trapmap
168 return $ castStablePtrToPtr ptr_trapmap
170 ptr2trapmap :: Ptr () -> IO TrapMap
171 ptr2trapmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr trapmap)
173 classmap2ptr :: ClassMap -> IO (Ptr ())
174 classmap2ptr cmap = do
175 ptr_cmap <- newStablePtr cmap
176 return $ castStablePtrToPtr ptr_cmap
178 ptr2classmap :: Ptr () -> IO ClassMap
179 ptr2classmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr cmap)
181 virtualmap2ptr :: VirtualMap -> IO (Ptr ())
182 virtualmap2ptr cmap = do
183 ptr_cmap <- newStablePtr cmap
184 return $ castStablePtrToPtr ptr_cmap
186 ptr2virtualmap :: Ptr () -> IO VirtualMap
187 ptr2virtualmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr cmap)
190 stringsmap2ptr :: StringsMap -> IO (Ptr ())
191 stringsmap2ptr cmap = do
192 ptr_cmap <- newStablePtr cmap
193 return $ castStablePtrToPtr ptr_cmap
195 ptr2stringsmap :: Ptr () -> IO StringsMap
196 ptr2stringsmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr cmap)
199 interfacesmap2ptr :: InterfacesMap -> IO (Ptr ())
200 interfacesmap2ptr cmap = do
201 ptr_cmap <- newStablePtr cmap
202 return $ castStablePtrToPtr ptr_cmap
204 ptr2interfacesmap :: Ptr () -> IO InterfacesMap
205 ptr2interfacesmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr cmap)
208 interfacemethodmap2ptr :: InterfaceMethodMap -> IO (Ptr ())
209 interfacemethodmap2ptr cmap = do
210 ptr_cmap <- newStablePtr cmap
211 return $ castStablePtrToPtr ptr_cmap
213 ptr2interfacemethodmap :: Ptr () -> IO InterfaceMethodMap
214 ptr2interfacemethodmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr cmap)