Mate.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Main where
   3
   4 import System.Environment
   5 import Data.Char
   6 import Data.List
   7 import Data.List.Split
   8 import qualified Data.ByteString.Lazy as B
   9 import Control.Monad
  10
  11 import JVM.ClassFile
  12 import Java.JAR
  13
  14 import Mate.BasicBlocks
  15 import Mate.MethodPool
  16 import Mate.Types
  17 import Mate.ClassPool
  18 import Mate.NativeMachine
  19 import Mate.Debug
  20
  21 import Mate.GC.Boehm
  22
  23 main ::  IO ()
  24 main = do
  25   args <- getArgs
  26   register_signal
  27   parseArgs args False
  28
  29 parseArgs :: [String] -> Bool -> IO ()
  30 parseArgs ("-jar":jarpath:_) stdcp = do
  31   unless stdcp $ addClassPath "./"
  32   addClassPathJAR jarpath
  33   res <- readMainClass jarpath
  34   case res of
  35     Nothing -> error "JAR: no MainClass entry found. Try to pass the jar file via -cp instead."
  36     Just mc -> do
  37       let bclspath = B.pack . map (fromIntegral . ord) $ mc
  38       cls <- getClassFile bclspath
  39       executeMain bclspath cls
  40
  41 parseArgs ("-cp":cps) cpset = parseArgs ("-classpath":cps) cpset
  42 parseArgs ("-classpath":cps:xs) False = do
  43   mapM_ addStuff $ splitOn ":" cps
  44   parseArgs xs True
  45     where
  46       addStuff :: String -> IO ()
  47       addStuff x
  48         | ".jar" `isSuffixOf` x = addClassPathJAR x
  49         | otherwise = addClassPath $ x ++ "/"
  50 parseArgs ("-classpath":xs) _ = parseArgs ("-":xs) True -- usage
  51 parseArgs (('-':_):_) _ = error "Usage: mate [-cp|-classpath <cp1:cp2:..>] [<class-file> | -jar <jar-file>]"
  52 -- first argument which isn't prefixed by '-' should be a class file
  53 parseArgs (clspath:_) stdcp = do
  54   unless stdcp $ addClassPath "./"
  55   let bclspath = B.pack . map (fromIntegral . ord) $ clspath
  56   cls <- getClassFile bclspath
  57   executeMain bclspath cls
  58 parseArgs _ _ = parseArgs ["-"] False
  59
  60
  61 executeMain :: B.ByteString -> Class Direct -> IO ()
  62 executeMain bclspath cls = do
  63   initGC --required on some platforms. [todo bernhard: maybe this should be moved somewhere else - maybe at a global place where vm initialization takes place
  64
  65   let methods = classMethods cls; methods :: [Method Direct]
  66   case find (\x -> methodName x == "main") methods of
  67     Just m -> do
  68       let mi = MethodInfo "main" bclspath $ methodSignature m
  69       rawmethod <- parseMethod cls "main" $ methodSignature m
  70       entry <- compileBB rawmethod mi
  71       addMethodRef entry mi [bclspath]
  72       printfInfo "executing `main' now:\n"
  73       executeFuncPtr entry
  74     Nothing -> error "main not found"