Wall: remove some warnings

[mate.git] / Mate / ClassPool.hs

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index ad290542d7167c57b8a4a9b29efbd149d71d212b..dde77e778599327620a8ee423ed3795ab6d7b611 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -3,6 +3,7 @@
 #include "debug.h"
 module Mate.ClassPool (
   getClassInfo,
+  classLoaded,
   getClassFile,
   getMethodTable,
   getObjectSize,
@@ -15,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
@@ -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
@@ -57,12 +58,17 @@ getClassInfo path = do
     Nothing -> loadAndInitClass path
     Just ci -> return ci
 
+classLoaded :: B.ByteString -> IO Bool
+classLoaded path = do
+  class_map <- getClassMap
+  return $ M.member path class_map
+
 getClassFile :: B.ByteString -> IO (Class Direct)
 getClassFile path = do
   ci <- getClassInfo path
   return $ ciFile ci
 
-getStaticFieldOffset :: B.ByteString -> B.ByteString -> IO CUInt
+getStaticFieldOffset :: B.ByteString -> B.ByteString -> IO CPtrdiff
 getStaticFieldOffset path field = do
   ci <- getClassInfo path
   return $ fromIntegral $ ciStaticMap ci M.! field
@@ -73,26 +79,26 @@ 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
-  -- (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 :: 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...
   let fsize = fromIntegral $ M.size $ ciFieldMap ci
   -- one slot for "method-table-ptr"
-  return $ (1 + fsize) * 4
+  return $ (1 + fsize) * ptrSize
 
-getStaticFieldAddr :: CUInt -> IO CUInt
+getStaticFieldAddr :: CPtrdiff -> IO CPtrdiff
 getStaticFieldAddr from = do
   trapmap <- getTrapMap
   let w32_from = fromIntegral from
@@ -103,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
@@ -140,15 +146,18 @@ 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
-      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
+      pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 wn_iftable
+#ifdef DBG_CLASS
+      let strpath = toString path
+      hexDumpMap ("staticmap @ " ++ strpath) staticmap
+      hexDumpMap ("fieldmap @ " ++ strpath) fieldmap
+      hexDumpMap ("methodmap @ " ++ strpath) methodmap
+      hexDumpMap ("interfacemap @ " ++ strpath) immap
+#endif
+      printfCp "mbase:   0x%08x\n" mbase
+      printfCp "iftable: 0x%08x\n" wn_iftable
       virtual_map <- getVirtualMap
       setVirtualMap $ M.insert mbase path virtual_map
 
@@ -223,7 +232,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 &&