getMethodOffset,
getFieldOffset,
getStaticFieldAddr,
- getInterfaceMethodOffset
+ getInterfaceMethodOffset,
+ addClassPath,
+ addClassPathJAR
) where
import Data.Int
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
import Mate.Types
-import Mate.Utilities
import Mate.Debug
import Mate.GarbageAlloc
Nothing -> loadAndInitClass path
Just ci -> return ci
-getClassFile :: B.ByteString -> IO (Class Resolved)
+getClassFile :: B.ByteString -> IO (Class Direct)
getClassFile path = do
ci <- getClassInfo path
return $ ciFile ci
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
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
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
getname p y = p `B.append` methodName y `B.append` encode (methodSignature y)
-calculateFields :: Class Resolved -> Maybe ClassInfo -> IO (FieldMap, FieldMap)
+calculateFields :: Class Direct -> Maybe ClassInfo -> IO (FieldMap, FieldMap)
calculateFields cf superclass = do
-- TODO(bernhard): correct sizes. int only atm
getsupermap superclass getter = case superclass of Just x -> getter x; Nothing -> M.empty
-calculateMethodMap :: Class Resolved -> Maybe ClassInfo -> IO (FieldMap, Word32)
+calculateMethodMap :: Class Direct -> Maybe ClassInfo -> IO (FieldMap, Word32)
calculateMethodMap cf superclass = do
let methods = filter
(\x -> (not . S.member ACC_STATIC . methodAccessFlags) x &&
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
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)