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)
65 cmp_args = (show args_a) `compare` (show args_b)
67 instance Show MethodInfo where
68 show (MethodInfo method c sig) =
69 (toString c) ++ "." ++ (toString method) ++ "." ++ (show sig)
73 -- store information of loaded classes
74 type ClassMap = M.Map B.ByteString ClassInfo
76 data ClassInfo = ClassInfo {
77 ciName :: B.ByteString,
78 ciFile :: Class Resolved,
79 ciStaticMap :: FieldMap,
80 ciFieldMap :: FieldMap,
81 ciMethodMap :: FieldMap,
82 ciMethodBase :: Word32,
86 -- store field offsets in a map
87 type FieldMap = M.Map B.ByteString Int32
90 -- java strings are allocated only once, therefore we
91 -- use a hashmap to store the address for a String
92 type StringsMap = M.Map B.ByteString Word32
95 -- map "methodtable addr" to "classname"
96 -- we need that to identify the actual type
97 -- on the invokevirtual insn
98 type VirtualMap = M.Map Word32 B.ByteString
101 -- store each parsed Interface upon first loading
102 type InterfacesMap = M.Map B.ByteString (Class Resolved)
104 -- store offset for each <Interface><Method><Signature> pair
105 type InterfaceMethodMap = M.Map B.ByteString Word32
108 toString :: B.ByteString -> String
109 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
112 -- those functions are for the "global map hax"
113 -- TODO(bernhard): other solution please
114 foreign import ccall "get_trapmap"
115 get_trapmap :: IO (Ptr ())
117 foreign import ccall "set_trapmap"
118 set_trapmap :: Ptr () -> IO ()
120 foreign import ccall "get_methodmap"
121 get_methodmap :: IO (Ptr ())
123 foreign import ccall "set_methodmap"
124 set_methodmap :: Ptr () -> IO ()
126 foreign import ccall "get_classmap"
127 get_classmap :: IO (Ptr ())
129 foreign import ccall "set_classmap"
130 set_classmap :: Ptr () -> IO ()
132 foreign import ccall "get_virtualmap"
133 get_virtualmap :: IO (Ptr ())
135 foreign import ccall "set_virtualmap"
136 set_virtualmap :: Ptr () -> IO ()
138 foreign import ccall "get_stringsmap"
139 get_stringsmap :: IO (Ptr ())
141 foreign import ccall "set_stringsmap"
142 set_stringsmap :: Ptr () -> IO ()
144 foreign import ccall "get_interfacesmap"
145 get_interfacesmap :: IO (Ptr ())
147 foreign import ccall "set_interfacesmap"
148 set_interfacesmap :: Ptr () -> IO ()
150 foreign import ccall "get_interfacemethodmap"
151 get_interfacemethodmap :: IO (Ptr ())
153 foreign import ccall "set_interfacemethodmap"
154 set_interfacemethodmap :: Ptr () -> IO ()
156 -- TODO(bernhard): make some typeclass magic 'n stuff
157 -- or remove that sh**
158 methodmap2ptr :: MethodMap -> IO (Ptr ())
159 methodmap2ptr methodmap = do
160 ptr_methodmap <- newStablePtr methodmap
161 return $ castStablePtrToPtr ptr_methodmap
163 ptr2methodmap :: Ptr () -> IO MethodMap
164 ptr2methodmap methodmap = deRefStablePtr $ ((castPtrToStablePtr methodmap) :: StablePtr MethodMap)
166 trapmap2ptr :: TrapMap -> IO (Ptr ())
167 trapmap2ptr trapmap = do
168 ptr_trapmap <- newStablePtr trapmap
169 return $ castStablePtrToPtr ptr_trapmap
171 ptr2trapmap :: Ptr () -> IO TrapMap
172 ptr2trapmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr trapmap)
174 classmap2ptr :: ClassMap -> IO (Ptr ())
175 classmap2ptr cmap = do
176 ptr_cmap <- newStablePtr cmap
177 return $ castStablePtrToPtr ptr_cmap
179 ptr2classmap :: Ptr () -> IO ClassMap
180 ptr2classmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
182 virtualmap2ptr :: VirtualMap -> IO (Ptr ())
183 virtualmap2ptr cmap = do
184 ptr_cmap <- newStablePtr cmap
185 return $ castStablePtrToPtr ptr_cmap
187 ptr2virtualmap :: Ptr () -> IO VirtualMap
188 ptr2virtualmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
191 stringsmap2ptr :: StringsMap -> IO (Ptr ())
192 stringsmap2ptr cmap = do
193 ptr_cmap <- newStablePtr cmap
194 return $ castStablePtrToPtr ptr_cmap
196 ptr2stringsmap :: Ptr () -> IO StringsMap
197 ptr2stringsmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
200 interfacesmap2ptr :: InterfacesMap -> IO (Ptr ())
201 interfacesmap2ptr cmap = do
202 ptr_cmap <- newStablePtr cmap
203 return $ castStablePtrToPtr ptr_cmap
205 ptr2interfacesmap :: Ptr () -> IO InterfacesMap
206 ptr2interfacesmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
209 interfacemethodmap2ptr :: InterfaceMethodMap -> IO (Ptr ())
210 interfacemethodmap2ptr cmap = do
211 ptr_cmap <- newStablePtr cmap
212 return $ castStablePtrToPtr ptr_cmap
214 ptr2interfacemethodmap :: Ptr () -> IO InterfaceMethodMap
215 ptr2interfacemethodmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)