From 55dbc4836a164757f92c97f98623cb203ffbed4e Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Sat, 19 May 2012 23:42:49 +0200 Subject: [PATCH] ClassPool: JAR and ClassPath support thanks hs-java awesomeness, although the implemented Java.ClassPath Modell doesn't really fit nicely in our current implementation :/ so it's a bit hackish... --- .gitignore | 1 + Mate.hs | 45 ++++++++++++++++++++++----------- Mate/ClassPool.hs | 64 +++++++++++++++++++++++++++++++++++++++-------- 3 files changed, 86 insertions(+), 24 deletions(-) diff --git a/.gitignore b/.gitignore index 6c7e29e..c5f7ddd 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,4 @@ tags *.hi-boot *.o-boot dist +*.jar diff --git a/Mate.hs b/Mate.hs index 911c1db..95daaf8 100644 --- a/Mate.hs +++ b/Mate.hs @@ -6,12 +6,14 @@ module Main where import System.Environment import Data.Char import Data.List +import Data.String.Utils import qualified Data.ByteString.Lazy as B #ifdef DEBUG import Text.Printf #endif import JVM.ClassFile +import Java.JAR import Mate.BasicBlocks import Mate.MethodPool @@ -23,24 +25,39 @@ main :: IO () main = do args <- getArgs register_signal + addClassPath "./" case args of [clspath] -> do let bclspath = B.pack $ map (fromIntegral . ord) clspath cls <- getClassFile bclspath - hmap <- parseMethod cls "main" - case hmap of - Just hmap' -> do - let methods = classMethods cls; methods :: [Method Direct] - let method = find (\x -> methodName x == "main") methods - case method of - Just m -> do - let mi = MethodInfo "main" bclspath $ methodSignature m - entry <- compileBB hmap' mi - addMethodRef entry mi [bclspath] + executeMain bclspath cls + ["-jar", jarpath] -> do + addClassPathJAR jarpath + res <- readMainClass jarpath + case res of + Nothing -> error "JAR: no MainClass entry found. Try to pass the jar file via -cp instead." + Just mc -> do + let mc' = replace "." "/" mc + let bclspath = B.pack $ map (fromIntegral . ord) mc' + cls <- getClassFile bclspath + executeMain bclspath cls + _ -> error "Usage: mate [ | -jar ]" + +executeMain :: B.ByteString -> Class Direct -> IO () +executeMain bclspath cls = do + hmap <- parseMethod cls "main" + case hmap of + Just hmap' -> do + let methods = classMethods cls; methods :: [Method Direct] + let method = find (\x -> methodName x == "main") methods + case method of + Just m -> do + let mi = MethodInfo "main" bclspath $ methodSignature m + entry <- compileBB hmap' mi + addMethodRef entry mi [bclspath] #ifdef DEBUG - printf "executing `main' now:\n" + printf "executing `main' now:\n" #endif - executeFuncPtr entry - Nothing -> error "main not found" + executeFuncPtr entry Nothing -> error "main not found" - _ -> error "Usage: mate " + Nothing -> error "main not found" diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs index f9f1038..0844ea5 100644 --- a/Mate/ClassPool.hs +++ b/Mate/ClassPool.hs @@ -10,7 +10,9 @@ module Mate.ClassPool ( getMethodOffset, getFieldOffset, getStaticFieldAddr, - getInterfaceMethodOffset + getInterfaceMethodOffset, + addClassPath, + addClassPathJAR ) where import Data.Int @@ -32,8 +34,14 @@ import Foreign.Ptr import Foreign.C.Types import Foreign.Storable +import Data.IORef +import System.IO.Unsafe +import System.Directory + import JVM.ClassFile import JVM.Converter +import Java.ClassPath hiding (Directory) +import Java.JAR import Mate.BasicBlocks import {-# SOURCE #-} Mate.MethodPool @@ -103,10 +111,9 @@ getInterfaceMethodOffset ifname meth sig = do Nothing -> error "getInterfaceMethodOffset: no offset set" -loadClass :: B.ByteString -> IO ClassInfo -loadClass path = do - let rpath = toString $ path `B.append` ".class" - cfile <- parseClassFile rpath +readClass :: B.ByteString -> IO ClassInfo +readClass path = do + cfile <- readClassFile $ toString path #ifdef DBG_CLASS dumpClass cfile #endif @@ -114,7 +121,7 @@ loadClass path = do sequence_ [ loadInterface i | i <- interfaces cfile ] superclass <- if path /= "java/lang/Object" then do - sc <- loadClass $ superClass cfile + sc <- readClass $ superClass cfile return $ Just sc else return Nothing @@ -153,8 +160,7 @@ loadInterface path = do Just _ -> return () Nothing -> do printfCp "interface: loading \"%s\"\n" $ toString path - let ifpath = toString $ path `B.append` ".class" - cfile <- parseClassFile ifpath + cfile <- readClassFile $ toString path -- load "superinterfaces" first sequence_ [ loadInterface i | i <- interfaces cfile ] immap <- getInterfaceMethodMap @@ -233,7 +239,7 @@ loadAndInitClass :: B.ByteString -> IO ClassInfo loadAndInitClass path = do class_map <- getClassMap ci <- case M.lookup path class_map of - Nothing -> loadClass path + Nothing -> readClass path Just x -> return x -- first try to execute class initializer of superclass @@ -251,10 +257,48 @@ loadAndInitClass path = do printfCp "executing static initializer from %s now\n" (toString path) executeFuncPtr entry printfCp "static initializer from %s done\n" (toString path) - Nothing -> error "loadClass: static initializer not found (WTF?). abort" + Nothing -> error "readClass: static initializer not found (WTF?). abort" Nothing -> return () class_map' <- getClassMap let new_ci = ci { ciInitDone = True } setClassMap $ M.insert path new_ci class_map' return new_ci + + +readClassFile :: String -> IO (Class Direct) +readClassFile path = readIORef classPaths >>= rcf + where + rcf :: [MClassPath] -> IO (Class Direct) + rcf [] = error $ "readClassFile: Class \"" ++ (show path) ++ "\" not found." + rcf ((Directory pre):xs) = do + let cf = pre ++ path ++ ".class" + b <- doesFileExist cf + if b + then parseClassFile cf + else rcf xs + rcf ((JAR p):xs) = do + entry <- getEntry p path + case entry of + Just (LoadedJAR _ cls) -> return cls + Nothing -> rcf xs + _ -> error $ "readClassFile: Class \"" ++ show path ++ "\" in JAR not found. #1" + +data MClassPath = + Directory String | + JAR [Tree CPEntry] + +classPaths :: IORef [MClassPath] +{-# NOINLINE classPaths #-} +classPaths = unsafePerformIO $ newIORef [] + +addClassPath :: String -> IO () +addClassPath x = do + cps <- readIORef classPaths + writeIORef classPaths (Directory x:cps) + +addClassPathJAR :: String -> IO () +addClassPathJAR x = do + cps <- readIORef classPaths + t <- execClassPath $ addJAR x + writeIORef classPaths (JAR t:cps) -- 2.25.1