debug: use #ifdef guards

[mate.git] / Mate / X86CodeGen.hs

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 1eb9057f7eb1dd559f67a6631b90841dd26ced1b..15397fada7e3f9af50db97fad0dddcaf2d02fb95 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,7 +15,9 @@ import Control.Monad
 import Foreign hiding (xor)
 import Foreign.C.Types
 
+#ifdef DEFINE
 import Text.Printf
+#endif
 
 import qualified JVM.Assembler as J
 import JVM.Assembler hiding (Instruction)
@@ -33,9 +36,6 @@ 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
 
@@ -45,73 +45,6 @@ foreign import ccall "callertrap"
 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
@@ -119,7 +52,7 @@ type PatchInfo = (BlockID, EntryPointOffset)
 
 type BBStarts = M.Map BlockID Int
 
-type CompileInfo = (EntryPoint, BBStarts, Int, TMap)
+type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
 
 
 emitFromBB :: B.ByteString -> Class Resolved -> MapBB -> CodeGen e s (CompileInfo, [Instruction])
@@ -142,7 +75,7 @@ emitFromBB method cls hmap =  do
   getLabel _ [] = error "label not found!"
   getLabel i ((x,l):xs) = if i==x then l else getLabel i xs
 
-  efBB :: (BlockID, BasicBlock) -> TMap -> BBStarts -> [(BlockID, Label)] -> CodeGen e s (TMap, BBStarts)
+  efBB :: (BlockID, BasicBlock) -> TrapMap -> BBStarts -> [(BlockID, Label)] -> CodeGen e s (TrapMap, BBStarts)
   efBB (bid, bb) calls bbstarts lmap =
         if M.member bid bbstarts then
           return (calls, bbstarts)
@@ -226,12 +159,7 @@ 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
@@ -270,7 +198,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