methodpool: small demo how to access a Data.Map instance from C

yes. it's ugly, unsafe, etc.
but it works :-)

diff --git a/.gitignore b/.gitignore
index 9332ce15575ea9ae8a92093da6827feaa308ab82..874b14dd809fd65eb6fdef76334c0c04ce57eba1 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -2,3 +2,5 @@
 *.class
 mate
 tags
+*_stub.c
+*_stub.h

diff --git a/Mate.hs b/Mate.hs
index fcd8ffca3d745fdc6bf67ac610ea711279133803..e1473daee9c2851e36bfddee3022ab47723f9b19 100644 (file)
--- a/Mate.hs
+++ b/Mate.hs
@@ -1,7 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
+import Text.Printf
+
 import Mate.X86CodeGen
+import Mate.MethodPool
 
 main ::  IO ()
-main = test_01
+main = do
+  printf "fib Codegen:\n"
+  test_01
+  printf "\n\n\n\nData.Map & FFI:\n"
+  t_01

diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs
new file mode 100644 (file)
index 0000000..7f7df1d
--- /dev/null
+++ b/Mate/MethodPool.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Mate.MethodPool where
+
+import Data.Binary
+import Data.Int
+import Data.List
+import Data.Maybe
+import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as B
+
+import Foreign
+import Foreign.Ptr
+import Foreign.StablePtr
+import Foreign.C.Types
+import Foreign.C.String
+
+import Text.Printf
+
+import qualified JVM.Assembler as J
+import JVM.Assembler hiding (Instruction)
+
+import Harpy
+import Harpy.X86Disassembler
+
+import Mate.X86CodeGen
+
+
+foreign import ccall "get_mmap"
+  get_mmap :: IO (Ptr ())
+
+foreign import ccall "set_mmap"
+  set_mmap :: Ptr () -> IO ()
+
+foreign import ccall "demo_mmap"
+  demo_mmap :: IO ()
+
+
+type MMap = M.Map String Word32
+
+foreign export ccall getMethodEntry :: Ptr () -> CString -> IO CUInt
+getMethodEntry :: Ptr () -> CString -> IO CUInt
+getMethodEntry ptr_mmap cstr = do
+  mmap <- deRefStablePtr $ ((castPtrToStablePtr ptr_mmap) :: StablePtr MMap)
+  k <- peekCString cstr
+  case M.lookup k mmap of
+    Nothing -> return 0
+    Just w32 -> return (fromIntegral w32)
+
+t_01 = do
+  (entry, end) <- testCase "./tests/Fib.class" "fib"
+  let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
+  let mmap = M.insert ("fib" :: String) int_entry M.empty
+  mapM_ (\(x,y) -> printf "%s at 0x%08x\n" x y) $ M.toList mmap
+  ptr_mmap <- newStablePtr mmap
+  set_mmap $ castStablePtrToPtr ptr_mmap
+  demo_mmap -- access Data.Map from C

diff --git a/trap.c b/trap.c
index 73b4256da5933fd094405d9bda8b853e03a05380..2e043d7d21cbd479a7c94d7e4e1dd4fe273b7aa0 100644 (file)
--- a/trap.c
+++ b/trap.c
@@ -3,6 +3,27 @@
 #include <signal.h>
 #include <asm/ucontext.h>
 
+unsigned int getMethodEntry(void *, char *);
+void *method_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 demo_mmap()
+{
+       printf("mmap: 0x%08x\n", getMethodEntry(method_map, "fib"));
+}
+
+
 unsigned int patchme = 0;
 void print_foo(unsigned int addr)
 {