X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=blobdiff_plain;f=Mate.hs;h=2231a5818be418b39fd6499043eb15927ab9207a;hp=a4e2a97c258b0e8d687db652da39b49fd6b5a9f1;hb=HEAD;hpb=496288a6ff9de79049f177ed8ab5fc1c77e8bac3 diff --git a/Mate.hs b/Mate.hs index a4e2a97..2231a58 100644 --- a/Mate.hs +++ b/Mate.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -#include "debug.h" module Main where import System.Environment @@ -8,10 +6,8 @@ import Data.Char import Data.List import Data.List.Split import qualified Data.ByteString.Lazy as B +import Control.Monad -#ifdef DEBUG -import Text.Printf -#endif import JVM.ClassFile import Java.JAR @@ -19,7 +15,10 @@ import Mate.BasicBlocks import Mate.MethodPool import Mate.Types import Mate.ClassPool -import Mate.X86TrapHandling +import Mate.NativeMachine +import Mate.Debug + +import Mate.GC.Boehm main :: IO () main = do @@ -29,51 +28,47 @@ main = do parseArgs :: [String] -> Bool -> IO () parseArgs ("-jar":jarpath:_) stdcp = do - if not stdcp then addClassPath "./" else return () + 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 + 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 - let paths = splitOn ":" cps - mapM_ addStuff paths + mapM_ addStuff $ splitOn ":" cps parseArgs xs True - where - addStuff :: String -> IO () - addStuff x - | ".jar" `isSuffixOf` x = addClassPathJAR x - | otherwise = addClassPath $ x ++ "/" + 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 - if not stdcp then addClassPath "./" else return () - let bclspath = B.pack $ map (fromIntegral . ord) clspath + 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] -#ifdef DEBUG - printf "executing `main' now:\n" -#endif - executeFuncPtr entry - Nothing -> error "main not found" +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"