first step, not really done cleanly at the moment.
TODO: introduce a classpool, where the
(1) static initializer is executed upon first loading
(2) reference to `Class Resolved' is saved somewhere
./$< tests/ArgumentPassing1.class | grep mainresult
@printf "should be: 0x%08x\n" 0x92
@printf "should be: 0x%08x\n" $$(((0 - 0x1337) & 0xffffffff))
+ ./$< tests/DifferentClass1.class | grep mainresult
+ @printf "should be: 0x%08x\n" 8
+ @printf "should be: 0x%08x\n" 13
%.class: %.java
$(JAVAC) $<
module Main where
import System.Environment
+import Data.Char
+import Data.String.Utils
+import Data.List
+import qualified Data.ByteString.Lazy as B
import Text.Printf
+import JVM.ClassFile
import JVM.Converter
import JVM.Dump
import Mate.BasicBlocks
import Mate.X86CodeGen
import Mate.MethodPool
+import Mate.Utilities
main :: IO ()
main = do
printMapBB hmap
case hmap of
Just hmap' -> do
- entry <- compileBB hmap' cls "main"
- printf "executing `main' now:\n"
- executeFuncPtr entry
+ let methods = classMethods cls; methods :: [Method Resolved]
+ let idx = findIndex (\x -> (methodName x) == "main") methods
+ case idx of
+ Just idx' -> do
+ let (Just m) = find (\x -> (methodName x) == "main") methods
+ let bclspath = B.pack $ map (fromIntegral . ord) (replace ".class" "" clspath)
+ entry <- compileBB hmap' (MethodInfo "main" bclspath (methodSignature m) (fromIntegral idx'))
+ printf "executing `main' now:\n"
+ executeFuncPtr entry
+ Nothing -> error "main not found"
Nothing -> error "main not found"
_ -> error "Usage: mate <class-file>"
import Foreign.StablePtr
import JVM.ClassFile
+import JVM.Converter
import Harpy
import Harpy.X86Disassembler
import Mate.BasicBlocks
import Mate.X86CodeGen
+import Mate.Utilities
foreign import ccall "get_mmap"
-- B.ByteString = name of method
-- Word32 = entrypoint of method
-type MMap = M.Map B.ByteString Word32
+type MMap = M.Map MethodInfo Word32
foreign export ccall getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt
getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt
cmap <- ptr2cmap ptr_cmap
let w32_from = fromIntegral signal_from
- let (method, cls, cpidx) = cmap M.! w32_from
- case M.lookup method mmap of
+ let mi@(MethodInfo method cm sig cpidx) = 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 method)
+ printf "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi)
-- TODO(bernhard): maybe we have to load the class first?
-- (Or better in X86CodeGen?)
let (CMethod _ nt) = (constsPool cls) M.! cpidx
printMapBB hmap
case hmap of
Just hmap' -> do
- entry <- compileBB hmap' cls method
+ entry <- compileBB hmap' mi
return $ fromIntegral $ ((fromIntegral $ ptrToIntPtr entry) :: Word32)
Nothing -> error $ (show method) ++ " not found. abort"
Just w32 -> return (fromIntegral w32)
mmap2ptr M.empty >>= set_mmap
cmap2ptr M.empty >>= set_cmap
-compileBB :: MapBB -> Class Resolved -> B.ByteString -> IO (Ptr Word8)
-compileBB hmap cls name = do
+compileBB :: MapBB -> MethodInfo -> IO (Ptr Word8)
+compileBB hmap methodinfo = do
mmap <- get_mmap >>= ptr2mmap
cmap <- get_cmap >>= ptr2cmap
+ -- TODO(bernhard): replace parsing with some kind of classpool
+ cls <- parseClassFile $ toString $ (classname methodinfo) `B.append` ".class"
let ebb = emitFromBB cls hmap
(_, Right ((entry, _, _, new_cmap), disasm)) <- runCodeGen ebb () ()
let w32_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32)
- let mmap' = M.insert name w32_entry mmap
+ let mmap' = M.insert methodinfo w32_entry mmap
let cmap' = M.union cmap new_cmap -- prefers elements in cmap
mmap2ptr mmap' >>= set_mmap
cmap2ptr cmap' >>= set_cmap
import Data.Char
import Data.Word
-import Data.Binary
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as B
-- import qualified Data.ByteString.Lazy.Char8 as B8
import JVM.ClassFile
+import Debug.Trace
+
+
+data MethodInfo = MethodInfo {
+ methodname :: B.ByteString,
+ classname :: B.ByteString,
+ signature :: MethodSignature,
+ index :: Word16 }
+
+instance Eq MethodInfo where
+ (MethodInfo m_a c_a s_a i_a) == (MethodInfo m_b c_b s_b i_b) =
+ (m_a == m_b) && (c_a == c_b) && (s_a == s_b) && (i_a == i_b)
+
+-- TODO(bernhard): not really efficient. also, outsource that to hs-java
+instance Ord MethodSignature where
+ compare (MethodSignature args_a ret_a) (MethodSignature args_b ret_b)
+ | cmp_args /= EQ = cmp_args
+ | otherwise = (show ret_a) `compare` (show ret_b)
+ where
+ cmp_args = (show args_a) `compare` (show args_b)
+
+instance Ord MethodInfo where
+ compare (MethodInfo m_a c_a s_a i_a) (MethodInfo m_b c_b s_b i_b)
+ | cmp_m /= EQ = cmp_m
+ | cmp_c /= EQ = cmp_c
+ | cmp_s /= EQ = cmp_s
+ | otherwise = i_a `compare` i_b
+ where
+ cmp_m = m_a `compare` m_b
+ cmp_c = c_a `compare` c_b
+ cmp_s = s_a `compare` s_b
+
+instance Show MethodInfo where
+ show (MethodInfo method c sig idx) =
+ (toString c) ++ "." ++ (toString method) ++ "." ++ (show sig) ++ "@" ++ (show idx)
+
-- TODO: actually this function already exists in hs-java-0.3!
lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
toString :: B.ByteString -> String
toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
-buildMethodID :: Class Resolved -> Word16 -> B.ByteString
-buildMethodID cls idx = (rc `B.append` dot) `B.append` (ntName nt) `B.append` nt'
+buildMethodID :: Class Resolved -> Word16 -> MethodInfo
+buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt) idx
where
(CMethod rc nt) = (constsPool cls) M.! idx
- nt' = encode $ ntSignature nt
- dot :: B.ByteString
- -- TODO(bernhard): WTF? why -XOverloadedStrings doesn't apply here?
- dot = B.pack $ map (fromIntegral . ord) "."
methodGetArgsCount :: Class Resolved -> Word16 -> Word32
methodGetArgsCount cls idx = fromIntegral $ length args
type CompileInfo = (EntryPoint, BBStarts, Int, CMap)
--- B.ByteString: encoded name: <Class>.<methodname><signature>
--- Class Resolved: classfile
--- Word16: index of invoke-instruction
-type MethodInfo = (B.ByteString, Class Resolved, Word16)
-
-- Word32 = point of method call in generated code
-- MethodInfo = relevant information about callee
type CMap = M.Map Word32 MethodInfo
let l = buildMethodID cls cpidx
calladdr <- getCodeOffset
let w32_calladdr = w32_ep + (fromIntegral calladdr) :: Word32
- newNamedLabel (toString l) >>= defineLabel
+ newNamedLabel (show l) >>= defineLabel
-- causes SIGILL. in the signal handler we patch it to the acutal call.
-- place a nop at the end, therefore the disasm doesn't screw up
emit32 (0xffff9090 :: Word32) >> emit8 (0x90 :: Word8)
when (argcnt > 0) (add esp argcnt)
-- push result on stack if method has a return value
when (methodHaveReturnValue cls cpidx) (push eax)
- return $ Just $ (w32_calladdr, (l, cls, cpidx))
+ return $ Just $ (w32_calladdr, l)
emit' insn = emit insn >> return Nothing
emit :: J.Instruction -> CodeGen e s ()
--- /dev/null
+package tests;
+
+public class DifferentClass1 {
+ public static void main(String[] args) {
+ Fib.fib(5);
+ Fib.fib(6);
+ }
+}
projects / mate.git / commitdiff