From 33fee81a6dc52f54beda6819c95e7e4571613ea6 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Thu, 2 Aug 2012 21:37:24 +0200 Subject: [PATCH] nativeMachine: use constants - rename NativeMaSchine to NativeMachine - new module for constants in order to avoid module cycles --- Mate.hs | 2 +- Mate/ClassPool.hs | 7 +++-- Mate/MethodPool.hs | 2 +- Mate/{NativeMaschine.hs => NativeMachine.hs} | 8 ++--- Mate/NativeSizes.hs | 9 ++++++ Mate/X86CodeGen.hs | 32 +++++++++----------- 6 files changed, 33 insertions(+), 27 deletions(-) rename Mate/{NativeMaschine.hs => NativeMachine.hs} (74%) create mode 100644 Mate/NativeSizes.hs diff --git a/Mate.hs b/Mate.hs index ee03d8d..1321104 100644 --- 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 diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs index 58ba6c7..e6c5bfe 100644 --- a/Mate/ClassPool.hs +++ b/Mate/ClassPool.hs @@ -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 diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index 23ff49b..f0465d6 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -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/NativeMaschine.hs b/Mate/NativeMachine.hs similarity index 74% rename from Mate/NativeMaschine.hs rename to Mate/NativeMachine.hs index e32cecc..542cc15 100644 --- a/Mate/NativeMaschine.hs +++ b/Mate/NativeMachine.hs @@ -1,17 +1,15 @@ {-# LANGUAGE CPP #-} -module Mate.NativeMaschine( +module Mate.NativeMachine( emitFromBB, mateHandler, register_signal, - wordSize + ptrSize, longSize )where #ifdef i386_HOST_ARCH import Mate.X86CodeGen import Mate.X86TrapHandling - -wordSize :: Int -wordSize = 4 +import Mate.NativeSizes #else #error "no other arch supported yet :/" diff --git a/Mate/NativeSizes.hs b/Mate/NativeSizes.hs new file mode 100644 index 0000000..b6d9286 --- /dev/null +++ b/Mate/NativeSizes.hs @@ -0,0 +1,9 @@ +module Mate.NativeSizes where + +import Data.Word + +ptrSize, longSize :: Word32 +#ifdef i386_HOST_ARCH +ptrSize = 4 +longSize = 8 +#endif diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index b2de573..8f2bbfb 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -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 -- 2.25.1