TODO: do some haskell magic for conversion functions.
type class? template haskell?
getClassFile :: B.ByteString -> IO (Class Resolved)
getClassFile path = do
- let rpath = toString $ path `B.append` ".class"
- parseClassFile rpath
+ ptr_classmap <- get_classmap
+ class_map <- ptr2classmap ptr_classmap
+ case M.lookup path class_map of
+ Nothing -> do
+ let rpath = toString $ path `B.append` ".class"
+ cfile <- parseClassFile rpath
+ let class_map' = M.insert path (ClassInfo path cfile) class_map
+ classmap2ptr class_map' >>= set_classmap
+ return cfile
+ Just (ClassInfo name cfs) -> return cfs
import Mate.ClassPool
-foreign import ccall "get_mmap"
- get_mmap :: IO (Ptr ())
-
-foreign import ccall "set_mmap"
- set_mmap :: Ptr () -> IO ()
-
foreign import ccall "dynamic"
code_void :: FunPtr (IO ()) -> (IO ())
nf <- loadNativeFunction symbol
let w32_nf = fromIntegral nf
let mmap' = M.insert mi w32_nf mmap
- mmap2ptr mmap' >>= set_mmap
+ mmap2ptr mmap' >>= set_methodmap
return nf
Nothing -> error $ (show method) ++ " not found. abort"
Just w32 -> return (fromIntegral w32)
initMethodPool :: IO ()
initMethodPool = do
- mmap2ptr M.empty >>= set_mmap
- cmap2ptr M.empty >>= set_cmap
+ mmap2ptr M.empty >>= set_methodmap
+ cmap2ptr M.empty >>= set_callermap
+ classmap2ptr M.empty >>= set_classmap
compileBB :: MapBB -> MethodInfo -> IO (Ptr Word8)
compileBB hmap methodinfo = do
- mmap <- get_mmap >>= ptr2mmap
- cmap <- get_cmap >>= ptr2cmap
+ mmap <- get_methodmap >>= ptr2mmap
+ cmap <- get_callermap >>= ptr2cmap
-- TODO(bernhard): replace parsing with some kind of classpool
cls <- getClassFile (cName methodinfo)
let mmap' = M.insert methodinfo w32_entry mmap
let cmap' = M.union cmap new_cmap -- prefers elements in cmap
- mmap2ptr mmap' >>= set_mmap
- cmap2ptr cmap' >>= set_cmap
+ mmap2ptr mmap' >>= set_methodmap
+ cmap2ptr cmap' >>= set_callermap
printf "disasm:\n"
mapM_ (putStrLn . showAtt) disasm
executeFuncPtr :: Ptr Word8 -> IO ()
executeFuncPtr entry = code_void $ ((castPtrToFunPtr entry) :: FunPtr (IO ()))
-
--- TODO(bernhard): make some typeclass magic 'n stuff
-mmap2ptr :: MMap -> IO (Ptr ())
-mmap2ptr mmap = do
- ptr_mmap <- newStablePtr mmap
- return $ castStablePtrToPtr ptr_mmap
-
-ptr2mmap :: Ptr () -> IO MMap
-ptr2mmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr MMap)
-
-cmap2ptr :: CMap -> IO (Ptr ())
-cmap2ptr cmap = do
- ptr_cmap <- newStablePtr cmap
- return $ castStablePtrToPtr ptr_cmap
-
-ptr2cmap :: Ptr () -> IO CMap
-ptr2cmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
module Mate.Types where
import Data.Char
import qualified Data.ByteString.Lazy as B
import Codec.Binary.UTF8.String hiding (encode,decode)
+import Foreign.Ptr
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.StablePtr
+
import JVM.ClassFile
import JVM.Assembler
-- Word32 = entrypoint of method
type MMap = M.Map MethodInfo Word32
+type ClassMap = M.Map B.ByteString ClassInfo
+
+data ClassInfo = ClassInfo {
+ clName :: B.ByteString,
+ clFile :: Class Resolved }
data MethodInfo = MethodInfo {
toString :: B.ByteString -> String
toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
+
+
+-- global map hax
+foreign import ccall "get_callermap"
+ get_callermap :: IO (Ptr ())
+
+foreign import ccall "set_callermap"
+ set_callermap :: Ptr () -> IO ()
+
+foreign import ccall "get_methodmap"
+ get_methodmap :: IO (Ptr ())
+
+foreign import ccall "set_methodmap"
+ set_methodmap :: Ptr () -> IO ()
+
+foreign import ccall "get_classmap"
+ get_classmap :: IO (Ptr ())
+
+foreign import ccall "set_classmap"
+ set_classmap :: Ptr () -> IO ()
+
+-- TODO(bernhard): make some typeclass magic 'n stuff
+mmap2ptr :: MMap -> IO (Ptr ())
+mmap2ptr mmap = do
+ ptr_mmap <- newStablePtr mmap
+ return $ castStablePtrToPtr ptr_mmap
+
+ptr2mmap :: Ptr () -> IO MMap
+ptr2mmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr MMap)
+
+cmap2ptr :: CMap -> IO (Ptr ())
+cmap2ptr cmap = do
+ ptr_cmap <- newStablePtr cmap
+ return $ castStablePtrToPtr ptr_cmap
+
+ptr2cmap :: Ptr () -> IO CMap
+ptr2cmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
+
+classmap2ptr :: ClassMap -> IO (Ptr ())
+classmap2ptr cmap = do
+ ptr_cmap <- newStablePtr cmap
+ return $ castStablePtrToPtr ptr_cmap
+
+ptr2classmap :: Ptr () -> IO ClassMap
+ptr2classmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
foreign import ccall "register_signal"
register_signal :: IO ()
-foreign import ccall "get_cmap"
- get_cmap :: IO (Ptr ())
-
-foreign import ccall "set_cmap"
- set_cmap :: Ptr () -> IO ()
-
test_01, test_02, test_03 :: IO ()
test_01 = do
register_signal
unsigned int getMethodEntry(unsigned int, void *, void *);
-void *method_map = NULL;
-void *caller_map = NULL;
-
-void set_mmap(void *mmap)
-{
- printf("set_mmap: 0x%08x\n", (unsigned int) mmap);
- method_map = mmap;
-}
-
-void *get_mmap()
-{
- printf("get_mmap: 0x%08x\n", (unsigned int) method_map);
- return method_map;
-}
-
-void set_cmap(void *cmap)
-{
- printf("set_cmap: 0x%08x\n", (unsigned int) cmap);
- caller_map = cmap;
-}
+#define NEW_MAP(prefix) \
+ void* prefix ## _map = NULL; \
+ void set_ ## prefix ## map(void *map) \
+ { \
+ printf("set_%s: 0x%08x\n", #prefix , (unsigned int) map); \
+ prefix ## _map = map; \
+ } \
+ void *get_ ## prefix ## map() \
+ { \
+ printf("get_%s: 0x%08x\n", #prefix , (unsigned int) prefix ## _map); \
+ return prefix ## _map; \
+ }
-void *get_cmap()
-{
- printf("get_cmap: 0x%08x\n", (unsigned int) caller_map);
- return caller_map;
-}
+NEW_MAP(method)
+NEW_MAP(caller)
+NEW_MAP(class)
void mainresult(unsigned int a)
public static int a;
public static int b;
+ static {
+ Static1.a = 0x1337;
+ }
+
public static void main(String []args) {
Static1.a = 0x11;
Static1.b = 0x22;