all: mate $(CLASS_FILES)
test: mate $(CLASS_FILES)
- ./$<
+ ./$< tests/Fib.class
%.class: %.java
$(JAVAC) $<
{-# LANGUAGE OverloadedStrings #-}
module Main where
+import System.Environment
+
import Text.Printf
+import JVM.Converter
+import JVM.Dump
+
+import Mate.BasicBlocks
import Mate.X86CodeGen
import Mate.MethodPool
main :: IO ()
main = do
- printf "fib Codegen:\n"
- test_01
- printf "\n\n\n\nData.Map & FFI:\n"
- t_01
+ args <- getArgs
+ register_signal
+ initMethodPool
+ case args of
+ [clspath] -> do
+ cls <- parseClassFile clspath
+ dumpClass cls
+ hmap <- parseMethod cls "main"
+ printMapBB hmap
+ case hmap of
+ Just hmap' -> do
+ entry <- compileBB hmap' "main"
+ printf "executing `main' now:\n"
+ executeFuncPtr entry
+ Nothing -> error "main not found"
+ _ -> error "Usage: mate <class-file>"
testInstance :: String -> B.ByteString -> IO ()
testInstance cf method = do
- hmap <- parseMethod cf method
+ cls <- parseClassFile cf
+ hmap <- parseMethod cls method
printMapBB hmap
test_main :: IO ()
test_03 = testInstance "./tests/While.class" "g"
-parseMethod :: String -> B.ByteString -> IO (Maybe MapBB)
-parseMethod clspath method = do
- cls <- parseClassFile clspath
+parseMethod :: Class Resolved -> B.ByteString -> IO (Maybe MapBB)
+parseMethod cls method = do
+ -- TODO(bernhard): remove me! just playing around with
+ -- hs-java interface.
+ -- we get that index at the INVOKESTATIC insn
+ putStrLn "via constpool @2:"
+ let cp = constsPool cls
+ let (CMethod rc nt) = cp M.! (2 :: Word16)
+ -- rc :: Link stage B.ByteString
+ -- nt :: Link stage (NameType Method)
+ B.putStrLn $ "rc: " `B.append` rc
+ B.putStrLn $ "nt: " `B.append` (encode $ ntSignature nt)
+
+ putStrLn "via methods:"
+ let msig = methodSignature $ (classMethods cls) !! 1
+ B.putStrLn (method `B.append` ": " `B.append` (encode msig))
+
return $ testCFG $ lookupMethod method cls
IF_ICMP _ w16 -> twotargets w16
GOTO w16 -> onetarget w16
IRETURN -> notarget
+ RETURN -> notarget
_ -> ((off, Nothing), x):next
where
notarget = ((off, Just Return), x):next
module Mate.MethodPool where
import Data.Binary
+import Data.String
import qualified Data.Map as M
-
+import qualified Data.ByteString.Lazy as B
import Text.Printf
import Foreign.C.String
import Foreign.StablePtr
+import JVM.Converter
+
+import Harpy
+import Harpy.X86Disassembler
+
+import Mate.BasicBlocks
import Mate.X86CodeGen
foreign import ccall "set_mmap"
set_mmap :: Ptr () -> IO ()
-foreign import ccall "demo_mmap"
- demo_mmap :: IO ()
+-- B.ByteString = name of method
+-- Word32 = entrypoint of method
+type MMap = M.Map B.ByteString Word32
-type MMap = M.Map String Word32
+-- TODO(bernhard): not in use yet
+-- Word32 = point of method call
+-- B.ByteString = name of called method
+type CMap = M.Map Word32 B.ByteString
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
+ mmap <- ptr2mmap ptr_mmap
+ str' <- peekCString cstr
+ let method = fromString str'
+ case M.lookup method mmap of
+ Nothing -> do
+ printf "getMethodEntry: no method found. compile it\n"
+ -- TODO(bernhard): hardcoded... fixme!
+ cls <- parseClassFile "tests/Fib.class"
+ hmap <- parseMethod cls method
+ case hmap of
+ Just hmap' -> do
+ entry <- compileBB hmap' method
+ let w32_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
+ let mmap' = M.insert method w32_entry mmap
+ mmap2ptr mmap' >>= set_mmap
+ return $ fromIntegral w32_entry
+ Nothing -> error $ (show method) ++ " not found. abort"
Just w32 -> return (fromIntegral w32)
-t_01 :: IO ()
-t_01 = do
- (entry, _) <- 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
+-- t_01 :: IO ()
+-- t_01 = do
+-- (entry, _) <- 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
+-- mmap2ptr mmap >>= set_mmap
+-- demo_mmap -- access Data.Map from C
+
+initMethodPool :: IO ()
+initMethodPool = mmap2ptr M.empty >>= set_mmap
+
+compileBB :: MapBB -> B.ByteString -> IO (Ptr Word8)
+compileBB hmap name = do
+ mmap <- get_mmap >>= ptr2mmap
+ let ebb = emitFromBB hmap
+ (_, Right ((entry, bbstarts, end), disasm)) <- runCodeGen ebb () ()
+ let w32_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
+ let mmap' = M.insert name w32_entry mmap
+ mmap2ptr mmap' >>= set_mmap
+ printf "disasm:\n"
+ mapM_ (putStrLn . showAtt) disasm
+ return entry
+
+foreign import ccall "dynamic"
+ code_void :: FunPtr (IO ()) -> (IO ())
+
+executeFuncPtr :: Ptr Word8 -> IO ()
+executeFuncPtr entry = code_void $ ((castPtrToFunPtr entry) :: FunPtr (IO ()))
+
+mmap2ptr :: MMap -> IO (Ptr ())
+mmap2ptr mmap = do
ptr_mmap <- newStablePtr mmap
- set_mmap $ castStablePtrToPtr ptr_mmap
- demo_mmap -- access Data.Map from C
+ return $ castStablePtrToPtr ptr_mmap
+
+ptr2mmap :: Ptr () -> IO MMap
+ptr2mmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr MMap)
import qualified JVM.Assembler as J
import JVM.Assembler hiding (Instruction)
+import JVM.Converter
import Harpy
import Harpy.X86Disassembler
testCase :: String -> B.ByteString -> IO (Ptr Word8, Int)
testCase cf method = do
- hmap <- parseMethod cf method
+ cls <- parseClassFile cf
+ hmap <- parseMethod cls method
printMapBB hmap
case hmap of
Nothing -> error "sorry, no code generation"
push ebp
mov ebp esp
- -- TODO(bernhard): remove me. just for PoC here
- let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
- push w32_ep
- -- '5' is the size of the `call' instruction ( + immediate)
- calladdr <- getCodeOffset
- let w32_calladdr = 5 + w32_ep + (fromIntegral calladdr) :: Word32
- let trapaddr = (fromIntegral getaddr :: Word32)
- call (trapaddr - w32_calladdr)
-
bbstarts <- efBB (0,(hmap M.! 0)) M.empty lmap
d <- disassemble
end <- getCodeOffset
-- instructions, so we can use patterns for optimizations
where
emit :: J.Instruction -> CodeGen e s ()
+ emit POP = do -- print dropped value
+ ep <- getEntryPoint
+ let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
+ -- '5' is the size of the `call' instruction ( + immediate)
+ calladdr <- getCodeOffset
+ let w32_calladdr = 5 + w32_ep + (fromIntegral calladdr) :: Word32
+ let trapaddr = (fromIntegral getaddr :: Word32)
+ call (trapaddr - w32_calladdr)
+ emit (BIPUSH val) = push ((fromIntegral val) :: Word32)
emit (ICONST_1) = push (1 :: Word32)
emit (ICONST_2) = push (2 :: Word32)
+ emit (ICONST_5) = push (5 :: Word32)
emit (ILOAD_ x) = do
push (Disp (cArgs_ x), ebp)
emit (ISTORE_ x) = do
-- push result on stack (TODO(bernhard): if any)
push eax
+ emit RETURN = do mov esp ebp; pop ebp; ret
emit IRETURN = do
pop eax
mov esp ebp
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)
+void mainresult(unsigned int a)
{
- // printf("\n\nprint foo: 0x%08x\n", addr);
- patchme = addr;
+ printf("mainresult: 0x%08x\n", a);
}
void callertrap(int nSignal, siginfo_t *info, void *ctx)
{
struct ucontext *uctx = (struct ucontext *) ctx;
+ unsigned int patchme = getMethodEntry(method_map, "fib");
printf("callertrap(mctx) by 0x%08x\n", (unsigned int) uctx->uc_mcontext.eip);
// printf("callertrap(addr) by 0x%08x\n", info->si_addr);
unsigned int getaddr(void)
{
- return (unsigned int) print_foo;
+ return (unsigned int) mainresult;
}
-public class Fib
-{
- public static int fib(int n)
- {
+public class Fib {
+ public static int fib(int n) {
if(n<=1) return 1;
else return fib(n-1) + fib(n-2);
}
- public static void main(String[] args)
- {
- for (int i = 0; i < 10; i++)
- System.out.println(i + ": " + fib(i));
+ public static void main(String[] args) {
+ fib(40);
}
}
projects / mate.git / commitdiff