tests: don't use `pop' hack anymore, but System.out.printf \o/

[mate.git] / Mate / X86CodeGen.hs

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 2db7a979a0ad5730748325ccdca3b4ad3a1b7ba9..00e93032827e46d5acf2c65c80468f48d93aff60 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -3,6 +3,7 @@
 module Mate.X86CodeGen where
 
 import Data.Binary
+import Data.BinaryState
 import Data.Int
 import Data.Maybe
 import qualified Data.Map as M
@@ -10,7 +11,7 @@ import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as B
 import Control.Monad
 
-import Foreign
+import Foreign hiding (xor)
 import Foreign.C.Types
 
 import Text.Printf
@@ -26,6 +27,8 @@ import Mate.BasicBlocks
 import Mate.Types
 import Mate.Utilities
 import Mate.ClassPool
+import Mate.Strings
+
 
 foreign import ccall "dynamic"
    code_int :: FunPtr (CInt -> CInt -> IO CInt) -> (CInt -> CInt -> IO CInt)
@@ -197,7 +200,7 @@ emitFromBB method cls hmap =  do
         mov eax (Disp 0, eax)
         -- get method offset
         let nameAndSig = methodname `B.append` (encode msig)
-        let offset = unsafePerformIO $ getMethodOffset objname nameAndSig
+        offset <- liftIO $ getMethodOffset objname nameAndSig
         -- make actual (indirect) call
         calladdr <- getCurrentOffset
         call (Disp offset, eax)
@@ -223,27 +226,51 @@ emitFromBB method cls hmap =  do
     emit' insn = emit insn >> return Nothing
 
     emit :: J.Instruction -> CodeGen e s ()
-    emit POP = do -- print dropped value
-        calladdr <- getCurrentOffset
-        -- '5' is the size of the `call' instruction ( + immediate)
-        let w32_calladdr = 5 + calladdr
-        let trapaddr = (fromIntegral getaddr :: Word32)
-        call (trapaddr - w32_calladdr)
+    emit POP = do -- dropp value
         add esp (4 :: Word32)
     emit DUP = push (Disp 0, esp)
+    emit AASTORE = emit IASTORE
+    emit IASTORE = do
+        pop eax -- value
+        pop ebx -- offset
+        add ebx (1 :: Word32)
+        pop ecx -- aref
+        mov (ecx, ebx, S4) eax
+    emit AALOAD = emit IALOAD
+    emit IALOAD = do
+        pop ebx -- offset
+        add ebx (1 :: Word32)
+        pop ecx -- aref
+        push (ecx, ebx, S4)
+    emit ARRAYLENGTH = do
+        pop eax
+        push (Disp 0, eax)
+    emit (ANEWARRAY _) = emit (NEWARRAY 10) -- 10 == T_INT
+    emit (NEWARRAY typ) = do
+        let tsize = case decodeS (0 :: Integer) (B.pack [typ]) of
+                    T_INT -> 4
+                    _ -> error $ "newarray: type not implemented yet"
+        -- get length from stack, but leave it there
+        mov eax (Disp 0, esp)
+        mov ebx (tsize :: Word32)
+        -- multiple amount with native size of one element
+        mul ebx -- result is in eax
+        add eax (4 :: Word32) -- for "length" entry
+        -- push amount of bytes to allocate
+        push eax
+        callMalloc
+        pop eax -- ref to arraymemory
+        pop ebx -- length
+        mov (Disp 0, eax) ebx -- store length at offset 0
+        push eax -- push ref again
     emit (NEW objidx) = do
         let objname = buildClassID cls objidx
-        let amount = unsafePerformIO $ getMethodSize objname
+        amount <- liftIO $ getMethodSize objname
         push (amount :: Word32)
-        calladdr <- getCurrentOffset
-        let w32_calladdr = 5 + calladdr
-        let malloaddr = (fromIntegral getMallocAddr :: Word32)
-        call (malloaddr - w32_calladdr)
-        add esp (4 :: Word32)
-        push eax
+        callMalloc
         -- TODO(bernhard): save reference somewhere for GC
         -- set method table pointer
-        let mtable = unsafePerformIO $ getMethodTable objname
+        mtable <- liftIO $ getMethodTable objname
         mov (Disp 0, eax) mtable
     emit (CHECKCAST _) = nop -- TODO(bernhard): ...
     emit (BIPUSH val) = push ((fromIntegral val) :: Word32)
@@ -251,6 +278,7 @@ emitFromBB method cls hmap =  do
     emit (ICONST_0) = push (0 :: Word32)
     emit (ICONST_1) = push (1 :: Word32)
     emit (ICONST_2) = push (2 :: Word32)
+    emit (ICONST_3) = push (3 :: Word32)
     emit (ICONST_4) = push (4 :: Word32)
     emit (ICONST_5) = push (5 :: Word32)
     emit (ALOAD_ x) = emit (ILOAD_ x)
@@ -268,24 +296,32 @@ emitFromBB method cls hmap =  do
         pop eax
         mov (Disp (cArgs x), ebp) eax
 
+    emit (LDC1 x) = emit (LDC2 $ fromIntegral x)
+    emit (LDC2 x) = do
+        value <- case (constsPool cls) M.! x of
+                      (CString s) -> liftIO $ getUniqueStringAddr s
+                      _ -> error $ "LDCI... missing impl."
+        push value
     emit (GETFIELD x) = do
         pop eax -- this pointer
         let (cname, fname) = buildFieldOffset cls x
-        let offset = unsafePerformIO $ getFieldOffset cname fname
-        push (Disp (fromIntegral $ offset * 4), eax) -- get field
+        offset <- liftIO $ getFieldOffset cname fname
+        push (Disp (fromIntegral $ offset), eax) -- get field
     emit (PUTFIELD x) = do
         pop ebx -- value to write
         pop eax -- this pointer
         let (cname, fname) = buildFieldOffset cls x
-        let offset = unsafePerformIO $ getFieldOffset cname fname
-        mov (Disp (fromIntegral $ offset * 4), eax) ebx -- set field
+        offset <- liftIO $ getFieldOffset cname fname
+        mov (Disp (fromIntegral $ offset), eax) ebx -- set field
 
     emit IADD = do pop ebx; pop eax; add eax ebx; push eax
     emit ISUB = do pop ebx; pop eax; sub eax ebx; push eax
     emit IMUL = do pop ebx; pop eax; mul ebx; push eax
+    emit IXOR = do pop ebx; pop eax; xor eax ebx; push eax
     emit (IINC x imm) = do
         add (Disp (cArgs x), ebp) (s8_w32 imm)
 
+    emit (IF_ACMP cond x) = emit (IF_ICMP cond x)
     emit (IF_ICMP cond _) = do
         pop eax -- value2
         pop ebx -- value1
@@ -320,6 +356,15 @@ emitFromBB method cls hmap =  do
         ret
     emit invalid = error $ "insn not implemented yet: " ++ (show invalid)
 
+    callMalloc :: CodeGen e s ()
+    callMalloc = do
+        calladdr <- getCurrentOffset
+        let w32_calladdr = 5 + calladdr
+        let malloaddr = (fromIntegral getMallocAddr :: Word32)
+        call (malloaddr - w32_calladdr)
+        add esp (4 :: Word32)
+        push eax
+
   -- for locals we use a different storage
   cArgs :: Word8 -> Word32
   cArgs x = if (x' >= thisMethodArgCnt)