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...

diff --git a/.gitignore b/.gitignore
index 6c7e29ea6ea82b769159882cd3c60b1fc9eb1361..c5f7ddd0280912a7c6fb202b3ff964d23e9a9567 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -10,3 +10,4 @@ tags
 *.hi-boot
 *.o-boot
 dist
+*.jar

diff --git a/Mate.hs b/Mate.hs
index 911c1dbd1c1ef1b892a511c65835f3e3c73537e9..95daaf8133d890e2445ef353b05072d5aeb9288e 100644 (file)
--- 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 [<class-file> | -jar <jar-file>]"
+
+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 <class-file>"
+    Nothing -> error "main not found"

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index f9f103829bbb3117affd5d06c7a8ebb814c5b296..0844ea5efa3e96f7655517a20ac59ad4ead29241 100644 (file)
--- 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)