debugmode: no maybe anymore

[mate.git] / Mate / X86CodeGen.hs

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 6517d9c84d0e1668b3819c4394e443b195db2293..6def8de41da1f5d8bafee84acce33cd413297dda 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -10,7 +10,6 @@ import Data.BinaryState
 import Data.Int
 import Data.Maybe
 import qualified Data.Map as M
-import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as B
 import Control.Monad
 
@@ -25,6 +24,7 @@ import Harpy
 import Harpy.X86Disassembler
 
 import Mate.BasicBlocks
+import Mate.NativeSizes
 import Mate.Types
 import Mate.Utilities
 import Mate.ClassPool
@@ -35,7 +35,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
@@ -46,15 +46,15 @@ type BBStarts = M.Map BlockID Int
 type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
 
 
-emitFromBB :: B.ByteString -> MethodSignature -> Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
-emitFromBB methodname sig cls method = do
+emitFromBB :: Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
+emitFromBB cls method = do
     let keys = M.keys hmap
     llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
     let lmap = zip keys llmap
     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
@@ -107,7 +107,7 @@ emitFromBB methodname sig cls method = do
       -- place a nop at the end, therefore the disasm doesn't screw up
       emit32 (0xffff9090 :: Word32) >> emit8 (0x90 :: Word8)
       -- discard arguments on stack
-      let argcnt = ((if hasThis then 1 else 0) + methodGetArgsCount 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)
@@ -119,8 +119,8 @@ emitFromBB methodname sig cls method = 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
+      -- 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)
@@ -138,7 +138,7 @@ emitFromBB methodname sig cls method = do
       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)
+      mov eax (Disp ((* ptrSize) $ fromIntegral $ length args), esp)
       -- get method-table-ptr, keep it in eax (for trap handling)
       mov eax (Disp 0, eax)
       -- get interface-table-ptr
@@ -154,7 +154,7 @@ emitFromBB methodname sig cls method = do
       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)
+      mov eax (Disp ((* ptrSize) $ fromIntegral $ length args), esp)
       -- get method-table-ptr
       mov eax (Disp 0, eax)
       -- get method offset
@@ -177,7 +177,7 @@ emitFromBB methodname sig cls method = do
     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
@@ -219,7 +219,7 @@ emitFromBB methodname sig 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
@@ -344,30 +344,20 @@ emitFromBB methodname sig 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' >= thisMethodArgCnt
-    -- TODO(bernhard): maybe s/(-4)/(-8)/
-    then fromIntegral $ (-4) * (x' - thisMethodArgCnt + 1)
-    else 4 + (thisMethodArgCnt * 4) - (4 * x')
-      where x' = fromIntegral x
+  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
 
-  -- TODO: factor this out to `compileBB'
-  thisMethodArgCnt :: Word32
-  thisMethodArgCnt = isNonStatic + fromIntegral (length args)
-    where
-      m = fromJust $ lookupMethodSig methodname sig cls
-      (MethodSignature args _) = sig
-      isNonStatic = if S.member ACC_STATIC (methodAccessFlags m)
-          then 0 else 1 -- one argument for the this pointer
-
 
   -- sign extension from w8 to w32 (over s8)
   --   unfortunately, hs-java is using Word8 everywhere (while