X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate.hs;h=eb3c8733bab63d9261cc54f6247888e244220fbc;hb=d3f63d65d80aaab4ad8eac43ee1caea7dea09fbd;hp=9fe09c6e3068b0da6d3baec792e4551a190af6f7;hpb=1c105c478918638cd02a42c96055681bff79aa4d;p=mate.git

diff --git a/Mate.hs b/Mate.hs
index 9fe09c6..eb3c873 100644
--- a/Mate.hs
+++ b/Mate.hs
@@ -1,95 +1,79 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}
+#include "debug.h"
 module Main where
 
-import Data.Binary
-import Data.String
-import System.Environment hiding (getEnv)
-import qualified Data.Map as M
+import System.Environment
+import Data.Char
+import Data.List
+import Data.List.Split
 import qualified Data.ByteString.Lazy as B
-
-import Text.Printf
-
 import Control.Monad
 
-import qualified JVM.Assembler as J
-import JVM.Assembler hiding (Instruction)
-import JVM.Common
+#ifdef DEBUG
+import Text.Printf
+#endif
 import JVM.ClassFile
-import JVM.Converter
-import JVM.Dump
-
-import Foreign
-
-import Harpy
-import Harpy.X86Disassembler
+import Java.JAR
 
+import Mate.BasicBlocks
+import Mate.MethodPool
+import Mate.Types
+import Mate.ClassPool
+import Mate.X86TrapHandling
 
-$(callDecl "callAsWord32" [t|Word32|])
-
+main ::  IO ()
 main = do
   args <- getArgs
-  case args of
-    [clspath] -> do
-      clsFile <- decodeFile clspath
-      let cp = constsPool (clsFile :: Class Pointers)
-      putStrLn "==== constpool: ===="
-      putStrLn $ showListIx $ M.elems cp
-      cf <- parseClassFile clspath
-      putStrLn "==== classfile dump: ===="
-      dumpClass cf
-      putStrLn "==== random stuff: ===="
-      let mainmethod = lookupMethod "main" cf -- "main|([Ljava/lang/String;)V" cf
-      case mainmethod of
-        Nothing -> putStrLn "no main found"
-        Just main ->
-          case attrByName main "Code" of
-            Nothing -> putStrLn "no code attr found"
-            Just bytecode -> do
-              putStrLn "woot, running now"
-              allocaArray 26 (\ p -> mapM_ (\ i -> poke (advancePtr p i) 0) [0..25] >> runstuff p bytecode)
-    _ -> error "Synopsis: dump-class File.class"
-
-runstuff :: Ptr Int32 -> B.ByteString -> IO ()
-runstuff env bytecode = do
-          (_, Right (ret, disasm)) <- runCodeGen (compile $ codeInstructions $ decodeMethod bytecode) env ()
-          printf "return value: 0x%08x\n" ret
-          printf "disasm:\n"
-          mapM_ (putStrLn . showAtt) disasm
-          return ()
-
-entryCode :: CodeGen e s ()
-entryCode = do push ebp
-               mov ebp esp
+  register_signal
+  parseArgs args False
 
-exitCode :: CodeGen e s ()
-exitCode = do mov esp ebp
-              pop ebp
-              ret
-
-compile :: [J.Instruction] -> CodeGen (Ptr Int32) s (Int32, [Instruction])
-compile insn = do
-  entryCode
-  mapM compile_ins insn
-  exitCode
-  d <- disassemble
-  r <- callAsWord32
-  return (fromIntegral r, d)
+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
+  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 <cp1:cp2:..>] [<class-file> | -jar <jar-file>]"
+-- 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
 
-compile_ins :: J.Instruction -> CodeGen (Ptr Int32) s ()
-compile_ins (BIPUSH w8) = do mov eax ((fromIntegral w8) :: Word32)
-compile_ins (PUTSTATIC w16) = do nop
-compile_ins (GETSTATIC w16) = do nop
-compile_ins ICONST_2 = do nop
-compile_ins IMUL = do nop
-compile_ins RETURN = do nop
-compile_ins _ = do nop
 
--- TODO: actually this function already exists in hs-java-0.3!
-lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
-lookupMethod name cls = look (classMethods cls)
-  where
-    look [] = Nothing
-    look (f:fs)
-      | methodName f == name = Just f
-      | otherwise  = look fs
+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
+          entry <- compileBB hmap' mi
+          addMethodRef entry mi [bclspath]
+#ifdef DEBUG
+          printf "executing `main' now:\n"
+#endif
+          executeFuncPtr entry
+        Nothing -> error "main not found"
+    Nothing -> error "main not found"