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
31 -- Word32 = point of method call in generated code
32 -- MethodInfo = relevant information about callee
33 type TMap = M.Map Word32 TrapInfo
37 VI MethodInfo | -- for virtual calls
40 data StaticFieldInfo = StaticFieldInfo {
41 sfiClassName :: B.ByteString,
42 sfiFieldName :: B.ByteString }
44 -- B.ByteString = name of method
45 -- Word32 = entrypoint of method
46 type MMap = M.Map MethodInfo Word32
48 type ClassMap = M.Map B.ByteString ClassInfo
50 type FieldMap = M.Map B.ByteString Int32
52 -- java strings are allocated once, therefore we
53 -- use a hashmap to store the address for a String
54 type StringsMap = M.Map B.ByteString Word32
56 -- map "methodtable addr" to "classname"
57 -- we need that to identify the actual type
58 -- on the invokevirtual insn
59 type VirtualMap = M.Map Word32 B.ByteString
61 data ClassInfo = ClassInfo {
62 clName :: B.ByteString,
63 clFile :: Class Resolved,
64 clStaticMap :: FieldMap,
65 clFieldMap :: FieldMap,
66 clMethodMap :: FieldMap,
67 clMethodBase :: Word32,
70 data MethodInfo = MethodInfo {
71 methName :: B.ByteString,
72 cName :: B.ByteString,
73 mSignature :: MethodSignature}
75 instance Eq MethodInfo where
76 (MethodInfo m_a c_a s_a) == (MethodInfo m_b c_b s_b) =
77 (m_a == m_b) && (c_a == c_b) && (s_a == s_b)
79 -- TODO(bernhard): not really efficient. also, outsource that to hs-java
80 instance Ord MethodSignature where
81 compare (MethodSignature args_a ret_a) (MethodSignature args_b ret_b)
82 | cmp_args /= EQ = cmp_args
83 | otherwise = (show ret_a) `compare` (show ret_b)
85 cmp_args = (show args_a) `compare` (show args_b)
87 instance Ord MethodInfo where
88 compare (MethodInfo m_a c_a s_a) (MethodInfo m_b c_b s_b)
91 | otherwise = s_a `compare` s_b
93 cmp_m = m_a `compare` m_b
94 cmp_c = c_a `compare` c_b
96 instance Show MethodInfo where
97 show (MethodInfo method c sig) =
98 (toString c) ++ "." ++ (toString method) ++ "." ++ (show sig)
101 toString :: B.ByteString -> String
102 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
106 foreign import ccall "get_trapmap"
107 get_trapmap :: IO (Ptr ())
109 foreign import ccall "set_trapmap"
110 set_trapmap :: Ptr () -> IO ()
112 foreign import ccall "get_methodmap"
113 get_methodmap :: IO (Ptr ())
115 foreign import ccall "set_methodmap"
116 set_methodmap :: Ptr () -> IO ()
118 foreign import ccall "get_classmap"
119 get_classmap :: IO (Ptr ())
121 foreign import ccall "set_classmap"
122 set_classmap :: Ptr () -> IO ()
124 foreign import ccall "get_virtualmap"
125 get_virtualmap :: IO (Ptr ())
127 foreign import ccall "set_virtualmap"
128 set_virtualmap :: Ptr () -> IO ()
130 foreign import ccall "get_stringsmap"
131 get_stringsmap :: IO (Ptr ())
133 foreign import ccall "set_stringsmap"
134 set_stringsmap :: Ptr () -> IO ()
136 -- TODO(bernhard): make some typeclass magic 'n stuff
137 mmap2ptr :: MMap -> IO (Ptr ())
139 ptr_mmap <- newStablePtr mmap
140 return $ castStablePtrToPtr ptr_mmap
142 ptr2mmap :: Ptr () -> IO MMap
143 ptr2mmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr MMap)
145 tmap2ptr :: TMap -> IO (Ptr ())
147 ptr_tmap <- newStablePtr tmap
148 return $ castStablePtrToPtr ptr_tmap
150 ptr2tmap :: Ptr () -> IO TMap
151 ptr2tmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr tmap)
153 classmap2ptr :: ClassMap -> IO (Ptr ())
154 classmap2ptr cmap = do
155 ptr_cmap <- newStablePtr cmap
156 return $ castStablePtrToPtr ptr_cmap
158 ptr2classmap :: Ptr () -> IO ClassMap
159 ptr2classmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
161 virtualmap2ptr :: VirtualMap -> IO (Ptr ())
162 virtualmap2ptr cmap = do
163 ptr_cmap <- newStablePtr cmap
164 return $ castStablePtrToPtr ptr_cmap
166 ptr2virtualmap :: Ptr () -> IO VirtualMap
167 ptr2virtualmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
170 stringsmap2ptr :: StringsMap -> IO (Ptr ())
171 stringsmap2ptr cmap = do
172 ptr_cmap <- newStablePtr cmap
173 return $ castStablePtrToPtr ptr_cmap
175 ptr2stringsmap :: Ptr () -> IO StringsMap
176 ptr2stringsmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)