codegen: fix bug in calling conv

[mate.git] / Mate / X86CodeGen.hs

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index ccaee0eef77a3676542021a44138afd723a88b70..572008473113eae4679d08a9ce1e5a0486ebfbcb 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -17,7 +17,6 @@ import Text.Printf
 import qualified JVM.Assembler as J
 import JVM.Assembler hiding (Instruction)
 import JVM.ClassFile
-import JVM.Converter
 
 import Harpy
 import Harpy.X86Disassembler
@@ -97,7 +96,7 @@ testCase cf method = do
       case hmap of
         Nothing -> error "sorry, no code generation"
         Just hmap' -> do
-              let ebb = emitFromBB cls hmap'
+              let ebb = emitFromBB method cls hmap'
               (_, Right ((entry, bbstarts, end, _), disasm)) <- runCodeGen ebb () ()
               let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Int)
               printf "disasm:\n"
@@ -116,13 +115,16 @@ type BBStarts = M.Map BlockID Int
 type CompileInfo = (EntryPoint, BBStarts, Int, TMap)
 
 
-emitFromBB :: Class Resolved -> MapBB -> CodeGen e s (CompileInfo, [Instruction])
-emitFromBB cls hmap =  do
+emitFromBB :: B.ByteString -> Class Resolved -> MapBB -> CodeGen e s (CompileInfo, [Instruction])
+emitFromBB method cls hmap =  do
         llmap <- sequence [newNamedLabel ("bb_" ++ show x) | (x,_) <- M.toList hmap]
         let lmap = zip (Prelude.fst $ unzip $ M.toList hmap) llmap
         ep <- getEntryPoint
         push ebp
         mov ebp esp
+        -- TODO(bernhard): determine a reasonable value.
+        --                 e.g. (locals used) * 4
+        sub esp (0x60 :: Word32)
 
         (calls, bbstarts) <- efBB (0,(hmap M.! 0)) M.empty M.empty lmap
         d <- disassemble
@@ -156,13 +158,17 @@ emitFromBB cls hmap =  do
     -- TODO(bernhard): implement `emit' as function which accepts a list of
     --                 instructions, so we can use patterns for optimizations
     where
+    getCurrentOffset :: CodeGen e s (Word32)
+    getCurrentOffset = do
+      ep <- getEntryPoint
+      let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
+      offset <- getCodeOffset
+      return $ w32_ep + (fromIntegral offset)
+
     emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapInfo))
     emit' (INVOKESTATIC cpidx) = do
-        ep <- getEntryPoint
-        let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
         let l = buildMethodID cls cpidx
-        calladdr <- getCodeOffset
-        let w32_calladdr = w32_ep + (fromIntegral calladdr) :: Word32
+        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
@@ -172,16 +178,24 @@ emitFromBB cls hmap =  do
         when (argcnt > 0) (add esp argcnt)
         -- push result on stack if method has a return value
         when (methodHaveReturnValue cls cpidx) (push eax)
-        return $ Just $ (w32_calladdr, MI l)
+        return $ Just $ (calladdr, MI l)
+    emit' (PUTSTATIC cpidx) = do
+        pop eax
+        trapaddr <- getCurrentOffset
+        mov (Addr 0x00000000) eax -- it's a trap
+        return $ Just $ (trapaddr, SFI $ buildFieldID cls cpidx)
+    emit' (GETSTATIC cpidx) = do
+        trapaddr <- getCurrentOffset
+        mov eax (Addr 0x00000000) -- it's a trap
+        push eax
+        return $ Just $ (trapaddr, SFI $ buildFieldID cls cpidx)
     emit' insn = emit insn >> return Nothing
 
     emit :: J.Instruction -> CodeGen e s ()
     emit POP = do -- print dropped value
-        ep <- getEntryPoint
-        let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
+        calladdr <- getCurrentOffset
         -- '5' is the size of the `call' instruction ( + immediate)
-        calladdr <- getCodeOffset
-        let w32_calladdr = 5 + w32_ep + (fromIntegral calladdr) :: Word32
+        let w32_calladdr = 5 + calladdr
         let trapaddr = (fromIntegral getaddr :: Word32)
         call (trapaddr - w32_calladdr)
         add esp (4 :: Word32)
@@ -194,9 +208,14 @@ emitFromBB cls hmap =  do
     emit (ICONST_5) = push (5 :: Word32)
     emit (ILOAD_ x) = do
         push (Disp (cArgs_ x), ebp)
+    emit (ILOAD x) = do
+        push (Disp (cArgs x), ebp)
     emit (ISTORE_ x) = do
         pop eax
         mov (Disp (cArgs_ x), ebp) eax
+    emit (ISTORE x) = do
+        pop eax
+        mov (Disp (cArgs x), ebp) eax
     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
@@ -236,8 +255,22 @@ emitFromBB cls hmap =  do
         ret
     emit invalid = error $ "insn not implemented yet: " ++ (show invalid)
 
-  cArgs x = (8 + 4 * (fromIntegral x))
-  cArgs_ x = (8 + 4 * case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3)
+  -- 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 8 + (4 * x')
+    where x' = fromIntegral x
+
+  cArgs_ :: IMM -> Word32
+  cArgs_ x = cArgs $ case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
+
+  thisMethodArgCnt :: Word32
+  thisMethodArgCnt = fromIntegral $ length args
+    where
+    (Just m) = lookupMethod method cls
+    (MethodSignature args _) = methodSignature m
 
   -- sign extension from w8 to w32 (over s8)
   --   unfortunately, hs-java is using Word8 everywhere (while