X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FX86CodeGen.hs;h=8b3c39f49d94b14c3953e6641c673b8a418fbcd4;hb=526b106f46fc784f03a05968159948957b2807a7;hp=42ee6620232fd4450b81157db8fbf4e0b739906d;hpb=1315c607541c6fe37830242dfca042e60a2b6eb0;p=mate.git

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 42ee662..8b3c39f 100644
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -4,7 +4,7 @@
 #include "debug.h"
 module Mate.X86CodeGen where
 
-import Prelude hiding (and)
+import Prelude hiding (and, div)
 import Data.Binary
 import Data.BinaryState
 import Data.Int
@@ -29,13 +29,13 @@ import Mate.Types
 import Mate.Utilities
 import Mate.ClassPool
 import Mate.Strings
+#ifdef DEBUG
+import Text.Printf
+#endif
 
 
-foreign import ccall "dynamic"
-   code_int :: FunPtr (CInt -> CInt -> IO CInt) -> CInt -> CInt -> IO CInt
-
-foreign import ccall "getMallocObjectAddr"
-  getMallocObjectAddr :: CUInt
+foreign import ccall "&mallocObject"
+  mallocObjectAddr :: FunPtr (Int -> IO CUInt)
 
 type EntryPoint = Ptr Word8
 type EntryPointOffset = Int
@@ -48,8 +48,9 @@ type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
 
 emitFromBB :: B.ByteString -> MethodSignature -> Class Direct -> MapBB -> CodeGen e s (CompileInfo, [Instruction])
 emitFromBB method sig cls hmap =  do
-        llmap <- sequence [newNamedLabel ("bb_" ++ show x) | (x,_) <- M.toList hmap]
-        let lmap = zip (Prelude.fst $ unzip $ M.toList hmap) llmap
+        let keys = M.keys hmap
+        llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
+        let lmap = zip keys llmap
         ep <- getEntryPoint
         push ebp
         mov ebp esp
@@ -74,11 +75,14 @@ emitFromBB method sig cls hmap =  do
           bb_offset <- getCodeOffset
           let bbstarts' = M.insert bid bb_offset bbstarts
           defineLabel $ getLabel bid lmap
-          cs <- mapM emit' $ code bb
+          cs <- mapM emit'' $ code bb
           let calls' = calls `M.union` M.fromList (catMaybes cs)
           case successor bb of
             Return -> return (calls', bbstarts')
-            FallThrough t -> efBB (t, hmap M.! t) calls' bbstarts' lmap
+            FallThrough t -> do
+              -- TODO(bernhard): le dirty hax. see java/lang/Integer.toString(int, int)
+              jmp (getLabel t lmap)
+              efBB (t, hmap M.! t) calls' bbstarts' lmap
             OneTarget t -> efBB (t, hmap M.! t) calls' bbstarts' lmap
             TwoTarget t1 t2 -> do
               (calls'', bbstarts'') <- efBB (t1, hmap M.! t1) calls' bbstarts' lmap
@@ -94,7 +98,7 @@ emitFromBB method sig cls hmap =  do
       offset <- getCodeOffset
       return $ w32_ep + fromIntegral offset
 
-    emitInvoke :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapInfo))
+    emitInvoke :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause))
     emitInvoke cpidx hasThis = do
         let l = buildMethodID cls cpidx
         calladdr <- getCurrentOffset
@@ -108,9 +112,25 @@ emitFromBB method sig cls hmap =  do
         -- push result on stack if method has a return value
         when (methodHaveReturnValue cls cpidx) (push eax)
         -- +2 is for correcting eip in trap context
-        return $ Just (calladdr + 2, MI l)
+        return $ Just (calladdr + 2, StaticMethod l)
 
-    emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapInfo))
+    invokeEpilog :: Word16 -> Word32 -> (Bool -> TrapCause) -> CodeGen e s (Maybe (Word32, TrapCause))
+    invokeEpilog cpidx offset trapcause = do
+        -- make actual (indirect) call
+        calladdr <- getCurrentOffset
+        call (Disp offset, eax)
+        -- discard arguments on stack (+4 for "this")
+        let argcnt = 4 + 4 * methodGetArgsCount cls cpidx
+        when (argcnt > 0) (add esp argcnt)
+        -- push result on stack if method has a return value
+        when (methodHaveReturnValue cls cpidx) (push eax)
+        let imm8 = is8BitOffset offset
+        return $ Just (calladdr + (if imm8 then 3 else 6), trapcause imm8)
+
+    emit'' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
+    emit'' insn = newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
+
+    emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
     emit' (INVOKESPECIAL cpidx) = emitInvoke cpidx True
     emit' (INVOKESTATIC cpidx) = emitInvoke cpidx False
     emit' (INVOKEINTERFACE cpidx _) = do
@@ -125,18 +145,10 @@ emitFromBB method sig cls hmap =  do
         mov ebx (Disp 0, eax)
         -- get method offset
         offset <- liftIO $ getInterfaceMethodOffset ifacename methodname (encode msig)
-        -- make actual (indirect) call
-        calladdr <- getCurrentOffset
-        call (Disp offset, ebx)
-        -- discard arguments on stack (+4 for "this")
-        let argcnt = 4 + 4 * methodGetArgsCount cls cpidx
-        when (argcnt > 0) (add esp argcnt)
-        -- push result on stack if method has a return value
-        when (methodHaveReturnValue cls cpidx) (push eax)
-        -- note, the "mi" has the wrong class reference here.
+        -- note, that "mi" has the wrong class reference here.
         -- we figure that out at run-time, in the methodpool,
         -- depending on the method-table-ptr
-        return $ Just (calladdr, II mi)
+        invokeEpilog cpidx offset (`InterfaceMethod` mi)
     emit' (INVOKEVIRTUAL cpidx) = do
         -- get methodInfo entry
         let mi@(MethodInfo methodname objname msig@(MethodSignature args _))  = buildMethodID cls cpidx
@@ -148,33 +160,27 @@ emitFromBB method sig cls hmap =  do
         -- get method offset
         let nameAndSig = methodname `B.append` encode msig
         offset <- liftIO $ getMethodOffset objname nameAndSig
-        -- make actual (indirect) call
-        calladdr <- getCurrentOffset
-        call (Disp offset, eax)
-        -- discard arguments on stack (+4 for "this")
-        let argcnt = 4 + 4 * methodGetArgsCount cls cpidx
-        when (argcnt > 0) (add esp argcnt)
-        -- push result on stack if method has a return value
-        when (methodHaveReturnValue cls cpidx) (push eax)
-        -- note, the "mi" has the wrong class reference here.
+        -- note, that "mi" has the wrong class reference here.
         -- we figure that out at run-time, in the methodpool,
         -- depending on the method-table-ptr
-        return $ Just (calladdr, VI mi)
+        invokeEpilog cpidx offset (`VirtualMethod` mi)
     emit' (PUTSTATIC cpidx) = do
         pop eax
         trapaddr <- getCurrentOffset
         mov (Addr 0x00000000) eax -- it's a trap
-        return $ Just (trapaddr, SFI $ buildStaticFieldID cls cpidx)
+        return $ Just (trapaddr, StaticField $ buildStaticFieldID cls cpidx)
     emit' (GETSTATIC cpidx) = do
         trapaddr <- getCurrentOffset
         mov eax (Addr 0x00000000) -- it's a trap
         push eax
-        return $ Just (trapaddr, SFI $ buildStaticFieldID cls cpidx)
+        return $ Just (trapaddr, StaticField $ buildStaticFieldID cls cpidx)
     emit' insn = emit insn >> return Nothing
 
     emit :: J.Instruction -> CodeGen e s ()
     emit POP = add esp (4 :: Word32) -- drop value
     emit DUP = push (Disp 0, esp)
+    emit DUP_X1 = do pop eax; pop ebx; push eax; push ebx; push eax
+    emit DUP_X2 = do pop eax; pop ebx; pop ecx; push eax; push ecx; push ebx; push eax
     emit AASTORE = emit IASTORE
     emit IASTORE = do
         pop eax -- value
@@ -231,26 +237,34 @@ emitFromBB method sig cls hmap =  do
         mtable <- liftIO $ getMethodTable objname
         mov (Disp 0, eax) mtable
     emit (CHECKCAST _) = nop -- TODO(bernhard): ...
+    -- TODO(bernhard): ...
+    emit (INSTANCEOF _) = do
+      pop eax
+      push (1 :: Word32)
+    emit ATHROW = -- TODO(bernhard): ...
+        emit32 (0xffffffff :: Word32)
     emit I2C = do
       pop eax
       and eax (0x000000ff :: Word32)
       push eax
     emit (BIPUSH val) = push (fromIntegral val :: Word32)
     emit (SIPUSH val) = push (fromIntegral (fromIntegral val :: Int16) :: Word32)
+    emit ACONST_NULL = push (0 :: Word32)
+    emit (ICONST_M1) = push ((-1) :: Word32)
     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)
-    emit (ILOAD_ x) = push (Disp (cArgs_ x), ebp)
+    emit (ILOAD_ x) = emit (ILOAD $ cArgs_ x)
     emit (ALOAD x) = emit (ILOAD x)
     emit (ILOAD x) = push (Disp (cArgs x), ebp)
+
     emit (ASTORE_ x) = emit (ISTORE_ x)
-    emit (ISTORE_ x) = do
-        pop eax
-        mov (Disp (cArgs_ x), ebp) eax
+    emit (ISTORE_ x) = emit (ISTORE $ cArgs_ x)
     emit (ASTORE x) = emit (ISTORE x)
     emit (ISTORE x) = do
         pop eax
@@ -260,7 +274,8 @@ emitFromBB method sig cls hmap =  do
     emit (LDC2 x) = do
         value <- case constsPool cls M.! x of
                       (CString s) -> liftIO $ getUniqueStringAddr s
-                      _ -> error "LDCI... missing impl."
+                      (CInteger i) -> liftIO $ return i
+                      e -> error $ "LDCI... missing impl.: " ++ show e
         push value
     emit (GETFIELD x) = do
         offset <- emitFieldOffset x
@@ -273,10 +288,16 @@ emitFromBB method sig cls hmap =  do
     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 IDIV = do pop ebx; pop eax; xor edx edx; div ebx; push eax
+    emit IREM = do pop ebx; pop eax; xor edx edx; div ebx; push edx
     emit IXOR = do pop ebx; pop eax; xor eax ebx; push eax
+    emit IUSHR = do pop ecx; pop eax; sar eax cl; push eax
+    emit INEG = do pop eax; neg eax; push eax
     emit (IINC x imm) =
         add (Disp (cArgs x), ebp) (s8_w32 imm)
 
+    emit (IFNONNULL x) = emit (IF C_NE x)
+    emit (IFNULL x) = emit (IF C_EQ x)
     emit (IF_ACMP cond x) = emit (IF_ICMP cond x)
     emit (IF_ICMP cond _) = do
         pop eax -- value2
@@ -308,17 +329,21 @@ emitFromBB method sig cls hmap =  do
     emitIF cond = let
       sid = case successor bb of TwoTarget _ t -> t; _ -> error "bad"
       l = getLabel sid lmap
-      in case cond of
-        C_EQ -> je  l; C_NE -> jne l
-        C_LT -> jl  l; C_GT -> jg  l
-        C_GE -> jge l; C_LE -> jle l
+      sid2 = case successor bb of TwoTarget t _ -> t; _ -> error "bad"
+      l2 = getLabel sid2 lmap
+      in do
+        case cond of
+          C_EQ -> je  l; C_NE -> jne l
+          C_LT -> jl  l; C_GT -> jg  l
+          C_GE -> jge l; C_LE -> jle l
+        -- TODO(bernhard): ugly workaround, to get broken emitBB working
+        --  (it didn't work for gnu/classpath/SystemProperties.java)
+        jmp l2
+
 
     callMalloc :: CodeGen e s ()
     callMalloc = do
-        calladdr <- getCurrentOffset
-        let w32_calladdr = 5 + calladdr
-        let malloaddr = fromIntegral getMallocObjectAddr :: Word32
-        call (malloaddr - w32_calladdr)
+        call mallocObjectAddr
         add esp (4 :: Word32)
         push eax
 
@@ -330,13 +355,13 @@ emitFromBB method sig cls hmap =  do
       else 4 + (thisMethodArgCnt * 4) - (4 * x')
     where x' = fromIntegral x
 
-  cArgs_ :: IMM -> Word32
-  cArgs_ x = cArgs $ case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
+  cArgs_ :: IMM -> Word8
+  cArgs_ x = case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
 
   thisMethodArgCnt :: Word32
   thisMethodArgCnt = isNonStatic + fromIntegral (length args)
     where
-    (Just m) = lookupMethodSig method sig cls
+    m = fromJust $ lookupMethodSig method sig cls
     (MethodSignature args _) = sig
     isNonStatic = if S.member ACC_STATIC (methodAccessFlags m)
         then 0 else 1 -- one argument for the this pointer
@@ -348,3 +373,7 @@ emitFromBB method sig cls hmap =  do
   s8_w32 :: Word8 -> Word32
   s8_w32 w8 = fromIntegral s8
     where s8 = fromIntegral w8 :: Int8
+
+  is8BitOffset :: Word32 -> Bool
+  is8BitOffset w32 = s32 < 128 && s32 > (-127)
+    where s32 = fromIntegral w32 :: Int32