refactor: trap.c

[mate.git] / Mate / X86CodeGen.hs

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index d95358c959440d0acab0d5a016b09b4fa6834f1a..9f68c659f2087004e3c2dbff8e2ee08ba28f246c 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Mate.X86CodeGen where
@@ -14,8 +15,6 @@ import Control.Monad
 import Foreign hiding (xor)
 import Foreign.C.Types
 
-import Text.Printf
-
 import qualified JVM.Assembler as J
 import JVM.Assembler hiding (Instruction)
 import JVM.ClassFile
@@ -33,85 +32,12 @@ import Mate.Strings
 foreign import ccall "dynamic"
    code_int :: FunPtr (CInt -> CInt -> IO CInt) -> (CInt -> CInt -> IO CInt)
 
-foreign import ccall "getaddr"
-  getaddr :: CUInt
-
 foreign import ccall "getMallocAddr"
   getMallocAddr :: CUInt
 
-foreign import ccall "callertrap"
-  callertrap :: IO ()
-
 foreign import ccall "register_signal"
   register_signal :: IO ()
 
-test_01, test_02, test_03 :: IO ()
-test_01 = do
-  register_signal
-  (entry, end) <- testCase "./tests/Fib" "fib"
-  let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
-
-  mapM_ (\x -> do
-    result <- code_int entryFuncPtr x 0
-    let iresult :: Int; iresult = fromIntegral result
-    let kk :: String; kk = if iresult == (fib x) then "OK" else "FAIL (" ++ (show (fib x)) ++ ")"
-    printf "result of fib(%2d): %3d\t\t%s\n" (fromIntegral x :: Int) iresult kk
-    ) $ ([0..10] :: [CInt])
-  printf "patched disasm:\n"
-  Right newdisasm <- disassembleBlock entry end
-  mapM_ (putStrLn . showAtt) newdisasm
-  where
-    fib :: CInt -> Int
-    fib n
-      | n <= 1 = 1
-      | otherwise = (fib (n - 1)) + (fib (n - 2))
-
-
-test_02 = do
-  (entry,_) <- testCase "./tests/While" "f"
-  let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
-  result <- code_int entryFuncPtr 5 4
-  let iresult :: Int; iresult = fromIntegral result
-  let kk :: String; kk = if iresult == 15 then "OK" else "FAIL"
-  printf "result of f(5,4): %3d\t\t%s\n" iresult kk
-
-  result2 <- code_int entryFuncPtr 4 3
-  let iresult2 :: Int; iresult2 = fromIntegral result2
-  let kk2 :: String; kk2 = if iresult2 == 10 then "OK" else "FAIL"
-  printf "result of f(4,3): %3d\t\t%s\n" iresult2 kk2
-
-
-test_03 = do
-  (entry,_) <- testCase "./tests/While" "g"
-  let entryFuncPtr = ((castPtrToFunPtr entry) :: FunPtr (CInt -> CInt -> IO CInt))
-  result <- code_int entryFuncPtr 5 4
-  let iresult :: Int; iresult = fromIntegral result
-  let kk :: String; kk = if iresult == 15 then "OK" else "FAIL"
-  printf "result of g(5,4): %3d\t\t%s\n" iresult kk
-
-  result2 <- code_int entryFuncPtr 4 3
-  let iresult2 :: Int; iresult2 = fromIntegral result2
-  let kk2 :: String; kk2 = if iresult2 == 10 then "OK" else "FAIL"
-  printf "result of g(4,3): %3d\t\t%s\n" iresult2 kk2
-
-
-testCase :: B.ByteString -> B.ByteString -> IO (Ptr Word8, Int)
-testCase cf method = do
-      cls <- getClassFile cf
-      hmap <- parseMethod cls method
-      printMapBB hmap
-      case hmap of
-        Nothing -> error "sorry, no code generation"
-        Just hmap' -> do
-              let ebb = emitFromBB method cls hmap'
-              (_, Right ((entry, bbstarts, end, _), disasm)) <- runCodeGen ebb () ()
-              let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Int)
-              printf "disasm:\n"
-              mapM_ (putStrLn . showAtt) disasm
-              printf "basicblocks addresses:\n"
-              let b = map (\(x,y) -> (x,y + int_entry)) $ M.toList bbstarts
-              mapM_ (\(x,y) -> printf "\tBasicBlock %2d starts at 0x%08x\n" x y) b
-              return (entry, end)
 
 type EntryPoint = Ptr Word8
 type EntryPointOffset = Int
@@ -190,6 +116,30 @@ emitFromBB method cls hmap =  do
     emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapInfo))
     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)
+        -- make actual (indirect) call
+        calladdr <- getCurrentOffset
+        call (Disp offset, ebx)
+        -- discard arguments on stack (+4 for "this")
+        let argcnt = 4 + ((methodGetArgsCount cls cpidx) * 4)
+        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.
+        -- we figure that out at run-time, in the methodpool,
+        -- depending on the method-table-ptr
+        return $ Just $ (calladdr, II mi)
     emit' (INVOKEVIRTUAL cpidx) = do
         -- get methodInfo entry
         let mi@(MethodInfo methodname objname msig@(MethodSignature args _))  = buildMethodID cls cpidx
@@ -265,7 +215,7 @@ emitFromBB method cls hmap =  do
         push eax -- push ref again
     emit (NEW objidx) = do
         let objname = buildClassID cls objidx
-        amount <- liftIO $ getMethodSize objname
+        amount <- liftIO $ getObjectSize objname
         push (amount :: Word32)
         callMalloc
         -- TODO(bernhard): save reference somewhere for GC