X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate.hs;h=02c9969ae55274aef67e84397e2b0d686b57a28f;hb=963d89d9e68f1db264e32afb681f5f2064aa82f4;hp=60eef34ea8114df6aedfc453f2bd14ea3fb08f30;hpb=963d156ebb3006076ac36cbd127df3d2fabd1704;p=mate.git

diff --git a/Mate.hs b/Mate.hs
index 60eef34..02c9969 100644
--- a/Mate.hs
+++ b/Mate.hs
@@ -1,114 +1,46 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
+#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 qualified Data.ByteString.Lazy as B
 
+#ifdef DEBUG
 import Text.Printf
-
-import Control.Monad
-
-import qualified JVM.Assembler as J
-import JVM.Assembler hiding (Instruction)
-import JVM.Common
+#endif
 import JVM.ClassFile
-import JVM.Converter
-import JVM.Dump
-
-import Foreign
-import Foreign.Ptr
-import Foreign.C.Types
-
-import Harpy
-import Harpy.X86Disassembler
-
 
-foreign import ccall "dynamic"
-   code_void :: FunPtr (CInt -> IO CInt) -> (CInt -> IO CInt)
-
-
-$(callDecl "callAsWord32" [t|Word32|])
+import Mate.BasicBlocks
+import Mate.X86CodeGen
+import Mate.MethodPool
+import Mate.Types
+import Mate.ClassPool
 
+main ::  IO ()
 main = do
   args <- getArgs
+  register_signal
   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
-          let emittedcode = compile $ codeInstructions $ decodeMethod bytecode
-          (_, Right (entryPtr, disasm)) <- runCodeGen emittedcode env ()
-          printf "entry point: 0x%08x\n" ((fromIntegral $ ptrToIntPtr entryPtr) :: Int)
-
-          let entryFuncPtr = ((castPtrToFunPtr entryPtr) :: FunPtr (CInt -> IO CInt))
-          result <- code_void entryFuncPtr (fromIntegral 0x1337)
-          let iresult::Int; iresult = fromIntegral result
-          printf "result: 0x%08x\n" iresult
-
-          result2 <- code_void entryFuncPtr (fromIntegral (-0x20))
-          let iresult2::Int; iresult2 = fromIntegral result2
-          printf "result: 0x%08x\n" iresult2
-
-          printf "disasm:\n"
-          mapM_ (putStrLn . showAtt) disasm
-          return ()
-
-
-entryCode :: CodeGen e s ()
-entryCode = do push ebp
-               mov ebp esp
-
-exitCode :: CodeGen e s ()
-exitCode = do mov esp ebp
-              pop ebp
-              ret
-
-compile :: [J.Instruction] -> CodeGen (Ptr Int32) s (Ptr Word8, [Instruction])
-compile insn = do
-  entryCode
-  mapM compile_ins insn
-  exitCode
-  d <- disassemble
-  c <- getEntryPoint
-  return (c,d)
-
-compile_ins :: J.Instruction -> CodeGen (Ptr Int32) s ()
-compile_ins (BIPUSH w8) = do mov eax ((fromIntegral w8) :: Word32)
-compile_ins (PUTSTATIC w16) = do add eax (Disp 8, ebp) -- add first argument to %eax
-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
+      let bclspath = B.pack $ map (fromIntegral . ord) clspath
+      cls <- getClassFile bclspath
+      hmap <- parseMethod cls "main"
+      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
+              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"
+        Nothing -> error "main not found"
+    _ -> error "Usage: mate <class-file>"