Mate.hs

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