1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE TemplateHaskell, FlexibleInstances #-}
3 {-# LANGUAGE ForeignFunctionInterface #-}
8 import System.Environment hiding (getEnv)
9 import qualified Data.Map as M
10 import qualified Data.ByteString.Lazy as B
16 import qualified JVM.Assembler as J
17 import JVM.Assembler hiding (Instruction)
25 import Foreign.C.Types
28 import Harpy.X86Disassembler
31 foreign import ccall "dynamic"
32 code_void :: FunPtr (CInt -> IO CInt) -> (CInt -> IO CInt)
34 foreign import ccall "getaddr"
37 foreign import ccall "callertrap"
41 $(callDecl "callAsWord32" [t|Word32|])
47 clsFile <- decodeFile clspath
48 let cp = constsPool (clsFile :: Class Pointers)
49 putStrLn "==== constpool: ===="
50 putStrLn $ showListIx $ M.elems cp
51 cf <- parseClassFile clspath
52 putStrLn "==== classfile dump: ===="
54 putStrLn "==== random stuff: ===="
55 let mainmethod = lookupMethod "main" cf -- "main|([Ljava/lang/String;)V" cf
57 Nothing -> putStrLn "no main found"
59 case attrByName main "Code" of
60 Nothing -> putStrLn "no code attr found"
62 putStrLn "woot, running now"
63 allocaArray 26 (\ p -> mapM_ (\ i -> poke (advancePtr p i) 0) [0..25] >> runstuff p bytecode)
64 _ -> error "Synopsis: dump-class File.class"
66 runstuff :: Ptr Int32 -> B.ByteString -> IO ()
67 runstuff env bytecode = do
68 let emittedcode = (compile (fromIntegral getaddr)) $ codeInstructions $ decodeMethod bytecode
69 (_, Right ((entryPtr, endOffset), disasm)) <- runCodeGen emittedcode env ()
70 printf "entry point: 0x%08x\n" ((fromIntegral $ ptrToIntPtr entryPtr) :: Int)
72 let entryFuncPtr = ((castPtrToFunPtr entryPtr) :: FunPtr (CInt -> IO CInt))
73 result <- code_void entryFuncPtr (fromIntegral 0x1337)
74 let iresult::Int; iresult = fromIntegral result
75 printf "result: 0x%08x\n" iresult -- expecting (2 * 0x1337) + 0x42 = 0x26b0
77 result2 <- code_void entryFuncPtr (fromIntegral (-0x20))
78 let iresult2::Int; iresult2 = fromIntegral result2
79 printf "result: 0x%08x\n" iresult2 -- expecting 0x2
82 -- s/mov ebx 0x6666/mov eax 0x6666/
83 let patchit = plusPtr entryPtr 0xb
84 poke patchit (0xb8 :: Word8)
86 result3 <- code_void entryFuncPtr (fromIntegral 0)
87 let iresult3::Int; iresult3 = fromIntegral result3
88 printf "result: 0x%08x\n" iresult3 -- expecting 0x6666
91 mapM_ (putStrLn . showAtt) disasm
93 printf "patched disasm:\n"
94 Right newdisasm <- disassembleBlock entryPtr endOffset
95 mapM_ (putStrLn . showAtt) $ newdisasm
97 let addr :: Int; addr = (fromIntegral getaddr :: Int)
98 printf "getaddr: 0x%08x\n" addr
103 entryCode :: CodeGen e s ()
104 entryCode = do push ebp
107 exitCode :: CodeGen e s ()
108 exitCode = do mov esp ebp
112 compile :: Word32 -> [J.Instruction] -> CodeGen (Ptr Int32) s ((Ptr Word8, Int), [Instruction])
113 compile trapaddr insn = do
115 mapM compile_ins insn
117 mov ecx (trapaddr :: Word32)
119 -- call trapaddr -- Y U DON'T WORK? (ask mr. gdb for help)
127 compile_ins :: J.Instruction -> CodeGen (Ptr Int32) s ()
128 compile_ins (BIPUSH w8) = do mov eax ((fromIntegral w8) :: Word32)
129 compile_ins (PUTSTATIC w16) = do add eax (Disp 8, ebp) -- add first argument to %eax
130 compile_ins (GETSTATIC w16) = do nop
131 compile_ins ICONST_2 = do mov ebx (0x6666 :: Word32) -- patch me!
132 compile_ins IMUL = do nop
133 -- mov eax (0 :: Word32)
135 compile_ins RETURN = do nop
136 compile_ins _ = do nop
138 -- TODO: actually this function already exists in hs-java-0.3!
139 lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
140 lookupMethod name cls = look (classMethods cls)
144 | methodName f == name = Just f
145 | otherwise = look fs