From c8169c16f11efe17090cd221d0a3ebde6db50de5 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Fri, 17 Aug 2012 19:21:45 +0200 Subject: [PATCH] nativeMaschine: use NativeWord instead of Word32 --- Mate/ClassPool.hs | 17 ++++++++--------- Mate/MethodPool.hs | 10 +++++----- Mate/MethodPool.hs-boot | 8 ++++---- Mate/NativeMachine.hs | 3 ++- Mate/NativeSizes.hs | 4 +++- Mate/Strings.hs | 5 +++-- Mate/Types.hs | 21 +++++++++++---------- Mate/Utilities.hs | 3 ++- 8 files changed, 38 insertions(+), 33 deletions(-) diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs index 8874999..9064857 100644 --- a/Mate/ClassPool.hs +++ b/Mate/ClassPool.hs @@ -16,7 +16,6 @@ module Mate.ClassPool ( ) where import Data.Int -import Data.Word import Data.Binary import qualified Data.Map as M import qualified Data.Set as S @@ -80,18 +79,18 @@ getFieldOffset path field = do return $ ciFieldMap ci M.! field -- method + signature plz! -getMethodOffset :: B.ByteString -> B.ByteString -> IO Word32 +getMethodOffset :: B.ByteString -> B.ByteString -> IO NativeWord getMethodOffset path method = do ci <- getClassInfo path -- (+ ptrSize) one slot for "interface-table-ptr" return $ (+ ptrSize) $ fromIntegral $ ciMethodMap ci M.! method -getMethodTable :: B.ByteString -> IO Word32 +getMethodTable :: B.ByteString -> IO NativeWord getMethodTable path = do ci <- getClassInfo path return $ ciMethodBase ci -getObjectSize :: B.ByteString -> IO Word32 +getObjectSize :: B.ByteString -> IO NativeWord getObjectSize path = do ci <- getClassInfo path -- TODO(bernhard): correct sizes for different types... @@ -110,7 +109,7 @@ getStaticFieldAddr from = do _ -> error "getFieldAddr: no TrapCause found. abort" -- interface + method + signature plz! -getInterfaceMethodOffset :: B.ByteString -> B.ByteString -> B.ByteString -> IO Word32 +getInterfaceMethodOffset :: B.ByteString -> B.ByteString -> B.ByteString -> IO NativeWord getInterfaceMethodOffset ifname meth sig = do loadInterface ifname ifmmap <- getInterfaceMethodMap @@ -147,15 +146,15 @@ readClass path = do -- entries have the same offset), so we could -- save some memory here. iftable <- mallocClassData ((4*) $ M.size immap) - let w32_iftable = fromIntegral $ ptrToIntPtr iftable :: Word32 + let wn_iftable = fromIntegral $ ptrToIntPtr iftable :: NativeWord -- store interface-table at offset 0 in method-table - pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 w32_iftable + pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 wn_iftable printfCp "staticmap: %s @ %s\n" (show staticmap) (toString path) printfCp "fieldmap: %s @ %s\n" (show fieldmap) (toString path) printfCp "methodmap: %s @ %s\n" (show methodmap) (toString path) printfCp "mbase: 0x%08x\n" mbase printfCp "interfacemethod: %s @ %s\n" (show immap) (toString path) - printfCp "iftable: 0x%08x\n" w32_iftable + printfCp "iftable: 0x%08x\n" wn_iftable virtual_map <- getVirtualMap setVirtualMap $ M.insert mbase path virtual_map @@ -230,7 +229,7 @@ getsupermap :: Maybe ClassInfo -> (ClassInfo -> FieldMap) -> FieldMap getsupermap superclass getter = case superclass of Just x -> getter x; Nothing -> M.empty -calculateMethodMap :: Class Direct -> Maybe ClassInfo -> IO (FieldMap, Word32) +calculateMethodMap :: Class Direct -> Maybe ClassInfo -> IO (FieldMap, NativeWord) calculateMethodMap cf superclass = do let methods = filter (\x -> (not . S.member ACC_STATIC . methodAccessFlags) x && diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index f0465d6..0b11d3d 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -102,7 +102,7 @@ lookupMethodRecursive name sig clsnames cls = foreign import ccall safe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) -loadNativeFunction :: String -> IO Word32 +loadNativeFunction :: String -> IO NativeWord loadNativeFunction sym = do _ <- loadRawObject "ffi/native.o" -- TODO(bernhard): WTF @@ -115,20 +115,20 @@ loadNativeFunction sym = do -- t_01 :: IO () -- t_01 = do -- (entry, _) <- testCase "./tests/Fib.class" "fib" --- let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32) +-- let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: NativeWord) -- let mmap = M.insert ("fib" :: String) int_entry M.empty -- mapM_ (\(x,y) -> printf "%s at 0x%08x\n" x y) $ M.toList mmap -- mmap2ptr mmap >>= set_mmap -- demo_mmap -- access Data.Map from C -addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO () +addMethodRef :: NativeWord -> MethodInfo -> [B.ByteString] -> IO () addMethodRef entry (MethodInfo mmname _ msig) clsnames = do mmap <- getMethodMap let newmap = foldr (\i -> M.insert (MethodInfo mmname i msig) entry) M.empty clsnames setMethodMap $ mmap `M.union` newmap -compileBB :: RawMethod -> MethodInfo -> IO Word32 +compileBB :: RawMethod -> MethodInfo -> IO NativeWord compileBB rawmethod methodinfo = do tmap <- getTrapMap @@ -155,6 +155,6 @@ compileBB rawmethod methodinfo = do return $ fromIntegral $ ptrToIntPtr entry -executeFuncPtr :: Word32 -> IO () +executeFuncPtr :: NativeWord -> IO () executeFuncPtr entry = code_void ((castPtrToFunPtr $ intPtrToPtr $ fromIntegral entry) :: FunPtr (IO ())) diff --git a/Mate/MethodPool.hs-boot b/Mate/MethodPool.hs-boot index 7efca9c..0527cd7 100644 --- a/Mate/MethodPool.hs-boot +++ b/Mate/MethodPool.hs-boot @@ -2,14 +2,14 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Mate.MethodPool where -import Data.Binary import qualified Data.ByteString.Lazy as B import Mate.Types +import Mate.NativeSizes import Foreign.C.Types -addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO () -compileBB :: RawMethod -> MethodInfo -> IO Word32 -executeFuncPtr :: Word32 -> IO () +addMethodRef :: NativeWord -> MethodInfo -> [B.ByteString] -> IO () +compileBB :: RawMethod -> MethodInfo -> IO NativeWord +executeFuncPtr :: NativeWord -> IO () getMethodEntry :: CPtrdiff -> CPtrdiff -> IO CPtrdiff diff --git a/Mate/NativeMachine.hs b/Mate/NativeMachine.hs index 542cc15..51e1bdf 100644 --- a/Mate/NativeMachine.hs +++ b/Mate/NativeMachine.hs @@ -3,7 +3,8 @@ module Mate.NativeMachine( emitFromBB, mateHandler, register_signal, - ptrSize, longSize + ptrSize, longSize, + NativeWord )where #ifdef i386_HOST_ARCH diff --git a/Mate/NativeSizes.hs b/Mate/NativeSizes.hs index b6d9286..07c4371 100644 --- a/Mate/NativeSizes.hs +++ b/Mate/NativeSizes.hs @@ -2,8 +2,10 @@ module Mate.NativeSizes where import Data.Word -ptrSize, longSize :: Word32 +ptrSize, longSize :: NativeWord #ifdef i386_HOST_ARCH ptrSize = 4 longSize = 8 + +type NativeWord = Word32 #endif diff --git a/Mate/Strings.hs b/Mate/Strings.hs index f41f022..05f6c50 100644 --- a/Mate/Strings.hs +++ b/Mate/Strings.hs @@ -19,12 +19,13 @@ import Foreign import Foreign.C.Types import Mate.Types +import Mate.NativeSizes import Mate.ClassPool import Mate.Debug import Mate.GarbageAlloc -getUniqueStringAddr :: B.ByteString -> IO Word32 +getUniqueStringAddr :: B.ByteString -> IO NativeWord getUniqueStringAddr str = do smap <- getStringMap case M.lookup str smap of @@ -34,7 +35,7 @@ getUniqueStringAddr str = do return addr Just addr -> return addr -allocateJavaString :: B.ByteString -> IO Word32 +allocateJavaString :: B.ByteString -> IO NativeWord allocateJavaString str = do {- we have to build a java object layout here, where String object looks like - diff --git a/Mate/Types.hs b/Mate/Types.hs index 831744a..b1fc6de 100644 --- a/Mate/Types.hs +++ b/Mate/Types.hs @@ -2,7 +2,6 @@ {-# LANGUAGE CPP #-} module Mate.Types where -import Data.Word import Data.Int import qualified Data.Map as M import qualified Data.ByteString.Lazy as B @@ -13,6 +12,8 @@ import System.IO.Unsafe import JVM.ClassFile import JVM.Assembler +import Mate.NativeSizes + type BlockID = Int -- Represents a CFG node @@ -29,12 +30,12 @@ data RawMethod = RawMethod { rawMapBB :: MapBB, rawLocals :: Int, rawStackSize :: Int, - rawArgCount :: Word32 } + rawArgCount :: NativeWord } --- Word32 = point of method call in generated code +-- NativeWord = point of method call in generated code -- MethodInfo = relevant information about callee -type TrapMap = M.Map Word32 TrapCause +type TrapMap = M.Map NativeWord TrapCause data TrapCause = StaticMethod MethodInfo | -- for static calls @@ -51,8 +52,8 @@ data StaticFieldInfo = StaticFieldInfo { -- B.ByteString = name of method --- Word32 = entrypoint of method -type MethodMap = M.Map MethodInfo Word32 +-- NativeWord = entrypoint of method +type MethodMap = M.Map MethodInfo NativeWord data MethodInfo = MethodInfo { methName :: B.ByteString, @@ -75,7 +76,7 @@ data ClassInfo = ClassInfo { ciStaticMap :: FieldMap, ciFieldMap :: FieldMap, ciMethodMap :: FieldMap, - ciMethodBase :: Word32, + ciMethodBase :: NativeWord, ciInitDone :: Bool } @@ -85,20 +86,20 @@ type FieldMap = M.Map B.ByteString Int32 -- java strings are allocated only once, therefore we -- use a hashmap to store the address for a String -type StringMap = M.Map B.ByteString Word32 +type StringMap = M.Map B.ByteString NativeWord -- map "methodtable addr" to "classname" -- we need that to identify the actual type -- on the invokevirtual insn -type VirtualMap = M.Map Word32 B.ByteString +type VirtualMap = M.Map NativeWord B.ByteString -- store each parsed Interface upon first loading type InterfaceMap = M.Map B.ByteString (Class Direct) -- store offset for each pair -type InterfaceMethodMap = M.Map B.ByteString Word32 +type InterfaceMethodMap = M.Map B.ByteString NativeWord {- diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs index da07ecf..612bbf4 100644 --- a/Mate/Utilities.hs +++ b/Mate/Utilities.hs @@ -12,6 +12,7 @@ import Data.Maybe import JVM.ClassFile import Mate.Types +import Mate.NativeSizes buildMethodID :: Class Direct -> Word16 -> MethodInfo @@ -41,7 +42,7 @@ methodNameTypeByIdx cls idx = case constsPool cls M.! idx of (CIfaceMethod _ nt') -> nt' _ -> error "methodGetArgsCount: something wrong. abort." -methodGetArgsCount :: NameType (Method Direct) -> Word32 +methodGetArgsCount :: NameType (Method Direct) -> NativeWord methodGetArgsCount nt = genericLength args where (MethodSignature args _) = ntSignature nt -- 2.25.1