mate: Initial commit

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..df1cda2
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+*.hi
+*.class
+mate

diff --git a/Makefile b/Makefile
new file mode 100644 (file)
index 0000000..8965f9a
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,11 @@
+all: mate Test.class
+       ./mate Test.class
+
+%.class: %.java
+       javac $<
+
+mate: Mate.hs
+       ghc --make -O2 $< -o $@
+
+clean:
+       rm -f *.hi *.o mate

diff --git a/Mate.hs b/Mate.hs
new file mode 100644 (file)
index 0000000..9fe09c6
--- /dev/null
+++ b/Mate.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}
+module Main where
+
+import Data.Binary
+import Data.String
+import System.Environment hiding (getEnv)
+import qualified Data.Map as M
+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
+import JVM.ClassFile
+import JVM.Converter
+import JVM.Dump
+
+import Foreign
+
+import Harpy
+import Harpy.X86Disassembler
+
+
+$(callDecl "callAsWord32" [t|Word32|])
+
+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
+
+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)
+
+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

diff --git a/README b/README
new file mode 100644 (file)
index 0000000..2cb413d
--- /dev/null
+++ b/README
@@ -0,0 +1,3 @@
+== DEPENDENCIES ==
+$ cabal install harpy
+$ cabal install hs-java # 0.2 at the moment!

diff --git a/Test.java b/Test.java
new file mode 100644 (file)
index 0000000..6f557c3
--- /dev/null
+++ b/Test.java
@@ -0,0 +1,9 @@
+public class Test {
+    private static int foo;
+    private static int bar;
+
+    public static void main(String [] args) {
+      foo = 0x42;
+      bar = 2 * foo;
+    }
+}