*.o
*.class
mate
+mate.dbg
tags
*.swp
*_stub.c
ghc -Wall -O2 -c $< -o $@
mate: Mate.hs ffi/trap.c $(HS_FILES) $(HS_BOOT) ffi/native.o
- ghc --make $(GHC_OPT) Mate.hs ffi/trap.c -o $@ $(GHC_LD)
+ @mkdir -p build/release
+ ghc --make $(GHC_OPT) Mate.hs ffi/trap.c -o $@ $(GHC_LD) -outputdir build/release
+
+%.dbg: %.class mate.dbg
+ ./mate.dbg $(basename $<)
+
+mate.dbg: Mate.hs ffi/trap.c $(HS_FILES) $(HS_BOOT) ffi/native.o
+ @mkdir -p build/debug/{ffi,Mate,}
+ gcc -Wall -DDEBUG -O0 -c ffi/trap.c -o build/debug/ffi/trap.o
+ ghc --make -DDEBUG $(GHC_OPT) Mate.hs build/debug/ffi/trap.o -o $@ $(GHC_LD) -outputdir build/debug
clean:
- rm -f {Mate/,}*.hi {Mate/,ffi/,}*.o Mate/*.{hi,o}-boot mate tests/*.class
+ rm -rf build mate mate.dbg ffi/native.o tests/*.class
ghci: mate
ghci $(PACKAGES) $(O_FILES) Mate.hs $(GHC_LD)
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.List
import qualified Data.ByteString.Lazy as B
+#ifdef DEBUG
import Text.Printf
-import JVM.ClassFile
import JVM.Dump
+#endif
+import JVM.ClassFile
import Mate.BasicBlocks
import Mate.X86CodeGen
[clspath] -> do
let bclspath = B.pack $ map (fromIntegral . ord) clspath
cls <- getClassFile bclspath
+#ifdef DEBUG
dumpClass cls
+#endif
hmap <- parseMethod cls "main"
- printMapBB hmap
case hmap of
Just hmap' -> do
let methods = classMethods cls; methods :: [Method Resolved]
let mi = (MethodInfo "main" bclspath (methodSignature m))
entry <- compileBB hmap' mi
addMethodRef entry mi [bclspath]
+#ifdef DEBUG
printf "executing `main' now:\n"
+#endif
executeFuncPtr entry
Nothing -> error "main not found"
Nothing -> error "main not found"
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Mate.BasicBlocks(
BlockID,
BasicBlock (..),
BBEnd (..),
MapBB,
+#ifdef DEBUG
printMapBB,
- parseMethod,
test_main,
+#endif
+ parseMethod,
testCFG -- added by hs to perform benches from outside
)where
type OffIns = (Offset, Instruction)
+#ifdef DEBUG
printMapBB :: Maybe MapBB -> IO ()
printMapBB Nothing = putStrLn "No BasicBlock"
printMapBB (Just hmap) = do
TwoTarget t1 t2 -> putStrLn $ "Sucessor: " ++ (show t1) ++ ", " ++ (show t2) ++ "\n"
printMapBB' is hmap
Nothing -> error $ "BlockID " ++ show i ++ " not found."
+#endif
+#ifdef DEBUG
testInstance :: String -> B.ByteString -> IO ()
testInstance cf method = do
cls <- parseClassFile cf
hmap <- parseMethod cls method
printMapBB hmap
+#endif
+#ifdef DEBUG
test_main :: IO ()
test_main = do
test_01
test_02 = testInstance "./tests/While.class" "f"
test_03 = testInstance "./tests/While.class" "g"
test_04 = testInstance "./tests/Fac.class" "fac"
+#endif
parseMethod :: Class Resolved -> B.ByteString -> IO (Maybe MapBB)
parseMethod cls method = do
+ let maybe_bb = testCFG $ lookupMethod method cls
+#ifdef DEBUG
putStr "BB: analysing: "
let msig = methodSignature $ (classMethods cls) !! 1
putStrLn $ toString (method `B.append` ": " `B.append` (encode msig))
- return $ testCFG $ lookupMethod method cls
+ printMapBB maybe_bb
+#endif
+ return maybe_bb
testCFG :: Maybe (Method Resolved) -> Maybe MapBB
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Mate.ClassPool (
import qualified Data.ByteString.Lazy as B
import Control.Monad
+#ifdef DEBUG
import Text.Printf
+#endif
import Foreign.Ptr
import Foreign.C.Types
loadClass :: B.ByteString -> IO ClassInfo
loadClass path = do
+#ifdef DEBUG
printf "loadClass: \"%s\"\n" $ toString path
+#endif
let rpath = toString $ path `B.append` ".class"
cfile <- parseClassFile rpath
superclass <- case (path /= "java/lang/Object") of
False -> return $ Nothing
(staticmap, fieldmap) <- calculateFields cfile superclass
+ (methodmap, mbase) <- calculateMethodMap cfile superclass
+#ifdef DEBUG
printf "staticmap: %s @ %s\n" (show staticmap) (toString path)
printf "fieldmap: %s @ %s\n" (show fieldmap) (toString path)
- (methodmap, mbase) <- calculateMethodMap cfile superclass
printf "methodmap: %s @ %s\n" (show methodmap) (toString path)
printf "mbase: 0x%08x\n" mbase
+#endif
virtual_map <- get_virtualmap >>= ptr2virtualmap
let virtual_map' = M.insert mbase path virtual_map
case lookupMethod "<clinit>" (ciFile ci) of
Just m -> do
hmap <- parseMethod (ciFile ci) "<clinit>"
- printMapBB hmap
case hmap of
Just hmap' -> do
let mi = (MethodInfo "<clinit>" path (methodSignature m))
entry <- compileBB hmap' mi
addMethodRef entry mi [path]
+#ifdef DEBUG
printf "executing static initializer from %s now\n" (toString path)
+#endif
executeFuncPtr entry
+#ifdef DEBUG
printf "static initializer from %s done\n" (toString path)
+#endif
Nothing -> error $ "loadClass: static initializer not found (WTF?). abort"
Nothing -> return ()
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Mate.MethodPool where
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 JVM.ClassFile
import Harpy
+#ifdef DEBUG
import Harpy.X86Disassembler
+import Text.Printf
+#endif
+
import Mate.BasicBlocks
import Mate.Types
import Mate.X86CodeGen
case M.lookup mi' mmap of
Nothing -> do
cls <- getClassFile cm
+#ifdef DEBUG
printf "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi')
+#endif
mm <- lookupMethodRecursive method [] cls
case mm of
Just (mm', clsnames, cls') -> do
case S.member ACC_NATIVE flags of
False -> do
hmap <- parseMethod cls' method
- printMapBB hmap
case hmap of
Just hmap' -> do
entry <- compileBB hmap' (MethodInfo method (thisClass cls') sig)
True -> do
-- TODO(bernhard): cleaner please... *do'h*
let symbol = (replace "/" "_" $ toString cm) ++ "__" ++ (toString method) ++ "__" ++ (replace ";" "_" $ replace "/" "_" $ replace "(" "_" (replace ")" "_" $ toString $ encode sig))
+#ifdef DEBUG
printf "native-call: symbol: %s\n" symbol
+#endif
nf <- loadNativeFunction symbol
let w32_nf = fromIntegral nf
let mmap' = M.insert mi' w32_nf mmap
cls <- getClassFile (methClassName methodinfo)
let ebb = emitFromBB (methName methodinfo) cls hmap
- (_, Right ((entry, _, _, new_tmap), disasm)) <- runCodeGen ebb () ()
+ (_, Right right) <- runCodeGen ebb () ()
+ let ((entry, _, _, new_tmap), _) = right
let tmap' = M.union tmap new_tmap -- prefers elements in cmap
trapmap2ptr tmap' >>= set_trapmap
+#ifdef DEBUG
printf "disasm:\n"
- mapM_ (putStrLn . showAtt) disasm
+ mapM_ (putStrLn . showAtt) (snd right)
+#endif
-- UNCOMMENT NEXT LINE FOR GDB FUN
-- _ <- getLine
-- (1) start it with `gdb ./mate' and then `run <classfile>'
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Mate.Strings (
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Internal as BI
+#ifdef DEBUG
import Text.Printf
+#endif
import Foreign.Ptr
import Foreign.Marshal.Alloc
BI.memset newstr 0 (fromIntegral $ strlen + 1)
copyBytes newstr arr strlen
let w32_ptr = fromIntegral $ ptrToIntPtr newstr
+#ifdef DEBUG
printf "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen
+#endif
return w32_ptr
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Mate.Utilities where
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Mate.X86CodeGen where
import Foreign hiding (xor)
import Foreign.C.Types
+#ifdef DEFINE
import Text.Printf
+#endif
import qualified JVM.Assembler as J
import JVM.Assembler hiding (Instruction)
foreign import ccall "dynamic"
code_int :: FunPtr (CInt -> CInt -> IO CInt) -> (CInt -> CInt -> IO CInt)
-foreign import ccall "getaddr"
- getaddr :: CUInt
-
foreign import ccall "getMallocAddr"
getMallocAddr :: CUInt
foreign import ccall "register_signal"
register_signal :: IO ()
-test_01, test_02, test_03 :: IO ()
-test_01 = do
- register_signal
- (entry, end) <- testCase "./tests/Fib" "fib"
- let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
-
- mapM_ (\x -> do
- result <- code_int entryFuncPtr x 0
- let iresult :: Int; iresult = fromIntegral result
- let kk :: String; kk = if iresult == (fib x) then "OK" else "FAIL (" ++ (show (fib x)) ++ ")"
- printf "result of fib(%2d): %3d\t\t%s\n" (fromIntegral x :: Int) iresult kk
- ) $ ([0..10] :: [CInt])
- printf "patched disasm:\n"
- Right newdisasm <- disassembleBlock entry end
- mapM_ (putStrLn . showAtt) newdisasm
- where
- fib :: CInt -> Int
- fib n
- | n <= 1 = 1
- | otherwise = (fib (n - 1)) + (fib (n - 2))
-
-
-test_02 = do
- (entry,_) <- testCase "./tests/While" "f"
- let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
- result <- code_int entryFuncPtr 5 4
- let iresult :: Int; iresult = fromIntegral result
- let kk :: String; kk = if iresult == 15 then "OK" else "FAIL"
- printf "result of f(5,4): %3d\t\t%s\n" iresult kk
-
- result2 <- code_int entryFuncPtr 4 3
- let iresult2 :: Int; iresult2 = fromIntegral result2
- let kk2 :: String; kk2 = if iresult2 == 10 then "OK" else "FAIL"
- printf "result of f(4,3): %3d\t\t%s\n" iresult2 kk2
-
-
-test_03 = do
- (entry,_) <- testCase "./tests/While" "g"
- let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
- result <- code_int entryFuncPtr 5 4
- let iresult :: Int; iresult = fromIntegral result
- let kk :: String; kk = if iresult == 15 then "OK" else "FAIL"
- printf "result of g(5,4): %3d\t\t%s\n" iresult kk
-
- result2 <- code_int entryFuncPtr 4 3
- let iresult2 :: Int; iresult2 = fromIntegral result2
- let kk2 :: String; kk2 = if iresult2 == 10 then "OK" else "FAIL"
- printf "result of g(4,3): %3d\t\t%s\n" iresult2 kk2
-
-
-testCase :: B.ByteString -> B.ByteString -> IO (Ptr Word8, Int)
-testCase cf method = do
- cls <- getClassFile cf
- hmap <- parseMethod cls method
- printMapBB hmap
- case hmap of
- Nothing -> error "sorry, no code generation"
- Just hmap' -> do
- let ebb = emitFromBB method cls hmap'
- (_, Right ((entry, bbstarts, end, _), disasm)) <- runCodeGen ebb () ()
- let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Int)
- printf "disasm:\n"
- mapM_ (putStrLn . showAtt) disasm
- printf "basicblocks addresses:\n"
- let b = map (\(x,y) -> (x,y + int_entry)) $ M.toList bbstarts
- mapM_ (\(x,y) -> printf "\tBasicBlock %2d starts at 0x%08x\n" x y) b
- return (entry, end)
type EntryPoint = Ptr Word8
type EntryPointOffset = Int
unsigned int getMethodEntry(unsigned int, unsigned int);
unsigned int getStaticFieldAddr(unsigned int, void*);
+#ifdef DEBUG
+#define dprintf(args...) do { printf (args); } while (0);
+#else
+#define dprintf(args...)
+#endif
+
#define NEW_MAP(prefix) \
void* prefix ## _map = NULL; \
void set_ ## prefix ## map(void *map) \
{ \
- printf("set_%s: 0x%08x\n", #prefix , (unsigned int) map); \
+ dprintf("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); \
+ dprintf("get_%s: 0x%08x\n", #prefix , (unsigned int) prefix ## _map); \
return prefix ## _map; \
}
void mainresult(unsigned int a)
{
- printf("mainresult: 0x%08x\n", a);
+ dprintf("mainresult: 0x%08x\n", a);
}
void callertrap(int nSignal, siginfo_t *info, void *ctx)
mcontext_t *mctx = &((ucontext_t *) ctx)->uc_mcontext;
unsigned int from = (unsigned int) mctx->gregs[REG_EIP] - 2;
unsigned int *to_patch = (unsigned int *) (from + 1);
- printf("callertrap(mctx) by 0x%08x\n", from);
+ dprintf("callertrap(mctx) by 0x%08x\n", from);
if (*to_patch != 0x90ffff90) {
- printf("callertrap: something is wrong here. abort\n");
+ dprintf("callertrap: something is wrong here. abort\n");
exit(0);
}
unsigned int patchme = getMethodEntry(from, 0);
unsigned char *insn = (unsigned char *) from;
*insn = 0xe8; // call opcode
- printf(" to_patch: 0x%08x\n", (unsigned int) to_patch);
- printf("*to_patch: 0x%08x\n", *to_patch);
+ dprintf(" to_patch: 0x%08x\n", (unsigned int) to_patch);
+ dprintf("*to_patch: 0x%08x\n", *to_patch);
*to_patch = patchme - (from + 5);
- printf("*to_patch: 0x%08x\n", *to_patch);
+ dprintf("*to_patch: 0x%08x\n", *to_patch);
mctx->gregs[REG_EIP] = (unsigned long) insn;
}
unsigned int from = (unsigned int) mctx->gregs[REG_EIP];
if (from < 0x10000) { // invokevirtual
if (from > 0) {
- printf("from: 0x%08x but should be 0 :-(\n", from);
+ dprintf("from: 0x%08x but should be 0 :-(\n", from);
}
unsigned int method_table_ptr = (unsigned int) mctx->gregs[REG_EAX];
unsigned int *esp = (unsigned int *) mctx->gregs[REG_ESP];
unsigned char offset = *((unsigned char *) (*esp) - 1);
/* method entry to patch */
unsigned int *to_patch = (unsigned int*) (method_table_ptr + offset);
- printf("invokevirtual by 0x%08x with offset 0x%08x\n", from, offset);
- printf(" to_patch: 0x%08x\n", (unsigned int) to_patch);
- printf("*to_patch: 0x%08x\n", *to_patch);
+ dprintf("invokevirtual by 0x%08x with offset 0x%08x\n", from, offset);
+ dprintf(" to_patch: 0x%08x\n", (unsigned int) to_patch);
+ dprintf("*to_patch: 0x%08x\n", *to_patch);
*to_patch = getMethodEntry(from, method_table_ptr);
mctx->gregs[REG_EIP] = *to_patch;
- printf("*to_patch: 0x%08x\n", *to_patch);
+ dprintf("*to_patch: 0x%08x\n", *to_patch);
} else {
unsigned int *to_patch = (unsigned int *) (from + 2);
- printf("staticfieldtrap by 0x%08x\n", from);
+ dprintf("staticfieldtrap by 0x%08x\n", from);
if (*to_patch != 0x00000000) {
- printf("staticfieldtrap: something is wrong here. abort\n");
+ dprintf("staticfieldtrap: something is wrong here. abort\n");
exit(0);
}
unsigned int patchme = getStaticFieldAddr(from, trap_map);
- printf(" to_patch: 0x%08x\n", (unsigned int) to_patch);
- printf("*to_patch: 0x%08x\n", *to_patch);
+ dprintf(" to_patch: 0x%08x\n", (unsigned int) to_patch);
+ dprintf("*to_patch: 0x%08x\n", *to_patch);
*to_patch = patchme;
- printf("*to_patch: 0x%08x\n", *to_patch);
+ dprintf("*to_patch: 0x%08x\n", *to_patch);
}
}
diff_output=`mktemp`
-$openjdk $class2test | grep -e '^result:' > $openjdk_output
-$mate $class2test | grep -e '^result:' > $mate_output
+$openjdk $class2test > $openjdk_output
+$mate $class2test > $mate_output
diff $openjdk_output $mate_output > $diff_output
projects / mate.git / commitdiff