BBEnd (..),
MapBB,
printMapBB,
- parseMethod
+ parseMethod,
+ test_main
)where
import Data.Binary
import Data.Int
-import qualified Data.Map as H
-import System.Environment
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as B
-import JVM.Common
import JVM.ClassFile
import JVM.Converter
-import JVM.Dump
import JVM.Assembler
-import Debug.Trace
-
import Mate.Utilities
-type Name = String -- use "virtual register id" instead?
-data Type = JInt | JFloat -- add more
-type Variable = (Type,Name)
type BlockID = Int
-- Represents a CFG node
-- describes (leaving) edges of a CFG node
data BBEnd = Return | OneTarget BlockID | TwoTarget BlockID BlockID deriving Show
-type MapBB = H.Map BlockID BasicBlock
+type MapBB = M.Map BlockID BasicBlock
-- for immediate representation for determine BBs
type Offset = (Int, Maybe BBEnd) -- (offset in bytecode, offset to jump target)
printMapBB Nothing = putStrLn "No BasicBlock"
printMapBB (Just hmap) = do
putStr "BlockIDs: "
- let keys = fst $ unzip $ H.toList hmap
+ let keys = fst $ unzip $ M.toList hmap
mapM_ (putStr . (flip (++)) ", " . show) keys
putStrLn "\n\nBasicBlocks:"
printMapBB' keys hmap
where
printMapBB' :: [BlockID] -> MapBB -> IO ()
printMapBB' [] _ = return ()
- printMapBB' (i:is) hmap = case H.lookup i hmap of
+ printMapBB' (i:is) hmap' = case M.lookup i hmap' of
Just bb -> do
putStrLn $ "Block " ++ (show i)
mapM_ putStrLn (map ((++) "\t" . show) $ code bb)
hmap <- parseMethod cf method
printMapBB hmap
+test_main :: IO ()
+test_main = do
+ test_01
+ test_02
+ test_03
+
+test_01, test_02, test_03 :: IO ()
test_01 = testInstance "./tests/Fib.class" "fib"
test_02 = testInstance "./tests/While.class" "f"
test_03 = testInstance "./tests/While.class" "g"
testCFG :: Maybe (Method Resolved) -> Maybe MapBB
testCFG (Just m) = case attrByName m "Code" of
- Nothing -> Nothing
- Just bytecode -> let code = decodeMethod bytecode
- instructions = codeInstructions code
- in Just $ buildCFG instructions
-testCFG _ = Nothing
+ Nothing -> Nothing
+ Just bytecode -> Just $ buildCFG $ codeInstructions $ decodeMethod bytecode
+testCFG _ = Nothing
buildCFG :: [Instruction] -> MapBB
-buildCFG xs = buildCFG' H.empty xs' xs'
+buildCFG xs = buildCFG' M.empty xs' xs'
where
xs' :: [OffIns]
xs' = calculateInstructionOffset xs
buildCFG' hmap (((off, entry), _):xs) insns = buildCFG' (insertlist entryi hmap) xs insns
where
insertlist :: [BlockID] -> MapBB -> MapBB
- insertlist [] hmap = hmap
- insertlist (x:xs) hmap = insertlist xs newhmap
+ insertlist [] hmap' = hmap'
+ insertlist (y:ys) hmap' = insertlist ys newhmap
where
- newhmap = if H.member x hmap then hmap else H.insert x value hmap
- value = parseBasicBlock x insns
+ newhmap = if M.member y hmap' then hmap' else M.insert y value hmap'
+ value = parseBasicBlock y insns
entryi :: [BlockID]
entryi = (if off == 0 then [0] else []) ++ -- also consider the entrypoint
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 Foreign.Ptr
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.StablePtr
import Mate.X86CodeGen
Nothing -> return 0
Just w32 -> return (fromIntegral w32)
+t_01 :: IO ()
t_01 = do
- (entry, end) <- testCase "./tests/Fib.class" "fib"
+ (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
import qualified Data.ByteString.Lazy as B
-import qualified JVM.Assembler as J
-import JVM.Assembler hiding (Instruction)
-import JVM.Common
import JVM.ClassFile
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.C.Types
import Text.Printf
(entry, end) <- testCase "./tests/Fib.class" "fib"
let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
- mapM_ (\(x,entryFuncPtr) -> do
- result <- code_int entryFuncPtr (fromIntegral x) (fromIntegral 0)
+ 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" x iresult kk
- ) $ zip ([0..10] :: [Int]) (repeat entryFuncPtr)
+ 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.class" "f"
let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
- result <- code_int entryFuncPtr (fromIntegral 5) (fromIntegral 4)
+ 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
- result <- code_int entryFuncPtr (fromIntegral 4) (fromIntegral 3)
- let iresult :: Int; iresult = fromIntegral result
- let kk :: String; kk = if iresult == 10 then "OK" else "FAIL"
- printf "result of f(4,3): %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.class" "g"
let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
- result <- code_int entryFuncPtr (fromIntegral 5) (fromIntegral 4)
+ 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
- result <- code_int entryFuncPtr (fromIntegral 4) (fromIntegral 3)
- let iresult :: Int; iresult = fromIntegral result
- let kk :: String; kk = if iresult == 10 then "OK" else "FAIL"
- printf "result of g(4,3): %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 :: String -> B.ByteString -> IO (Ptr Word8, Int)
printMapBB hmap
case hmap of
Nothing -> error "sorry, no code generation"
- Just hmap -> do
- let ebb = emitFromBB hmap
+ Just hmap' -> do
+ let ebb = emitFromBB hmap'
(_, Right ((entry, bbstarts, end), disasm)) <- runCodeGen ebb () ()
let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Int)
printf "disasm:\n"
mov ebp esp
-- TODO(bernhard): remove me. just for PoC here
- ep <- getEntryPoint
let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
push w32_ep
-- '5' is the size of the `call' instruction ( + immediate)
bb_offset <- getCodeOffset
let bbstarts' = M.insert bid bb_offset bbstarts
defineLabel $ getLabel bid lmap
- mapM emit $ code bb
+ mapM_ emit $ code bb
case successor bb of
Return -> return bbstarts'
OneTarget t -> do
pop eax -- value2
pop ebx -- value1
cmp ebx eax -- intel syntax is swapped (TODO(bernhard): test that plz)
- let sid = case successor bb of TwoTarget _ t -> t
+ let sid = case successor bb of TwoTarget _ t -> t; _ -> error "bad"
let l = getLabel sid lmap
case cond of
C_EQ -> je l; C_NE -> jne l
emit (IF cond _) = do
pop eax -- value1
cmp eax (0 :: Word32) -- TODO(bernhard): test that plz
- let sid = case successor bb of TwoTarget _ t -> t
+ let sid = case successor bb of TwoTarget _ t -> t; _ -> error "bad"
let l = getLabel sid lmap
case cond of
C_EQ -> je l; C_NE -> jne l
C_GE -> jge l; C_LE -> jle l
emit (GOTO _ ) = do
- let sid = case successor bb of OneTarget t -> t
+ let sid = case successor bb of OneTarget t -> t; _ -> error "bad"
jmp $ getLabel sid lmap
- emit (INVOKESTATIC x) = do
+ emit (INVOKESTATIC _) = do
-- TODO(bernhard): get and save information about this call
-- TODO(bernhard): better try SIGILL instead of SIGSEGV?
mov (Addr 0) eax
{
struct ucontext *uctx = (struct ucontext *) ctx;
- printf("callertrap(mctx) by 0x%08x\n", uctx->uc_mcontext.eip);
+ printf("callertrap(mctx) by 0x%08x\n", (unsigned int) uctx->uc_mcontext.eip);
// printf("callertrap(addr) by 0x%08x\n", info->si_addr);
// printf("callertrap(*esp) by 0x%08x\n", * (unsigned int *) uctx->uc_mcontext.esp);
unsigned int *to_patch = (unsigned int *) (uctx->uc_mcontext.eip + 2);
- unsigned char *insn = (unsigned int *) (uctx->uc_mcontext.eip);
+ unsigned char *insn = (unsigned char *) (uctx->uc_mcontext.eip);
*insn = 0x90; // nop
insn++;
*insn = 0xe8; // call
- printf(" to_patch: 0x%08x\n", to_patch);
+ printf(" to_patch: 0x%08x\n", (unsigned int) to_patch);
printf("*to_patch: 0x%08x\n", *to_patch);
if (*to_patch != 0x00000000) {
printf("something is wrong here. abort\n");
}
*to_patch = (unsigned int) patchme - ((unsigned int) insn + 5);
printf("*to_patch: 0x%08x\n", *to_patch);
- uctx->uc_mcontext.eip = insn;
+ uctx->uc_mcontext.eip = (unsigned long) insn;
// while (1) ;
}
projects / mate.git / commitdiff