invokevirtual: implement lazy class loading right
[mate.git] / Mate / X86CodeGen.hs
index df39e5f858c7251057912d1167bfdc6c3a25922c..fb62c905d3332d67c3188e5b81cba239e809a676 100644 (file)
@@ -9,6 +9,7 @@ import Data.Binary
 import Data.BinaryState
 import Data.Int
 import Data.Maybe
+import Data.List (genericLength)
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as B
 import Control.Monad
@@ -24,6 +25,7 @@ import Harpy
 import Harpy.X86Disassembler
 
 import Mate.BasicBlocks
+import Mate.NativeSizes
 import Mate.Types
 import Mate.Utilities
 import Mate.ClassPool
@@ -34,7 +36,7 @@ import Text.Printf
 
 
 foreign import ccall "&mallocObject"
-  mallocObjectAddr :: FunPtr (Int -> IO CUInt)
+  mallocObjectAddr :: FunPtr (Int -> IO CPtrdiff)
 
 type EntryPoint = Ptr Word8
 type EntryPointOffset = Int
@@ -53,7 +55,7 @@ emitFromBB cls method = do
     ep <- getEntryPoint
     push ebp
     mov ebp esp
-    sub esp (fromIntegral ((rawLocals method) * 4) :: Word32)
+    sub esp (fromIntegral (rawLocals method) * ptrSize :: Word32)
 
     (calls, bbstarts) <- efBB (0, hmap M.! 0) M.empty M.empty lmap
     d <- disassemble
@@ -90,6 +92,13 @@ emitFromBB cls method = do
     -- TODO(bernhard): implement `emit' as function which accepts a list of
     --                 instructions, so we can use patterns for optimizations
     where
+    forceRegDump :: CodeGen e s ()
+    forceRegDump = do
+      push esi
+      mov esi (0x13371234 :: Word32)
+      mov esi (Addr 0)
+      pop esi
+
     getCurrentOffset :: CodeGen e s Word32
     getCurrentOffset = do
       ep <- getEntryPoint
@@ -103,28 +112,44 @@ emitFromBB cls method = do
       calladdr <- getCurrentOffset
       newNamedLabel (show l) >>= defineLabel
       -- causes SIGILL. in the signal handler we patch it to the acutal call.
-      -- place a nop at the end, therefore the disasm doesn't screw up
-      emit32 (0xffff9090 :: Word32) >> emit8 (0x90 :: Word8)
+      -- place two nop's at the end, therefore the disasm doesn't screw up
+      emit32 (0x9090ffff :: Word32); nop
       -- discard arguments on stack
-      let argcnt = ((if hasThis then 1 else 0) + (methodGetArgsCount $ methodNameTypeByIdx cls cpidx)) * 4
+      let argcnt = ((if hasThis then 1 else 0) + methodGetArgsCount (methodNameTypeByIdx cls cpidx)) * ptrSize
       when (argcnt > 0) (add esp argcnt)
       -- 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, StaticMethod l)
+      return $ Just (calladdr, StaticMethod l)
 
-    invokeEpilog :: Word16 -> Word32 -> (Bool -> TrapCause) -> CodeGen e s (Maybe (Word32, TrapCause))
-    invokeEpilog cpidx offset trapcause = do
+    virtualCall :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause))
+    virtualCall cpidx isInterface = do
+      let mi@(MethodInfo methodname objname msig@(MethodSignature args _))  = buildMethodID cls cpidx
+      newNamedLabel (show mi) >>= defineLabel
+      -- get method offset for call @ runtime
+      let offset = if isInterface
+          then getInterfaceMethodOffset objname methodname (encode msig)
+          else getMethodOffset objname (methodname `B.append` encode msig)
+      let argsLen = genericLength args
+      -- objref lives somewhere on the argument stack
+      mov ebx (Disp (argsLen * ptrSize), esp)
+      if isInterface
+        then mov ebx (Disp 0, ebx) -- get method-table-ptr, keep it in ebx
+        else return () -- invokevirtual
+      -- get method-table-ptr (or interface-table-ptr)
+      mov eax (Disp 0, ebx)
       -- make actual (indirect) call
       calladdr <- getCurrentOffset
-      call (Disp offset, eax)
-      -- discard arguments on stack (+4 for "this")
-      let argcnt = 4 + 4 * (methodGetArgsCount $ methodNameTypeByIdx cls cpidx)
+      -- will be patched to this: call (Disp 0xXXXXXXXX, eax)
+      emit32 (0x9090ffff :: Word32); nop; nop
+      -- discard arguments on stack (`+1' for "this")
+      let argcnt = ptrSize * (1 + methodGetArgsCount (methodNameTypeByIdx 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)
+      -- 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, VirtualCall isInterface mi offset)
 
     emit'' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
     emit'' insn = newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
@@ -132,37 +157,8 @@ emitFromBB cls method = do
     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
-      -- get methodInfo entry
-      let mi@(MethodInfo methodname ifacename msig@(MethodSignature args _)) = buildMethodID cls cpidx
-      newNamedLabel (show mi) >>= defineLabel
-      -- objref lives somewhere on the argument stack
-      mov eax (Disp ((*4) $ fromIntegral $ length args), esp)
-      -- get method-table-ptr, keep it in eax (for trap handling)
-      mov eax (Disp 0, eax)
-      -- get interface-table-ptr
-      mov ebx (Disp 0, eax)
-      -- get method offset
-      offset <- liftIO $ getInterfaceMethodOffset ifacename methodname (encode msig)
-      -- 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
-      invokeEpilog cpidx offset (`InterfaceMethod` mi)
-    emit' (INVOKEVIRTUAL cpidx) = do
-      -- get methodInfo entry
-      let mi@(MethodInfo methodname objname msig@(MethodSignature args _))  = buildMethodID cls cpidx
-      newNamedLabel (show mi) >>= defineLabel
-      -- objref lives somewhere on the argument stack
-      mov eax (Disp ((*4) $ fromIntegral $ length args), esp)
-      -- get method-table-ptr
-      mov eax (Disp 0, eax)
-      -- get method offset
-      let nameAndSig = methodname `B.append` encode msig
-      offset <- liftIO $ getMethodOffset objname nameAndSig
-      -- 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
-      invokeEpilog cpidx offset (`VirtualMethod` mi)
+    emit' (INVOKEINTERFACE cpidx _) = virtualCall cpidx True
+    emit' (INVOKEVIRTUAL cpidx) = virtualCall cpidx False
     emit' (PUTSTATIC cpidx) = do
       pop eax
       trapaddr <- getCurrentOffset
@@ -173,10 +169,32 @@ emitFromBB cls method = do
       mov eax (Addr 0x00000000) -- it's a trap
       push eax
       return $ Just (trapaddr, StaticField $ buildStaticFieldID cls cpidx)
+    emit' (INSTANCEOF cpidx) = do
+      pop eax
+      mov eax (Disp 0, eax) -- mtable of objectref
+      trapaddr <- getCurrentOffset
+      -- place something like `mov edx $mtable_of_objref' instead
+      emit32 (0x9090ffff :: Word32); nop
+      cmp eax edx
+      sete al
+      movzxb eax al
+      push eax
+      forceRegDump
+      return $ Just (trapaddr, InstanceOf $ buildClassID cls cpidx)
+    emit' (NEW objidx) = do
+      let objname = buildClassID cls objidx
+      trapaddr <- getCurrentOffset
+      -- place something like `push $objsize' instead
+      emit32 (0x9090ffff :: Word32); nop
+      callMalloc
+      -- 0x13371337 is just a placeholder; will be replaced with mtable ptr
+      mov (Disp 0, eax) (0x13371337 :: Word32)
+      return $ Just (trapaddr, NewObject objname)
+
     emit' insn = emit insn >> return Nothing
 
     emit :: J.Instruction -> CodeGen e s ()
-    emit POP = add esp (4 :: Word32) -- drop value
+    emit POP = add esp (ptrSize :: 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
@@ -218,7 +236,7 @@ emitFromBB cls method = do
       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
+      add eax (ptrSize :: Word32) -- for "length" entry
       -- push amount of bytes to allocate
       push eax
       callMalloc
@@ -226,20 +244,8 @@ emitFromBB cls method = do
       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
-      amount <- liftIO $ getObjectSize objname
-      push (amount :: Word32)
-      callMalloc
-      -- TODO(bernhard): save reference somewhere for GC
-      -- set method table pointer
-      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
@@ -343,19 +349,16 @@ emitFromBB cls method = do
     callMalloc :: CodeGen e s ()
     callMalloc = do
       call mallocObjectAddr
-      add esp (4 :: Word32)
+      add esp (ptrSize :: Word32)
       push eax
 
   -- for locals we use a different storage
   cArgs :: Word8 -> Word32
-  cArgs x =
-    if x' >= argcount
-    -- TODO(bernhard): maybe s/(-4)/(-8)/
-    then (-4) * (x' - argcount + 1)
-    else 4 + (argcount * 4) - (4 * x')
-      where
-        x' = fromIntegral x
-        argcount = rawArgCount method
+  cArgs x = ptrSize * (argcount - x' + isLocal)
+    where
+      x' = fromIntegral x
+      argcount = rawArgCount method
+      isLocal = if x' >= argcount then (-1) else 1
 
   cArgs_ :: IMM -> Word8
   cArgs_ x = case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
@@ -367,7 +370,3 @@ emitFromBB cls method = 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