native: demo for a call to haskell functions at runtime

still a hack though

diff --git a/Mate/GarbageAlloc.hs b/Mate/GarbageAlloc.hs
index 56bb8f17a80cde7cfa65808258fdecaa74a907be..e7c1cc955a266ab09fb3691945fb8aadd1d5272d 100644 (file)
--- a/Mate/GarbageAlloc.hs
+++ b/Mate/GarbageAlloc.hs
@@ -6,9 +6,7 @@ module Mate.GarbageAlloc where
 import Foreign
 import Foreign.C
 
-#ifdef DEBUG
 import Text.Printf
-#endif
 import Mate.Debug
 
 -- unified place for allocating Memory
@@ -30,3 +28,10 @@ mallocObject size = do
   ptr <- mallocBytes size
   printfStr "mallocObject: %d\n" size
   return $ fromIntegral $ ptrToIntPtr ptr
+
+-- TODO: delete me
+foreign export ccall demoInterfaceCall :: CUInt -> IO ()
+demoInterfaceCall :: CUInt -> IO ()
+demoInterfaceCall val = do
+  printf "demoInterfaceCall: 0x%08x\n" (fromIntegral val :: Word32)
+  return ()

diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs
index 5330ade2e6a5b8d1eac3b3878fd08622a9f91a25..73f47c090a76259fde609f4b1139a28a4191baca 100644 (file)
--- a/Mate/MethodPool.hs
+++ b/Mate/MethodPool.hs
@@ -36,6 +36,9 @@ import Mate.Utilities
 foreign import ccall "dynamic"
    code_void :: FunPtr (IO ()) -> IO ()
 
+foreign import ccall "&demoInterfaceCall"
+  demoInterfaceCallAddr :: FunPtr (CUInt -> IO ())
+
 
 getMethodEntry :: CPtrdiff -> CPtrdiff -> IO CPtrdiff
 getMethodEntry signal_from methodtable = do
@@ -65,15 +68,23 @@ getMethodEntry signal_from methodtable = do
             let flags = methodAccessFlags mm'
             if S.member ACC_NATIVE flags
               then do
-                -- TODO(bernhard): cleaner please... *do'h*
-                let sym1 = replace "/" "_" $ toString cm
-                    parenth = replace "(" "_" $ replace ")" "_" $ toString $ encode sig
-                    sym2 = replace ";" "_" $ replace "/" "_" parenth
-                    symbol = sym1 ++ "__" ++ toString method ++ "__" ++ sym2
-                printfMp "native-call: symbol: %s\n" symbol
-                nf <- loadNativeFunction symbol
-                setMethodMap $ M.insert mi' nf mmap
-                return nf
+                let scm = toString cm; smethod = toString method
+                if scm == "jmate/lang/MateRuntime" then do
+                  case smethod of
+                    "demoInterfaceCall" ->
+                       return . funPtrToAddr $ demoInterfaceCallAddr
+                    _ ->
+                       error $ "native-call: " ++ smethod ++ " not found."
+                else do
+                  -- TODO(bernhard): cleaner please... *do'h*
+                  let sym1 = replace "/" "_" scm
+                      parenth = replace "(" "_" $ replace ")" "_" $ toString $ encode sig
+                      sym2 = replace ";" "_" $ replace "/" "_" parenth
+                      symbol = sym1 ++ "__" ++ smethod ++ "__" ++ sym2
+                  printfMp "native-call: symbol: %s\n" symbol
+                  nf <- loadNativeFunction symbol
+                  setMethodMap $ M.insert mi' nf mmap
+                  return nf
               else do
                 rawmethod <- parseMethod cls' method sig
                 entry <- compileBB rawmethod (MethodInfo method (thisClass cls') sig)
@@ -83,6 +94,9 @@ getMethodEntry signal_from methodtable = do
     Just w32 -> return w32
   return $ fromIntegral entryaddr
 
+funPtrToAddr :: Num b => FunPtr a -> b
+funPtrToAddr = fromIntegral . ptrToIntPtr . castFunPtrToPtr
+
 lookupMethodRecursive :: B.ByteString -> MethodSignature -> [B.ByteString] -> Class Direct
                          -> IO (Maybe (Method Direct, [B.ByteString], Class Direct))
 lookupMethodRecursive name sig clsnames cls =

diff --git a/examples/RuntimeInfo.java b/examples/RuntimeInfo.java
new file mode 100644 (file)
index 0000000..5727199
--- /dev/null
+++ b/examples/RuntimeInfo.java
@@ -0,0 +1,9 @@
+package examples;
+
+import jmate.lang.*;
+
+public class RuntimeInfo {
+       public static void main(String []args) {
+               MateRuntime.demoInterfaceCall(0x1337);
+       }
+}

diff --git a/jmate/lang/MateRuntime.java b/jmate/lang/MateRuntime.java
new file mode 100644 (file)
index 0000000..1a04df9
--- /dev/null
+++ b/jmate/lang/MateRuntime.java
@@ -0,0 +1,5 @@
+package jmate.lang;
+
+public class MateRuntime {
+       public static native void demoInterfaceCall(int val);
+}