X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=blobdiff_plain;f=Mate.hs;h=2231a5818be418b39fd6499043eb15927ab9207a;hp=e1473daee9c2851e36bfddee3022ab47723f9b19;hb=HEAD;hpb=b28a506429a0fcfa53f199fc17928dc1e885aabd diff --git a/Mate.hs b/Mate.hs index e1473da..2231a58 100644 --- a/Mate.hs +++ b/Mate.hs @@ -1,14 +1,74 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Text.Printf +import System.Environment +import Data.Char +import Data.List +import Data.List.Split +import qualified Data.ByteString.Lazy as B +import Control.Monad -import Mate.X86CodeGen +import JVM.ClassFile +import Java.JAR + +import Mate.BasicBlocks import Mate.MethodPool +import Mate.Types +import Mate.ClassPool +import Mate.NativeMachine +import Mate.Debug + +import Mate.GC.Boehm main :: IO () main = do - printf "fib Codegen:\n" - test_01 - printf "\n\n\n\nData.Map & FFI:\n" - t_01 + args <- getArgs + register_signal + 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 + +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 + 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 mi rawmethod mi + addMethodRef entry mi [bclspath] + printfInfo "executing `main' now:\n" + executeFuncPtr $ fst entry + Nothing -> error "main not found"