From: Bernhard Urban Date: Sun, 22 Apr 2012 18:42:50 +0000 (+0200) Subject: classloading: load classfile on demand X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=e9bbf51a0b41aee0b904936c4f1b69ca555d2648 classloading: load classfile on demand 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 --- diff --git a/Makefile b/Makefile index f3b274d..bf68386 100644 --- a/Makefile +++ b/Makefile @@ -24,6 +24,9 @@ test: mate $(CLASS_FILES) ./$< 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) $< diff --git a/Mate.hs b/Mate.hs index b787c26..1acc64d 100644 --- a/Mate.hs +++ b/Mate.hs @@ -2,15 +2,21 @@ 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 @@ -25,8 +31,15 @@ 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 " diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index e7a1aeb..2cd739e 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -13,12 +13,14 @@ import Foreign.C.Types 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" @@ -30,7 +32,7 @@ foreign import ccall "set_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 @@ -39,10 +41,12 @@ getMethodEntry signal_from ptr_mmap ptr_cmap = do 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 @@ -50,7 +54,7 @@ getMethodEntry signal_from ptr_mmap ptr_cmap = do 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) @@ -69,16 +73,18 @@ initMethodPool = do 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 diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs index 637d4d1..a73d60c 100644 --- a/Mate/Utilities.hs +++ b/Mate/Utilities.hs @@ -3,7 +3,6 @@ module Mate.Utilities where 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 @@ -11,6 +10,42 @@ import Codec.Binary.UTF8.String hiding (encode,decode) 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) @@ -24,14 +59,10 @@ lookupMethod name cls = look (classMethods cls) 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 diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index d2d62c2..d2c9caf 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -119,11 +119,6 @@ type BBStarts = M.Map BlockID Int type CompileInfo = (EntryPoint, BBStarts, Int, CMap) --- B.ByteString: encoded name: . --- 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 @@ -176,7 +171,7 @@ emitFromBB cls hmap = do 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) @@ -185,7 +180,7 @@ emitFromBB cls hmap = do 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 () diff --git a/tests/DifferentClass1.java b/tests/DifferentClass1.java new file mode 100644 index 0000000..ec397f1 --- /dev/null +++ b/tests/DifferentClass1.java @@ -0,0 +1,8 @@ +package tests; + +public class DifferentClass1 { + public static void main(String[] args) { + Fib.fib(5); + Fib.fib(6); + } +}