X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate.hs;h=96edb9633155c58b5850e689e489134eb5eb9030;hb=08628062840ccf3730e239222c30e78b403dc6f4;hp=95daaf8133d890e2445ef353b05072d5aeb9288e;hpb=55dbc4836a164757f92c97f98623cb203ffbed4e;p=mate.git diff --git a/Mate.hs b/Mate.hs index 95daaf8..96edb96 100644 --- a/Mate.hs +++ b/Mate.hs @@ -6,8 +6,9 @@ module Main where import System.Environment import Data.Char import Data.List -import Data.String.Utils +import Data.List.Split import qualified Data.ByteString.Lazy as B +import Control.Monad #ifdef DEBUG import Text.Printf @@ -19,45 +20,60 @@ import Mate.BasicBlocks import Mate.MethodPool import Mate.Types import Mate.ClassPool -import Mate.X86TrapHandling +import Mate.NativeMachine + +import Mate.GC.Boehm main :: IO () main = do args <- getArgs register_signal - addClassPath "./" - case args of - [clspath] -> do - let bclspath = B.pack $ map (fromIntegral . ord) clspath + parseArgs args False + +parseArgs :: [String] -> Bool -> IO () +parseArgs ("-jar":jarpath:_) stdcp = do + unless stdcp $ addClassPath "./" + 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 bclspath = B.pack . map (fromIntegral . ord) $ mc cls <- getClassFile 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 ]" + +parseArgs ("-cp":cps) cpset = parseArgs ("-classpath":cps) cpset +parseArgs ("-classpath":cps:xs) False = do + mapM_ addStuff $ splitOn ":" cps + parseArgs xs True + where + addStuff :: String -> IO () + addStuff x + | ".jar" `isSuffixOf` x = addClassPathJAR x + | otherwise = addClassPath $ x ++ "/" +parseArgs ("-classpath":xs) _ = parseArgs ("-":xs) True -- usage +parseArgs (('-':_):_) _ = error "Usage: mate [-cp|-classpath ] [ | -jar ]" +-- first argument which isn't prefixed by '-' should be a class file +parseArgs (clspath:_) stdcp = do + unless stdcp $ addClassPath "./" + let bclspath = B.pack . map (fromIntegral . ord) $ clspath + cls <- getClassFile bclspath + executeMain bclspath cls +parseArgs _ _ = parseArgs ["-"] False + 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] +executeMain bclspath cls = do + initGC --required on some platforms. [todo bernhard: maybe this should be moved somewhere else - maybe at a global place where vm initialization takes place + let methods = classMethods cls; methods :: [Method Direct] + case find (\x -> methodName x == "main") methods of + Just m -> do + let mi = MethodInfo "main" bclspath $ methodSignature m + rawmethod <- parseMethod cls "main" $ methodSignature m + entry <- compileBB rawmethod 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"