nativeMachine: use constants
authorBernhard Urban <lewurm@gmail.com>
Thu, 2 Aug 2012 19:37:24 +0000 (21:37 +0200)
committerBernhard Urban <lewurm@gmail.com>
Thu, 2 Aug 2012 13:40:56 +0000 (15:40 +0200)
- rename NativeMaSchine to NativeMachine
- new module for constants in order to avoid module cycles

Mate.hs
Mate/ClassPool.hs
Mate/MethodPool.hs
Mate/NativeMachine.hs [new file with mode: 0644]
Mate/NativeMaschine.hs [deleted file]
Mate/NativeSizes.hs [new file with mode: 0644]
Mate/X86CodeGen.hs

diff --git a/Mate.hs b/Mate.hs
index ee03d8d78ad1b3dfb19f766ae813d062f000c305..1321104a20fdbbf4c80b2cc848ec3c46ccf8ec77 100644 (file)
--- a/Mate.hs
+++ b/Mate.hs
@@ -20,7 +20,7 @@ import Mate.BasicBlocks
 import Mate.MethodPool
 import Mate.Types
 import Mate.ClassPool
-import Mate.NativeMaschine
+import Mate.NativeMachine
 
 main ::  IO ()
 main = do
index 58ba6c7a6080742870fbd352adeebf5bf24882cd..e6c5bfef8d333b2650755be78844b47021ff8809 100644 (file)
@@ -49,6 +49,7 @@ import {-# SOURCE #-} Mate.MethodPool
 import Mate.Types
 import Mate.Debug
 import Mate.GarbageAlloc
+import Mate.NativeSizes
 
 getClassInfo :: B.ByteString -> IO ClassInfo
 getClassInfo path = do
@@ -76,8 +77,8 @@ getFieldOffset path field = do
 getMethodOffset :: B.ByteString -> B.ByteString -> IO Word32
 getMethodOffset path method = do
   ci <- getClassInfo path
-  -- (4+) one slot for "interface-table-ptr"
-  return $ (+4) $ fromIntegral $ ciMethodMap ci M.! method
+  -- (+ ptrSize) one slot for "interface-table-ptr"
+  return $ (+ ptrSize) $ fromIntegral $ ciMethodMap ci M.! method
 
 getMethodTable :: B.ByteString -> IO Word32
 getMethodTable path = do
@@ -90,7 +91,7 @@ getObjectSize path = do
   -- TODO(bernhard): correct sizes for different types...
   let fsize = fromIntegral $ M.size $ ciFieldMap ci
   -- one slot for "method-table-ptr"
-  return $ (1 + fsize) * 4
+  return $ (1 + fsize) * ptrSize
 
 getStaticFieldAddr :: CPtrdiff -> IO CPtrdiff
 getStaticFieldAddr from = do
index 23ff49b6439757bbb590e63a411ded2de631f7bd..f0465d6e7e584e0682f738ceeb9790e801f59bb3 100644 (file)
@@ -26,7 +26,7 @@ import Text.Printf
 
 import Mate.BasicBlocks
 import Mate.Types
-import Mate.NativeMaschine
+import Mate.NativeMachine
 import Mate.ClassPool
 import Mate.Debug
 import Mate.Utilities
diff --git a/Mate/NativeMachine.hs b/Mate/NativeMachine.hs
new file mode 100644 (file)
index 0000000..542cc15
--- /dev/null
@@ -0,0 +1,16 @@
+{-# LANGUAGE CPP #-}
+module Mate.NativeMachine(
+  emitFromBB,
+  mateHandler,
+  register_signal,
+  ptrSize, longSize
+  )where
+
+#ifdef i386_HOST_ARCH
+import Mate.X86CodeGen
+import Mate.X86TrapHandling
+import Mate.NativeSizes
+
+#else
+#error "no other arch supported yet :/"
+#endif
diff --git a/Mate/NativeMaschine.hs b/Mate/NativeMaschine.hs
deleted file mode 100644 (file)
index e32cecc..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE CPP #-}
-module Mate.NativeMaschine(
-  emitFromBB,
-  mateHandler,
-  register_signal,
-  wordSize
-  )where
-
-#ifdef i386_HOST_ARCH
-import Mate.X86CodeGen
-import Mate.X86TrapHandling
-
-wordSize :: Int
-wordSize = 4
-
-#else
-#error "no other arch supported yet :/"
-#endif
diff --git a/Mate/NativeSizes.hs b/Mate/NativeSizes.hs
new file mode 100644 (file)
index 0000000..b6d9286
--- /dev/null
@@ -0,0 +1,9 @@
+module Mate.NativeSizes where
+
+import Data.Word
+
+ptrSize, longSize :: Word32
+#ifdef i386_HOST_ARCH
+ptrSize = 4
+longSize = 8
+#endif
index b2de573f619ad09672aec54e63b0ca6530e3f1f7..8f2bbfb4af28f1cdddff71d005a04f2a6ce48ac9 100644 (file)
@@ -24,6 +24,7 @@ import Harpy
 import Harpy.X86Disassembler
 
 import Mate.BasicBlocks
+import Mate.NativeSizes
 import Mate.Types
 import Mate.Utilities
 import Mate.ClassPool
@@ -53,7 +54,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
@@ -106,7 +107,7 @@ emitFromBB 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 $ 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)
@@ -118,8 +119,8 @@ emitFromBB 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 $ methodNameTypeByIdx 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)
@@ -137,7 +138,7 @@ emitFromBB 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
@@ -153,7 +154,7 @@ emitFromBB 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
@@ -176,7 +177,7 @@ emitFromBB 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
@@ -218,7 +219,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
@@ -343,19 +344,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