X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate.hs;h=eb3c8733bab63d9261cc54f6247888e244220fbc;hb=d3f63d65d80aaab4ad8eac43ee1caea7dea09fbd;hp=8e63fbf578132bd2c3afeeeae57700583c3fccd8;hpb=399b0642a76cf3ae0f1a654ba6466ea2ac7e9136;p=mate.git diff --git a/Mate.hs b/Mate.hs index 8e63fbf..eb3c873 100644 --- a/Mate.hs +++ b/Mate.hs @@ -1,45 +1,79 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +#include "debug.h" module Main where import System.Environment import Data.Char -import Data.String.Utils 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 JVM.Converter -import JVM.Dump +import Java.JAR import Mate.BasicBlocks -import Mate.X86CodeGen import Mate.MethodPool import Mate.Types import Mate.ClassPool +import Mate.X86TrapHandling main :: IO () main = do args <- getArgs register_signal - initMethodPool - 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 - dumpClass cls - hmap <- parseMethod cls "main" - printMapBB hmap + executeMain bclspath cls +parseArgs ("-cp":cps) cpset = parseArgs ("-classpath":cps) cpset +parseArgs ("-classpath":cps:xs) False = do + let paths = splitOn ":" cps + mapM_ addStuff paths + 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 + 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 + hmap <- parseMethod cls "main" $ methodSignature m case hmap of Just hmap' -> do - let methods = classMethods cls; methods :: [Method Resolved] - let method = find (\x -> (methodName x) == "main") methods - case method of - Just m -> do - entry <- compileBB hmap' (MethodInfo "main" bclspath (methodSignature m)) - printf "executing `main' now:\n" - executeFuncPtr entry - Nothing -> error "main not found" + entry <- compileBB hmap' mi + addMethodRef entry mi [bclspath] +#ifdef DEBUG + printf "executing `main' now:\n" +#endif + executeFuncPtr entry Nothing -> error "main not found" - _ -> error "Usage: mate " + Nothing -> error "main not found"