From: Bernhard Urban Date: Sun, 22 Apr 2012 23:14:45 +0000 (+0200) Subject: methodpool: also call native methods X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=cf43ecc7ce06b6cbfa675239d050e3de30b15103 methodpool: also call native methods some comments: (1) we need shared libs now, otherwise the binary too big (~24MB). please recompile from cabal (see README) (2) as C doesn't allow '/', '(' and ')' as identifier names (unlike forth <3), we replace them with '_', in order to identify a (unique) native function. the pattern is as follows: class__methodname__methodsignature (3) `loadNativeFunction' is quite hackisch now. I don't know if we get troubles with it at some point. we should consider: (3a) ask on stackoverflow (3b) patch this wtf stuff in ghc (3c) just determine addresses at compile-time. (3c) sucks, because you have to write much glue-code for every native method. but maybe we could solve it with some magic TH stuff (as suggested by hs_) --- diff --git a/Makefile b/Makefile index bf68386..f3a53a4 100644 --- a/Makefile +++ b/Makefile @@ -8,7 +8,7 @@ O_FILES = $(shell ls Mate/*.o) $(wildcard ffi/*.o) PACKAGES_ := bytestring harpy hs-java PACKAGES := $(addprefix -package ,$(PACKAGES_)) -GHC_OPT := -Wall -O0 -fno-warn-unused-do-bind +GHC_OPT := -dynamic -Wall -O0 -fno-warn-unused-do-bind GHC_LD := -optl-Xlinker -optl-x @@ -27,11 +27,15 @@ test: mate $(CLASS_FILES) ./$< tests/DifferentClass1.class | grep mainresult @printf "should be: 0x%08x\n" 8 @printf "should be: 0x%08x\n" 13 + ./$< tests/Native1.class | egrep -i -e '^printsomething: ' %.class: %.java $(JAVAC) $< -mate: Mate.hs ffi/trap.c $(HS_FILES) +ffi/native.o: ffi/native.c + ghc -Wall -O2 -c $< -o $@ + +mate: Mate.hs ffi/trap.c $(HS_FILES) ffi/native.o ghc --make $(GHC_OPT) Mate.hs ffi/trap.c -o $@ $(GHC_LD) clean: diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index 1a9d360..48afcde 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -3,15 +3,20 @@ module Mate.MethodPool where import Data.Binary +import Data.String.Utils import qualified Data.Map as M +import qualified Data.Set as S import qualified Data.ByteString.Lazy as B +import System.Plugins import Text.Printf import Foreign.Ptr import Foreign.C.Types +import Foreign.C.String import Foreign.StablePtr +import JVM.ClassFile import JVM.Converter import Harpy @@ -20,6 +25,7 @@ import Harpy.X86Disassembler import Mate.BasicBlocks import Mate.Types import Mate.X86CodeGen +import Mate.Utilities foreign import ccall "get_mmap" @@ -28,6 +34,10 @@ foreign import ccall "get_mmap" foreign import ccall "set_mmap" set_mmap :: Ptr () -> IO () +foreign import ccall "dynamic" + code_void :: FunPtr (IO ()) -> (IO ()) + + foreign export ccall getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt getMethodEntry signal_from ptr_mmap ptr_cmap = do @@ -35,21 +45,50 @@ getMethodEntry signal_from ptr_mmap ptr_cmap = do cmap <- ptr2cmap ptr_cmap let w32_from = fromIntegral signal_from - let mi@(MethodInfo method cm _) = cmap M.! w32_from + let mi@(MethodInfo method cm sig) = cmap M.! w32_from -- TODO(bernhard): replace parsing with some kind of classpool cls <- parseClassFile $ toString $ cm `B.append` ".class" case M.lookup mi mmap of Nothing -> do printf "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi) - hmap <- parseMethod cls method - printMapBB hmap - case hmap of - Just hmap' -> do - entry <- compileBB hmap' mi - return $ fromIntegral $ ((fromIntegral $ ptrToIntPtr entry) :: Word32) + let mm = lookupMethod method cls + case mm of + Just mm' -> do + let flags = methodAccessFlags mm' + case S.member ACC_NATIVE flags of + False -> do + hmap <- parseMethod cls method + printMapBB hmap + case hmap of + Just hmap' -> do + entry <- compileBB hmap' mi + return $ fromIntegral $ ((fromIntegral $ ptrToIntPtr entry) :: Word32) + Nothing -> error $ (show method) ++ " not found. abort" + True -> do + let symbol = (replace "/" "_" $ toString cm) ++ "__" ++ (toString method) ++ "__" ++ (replace "(" "_" (replace ")" "_" $ toString $ encode sig)) + printf "native-call: symbol: %s\n" symbol + nf <- loadNativeFunction symbol + let w32_nf = fromIntegral nf + let mmap' = M.insert mi w32_nf mmap + mmap2ptr mmap' >>= set_mmap + return nf Nothing -> error $ (show method) ++ " not found. abort" Just w32 -> return (fromIntegral w32) +-- TODO(bernhard): UBERHAX. ghc patch? +foreign import ccall safe "lookupSymbol" + c_lookupSymbol :: CString -> IO (Ptr a) + +loadNativeFunction :: String -> IO (CUInt) +loadNativeFunction sym = do + _ <- loadRawObject "ffi/native.o" + -- TODO(bernhard): WTF + resolveObjs (return ()) + ptr <- withCString sym c_lookupSymbol + if (ptr == nullPtr) + then error $ "dyn. loading of \"" ++ sym ++ "\" failed." + else return $ fromIntegral $ minusPtr ptr nullPtr + -- t_01 :: IO () -- t_01 = do -- (entry, _) <- testCase "./tests/Fib.class" "fib" @@ -91,9 +130,6 @@ compileBB hmap methodinfo = do return entry -foreign import ccall "dynamic" - code_void :: FunPtr (IO ()) -> (IO ()) - executeFuncPtr :: Ptr Word8 -> IO () executeFuncPtr entry = code_void $ ((castPtrToFunPtr entry) :: FunPtr (IO ())) diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index 21d2b3c..2355acd 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -239,7 +239,7 @@ emitFromBB cls hmap = do mov esp ebp pop ebp ret - emit _ = do cmovbe eax eax -- dummy + emit invalid = error $ "insn not implemented yet: " ++ (show invalid) cArgs x = (8 + 4 * (fromIntegral x)) cArgs_ x = (8 + 4 * case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3) diff --git a/README b/README index 6de21a1..67ebed3 100644 --- a/README +++ b/README @@ -1,11 +1,13 @@ == DEPENDENCIES == === HARPY === - $ cabal install harpy + $ cabal install harpy --enable-shared if this fails (e.g. you use ghc >= 7.0) then try our patched version: $ git clone git://wien.tomnetworks.com/harpy.git $ cd harpy - $ cabal configure; cabal build; cabal install + $ cabal configure --enable-shared + $ cabal build + $ cabal install --enable-shared === HS-JAVA === @@ -13,10 +15,17 @@ for `hs-java' a patched build is needed: $ git clone git://wien.tomnetworks.com/hs-java.git $ cd hs-java $ git checkout -t origin/v0.2 - $ cabal configure; cabal build; cabal install + $ cabal configure --enable-shared + $ cabal build + $ cabal install --enable-shared hint: for some unknown reason yet, it seems building from source will be easier if you first install `hs-java' via cabal (like `harpy' above) +=== MISC === + $ cabal install missingh --enable-shared + $ cabal install heap --enable-shared + $ cabal install plugins --enable-shared + == NOTE == unfortunately, many haskell libaries arn't tested very well, so building diff --git a/ffi/native.c b/ffi/native.c new file mode 100644 index 0000000..d743d57 --- /dev/null +++ b/ffi/native.c @@ -0,0 +1,11 @@ +#include + +void tests_Native1__printSomething____V(void) +{ + printf("printSomething: woot \\o/\n"); +} + +void tests_Native1__printSomething___I_V(int a) +{ + printf("printSomething: 0x%08x\n", a); +} diff --git a/tests/Native1.java b/tests/Native1.java new file mode 100644 index 0000000..3226aec --- /dev/null +++ b/tests/Native1.java @@ -0,0 +1,19 @@ +package tests; + +public class Native1 { + public static void main(String []args) { + printSomething(); + for (int i = 0; i < 10; i++) + printNumber(0x1337 + i); + printSomething(); + printSomething(); + printNumber(0x15a5); + } + + public static void printNumber(int a) { + printSomething(a); + } + + public static native void printSomething(); + public static native void printSomething(int a); +}