gc: factor out allocation

in order to have central place when starting with garbage collection.

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index 710b6a57239afc6af43e1926a291dbd605d8ba10..1f7d7858a63b2cfb6b260249cb4716042ebeb0e1 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -30,7 +30,6 @@ import JVM.Dump
 
 import Foreign.Ptr
 import Foreign.C.Types
-import Foreign.Marshal.Alloc
 import Foreign.Storable
 
 import JVM.ClassFile
@@ -41,6 +40,7 @@ import {-# SOURCE #-} Mate.MethodPool
 import Mate.Types
 import Mate.Utilities
 import Mate.Debug
+import Mate.GarbageAlloc
 
 getClassInfo :: B.ByteString -> IO ClassInfo
 getClassInfo path = do
@@ -129,7 +129,7 @@ loadClass path = do
   -- TODO(bernhard): we have some duplicates in immap (i.e. some
   --                 entries have the same offset), so we could
   --                 save some memory here.
-  iftable <- mallocBytes ((4*) $ M.size immap)
+  iftable <- mallocClassData ((4*) $ M.size immap)
   let w32_iftable = fromIntegral $ ptrToIntPtr iftable :: Word32
   -- store interface-table at offset 0 in method-table
   pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 w32_iftable
@@ -195,7 +195,7 @@ calculateFields cf superclass = do
 
     let (sfields, ifields) = span (S.member ACC_STATIC . fieldAccessFlags) (classFields cf)
 
-    staticbase <- mallocBytes ((fromIntegral $ length sfields) * 4)
+    staticbase <- mallocClassData ((fromIntegral $ length sfields) * 4)
     let i_sb = fromIntegral $ ptrToIntPtr $ staticbase
     let sm = zipbase i_sb sfields
     let sc_sm = getsupermap superclass ciStaticMap
@@ -230,7 +230,7 @@ calculateMethodMap cf superclass = do
     let methodmap = (M.fromList mm) `M.union` sc_mm
 
     -- (+1): one slot for the interface-table-ptr
-    methodbase <- mallocBytes (((+1) $ fromIntegral $ M.size methodmap) * 4)
+    methodbase <- mallocClassData (((+1) $ fromIntegral $ M.size methodmap) * 4)
     return (methodmap, fromIntegral $ ptrToIntPtr $ methodbase)
   where zipbase base = zipWith (\x y -> (entry y, x + base)) [0,4..]
           where entry y = (methodName y) `B.append` (encode $ methodSignature y)

diff --git a/Mate/GarbageAlloc.hs b/Mate/GarbageAlloc.hs
new file mode 100644 (file)
index 0000000..f5b1093
--- /dev/null
+++ b/Mate/GarbageAlloc.hs
@@ -0,0 +1,19 @@
+module Mate.GarbageAlloc where
+
+import Foreign
+import Foreign.C
+
+-- unified place for allocating Memory
+-- TODO: implement GC stuff ;-)
+
+mallocClassData :: Int -> IO (Ptr a)
+mallocClassData = mallocBytes
+
+mallocString :: Int -> IO (Ptr a)
+mallocString = mallocBytes
+
+foreign export ccall mallocObject :: Int -> IO CUInt
+mallocObject :: Int -> IO CUInt
+mallocObject size = do
+  ptr <- mallocBytes size
+  return $ fromIntegral $ ptrToIntPtr ptr

diff --git a/Mate/Strings.hs b/Mate/Strings.hs
index fb7f0afb298184559606ebdc06e30f2a9ab9566e..6e541814e7645247ee0f2a638d61fe7cd4a31aab 100644 (file)
--- a/Mate/Strings.hs
+++ b/Mate/Strings.hs
@@ -15,12 +15,12 @@ import Text.Printf
 #endif
 
 import Foreign.Ptr
-import Foreign.Marshal.Alloc
 import Foreign.Marshal.Utils
 import Foreign.Marshal.Array
 
 import Mate.Types
 import Mate.Debug
+import Mate.GarbageAlloc
 
 
 getUniqueStringAddr :: B.ByteString -> IO Word32
@@ -40,7 +40,7 @@ allocateJavaString str = do
   let strlen = fromIntegral $ B.length str
   arr <- newArray $ ((map fromIntegral $ B.unpack str) :: [Word8])
   -- (+1) for \0
-  newstr <- mallocBytes (strlen + 1)
+  newstr <- mallocString (strlen + 1)
   BI.memset newstr 0 (fromIntegral $ strlen + 1)
   copyBytes newstr arr strlen
   let w32_ptr = fromIntegral $ ptrToIntPtr newstr

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index ea986d2fc568b9da9f585c7d2b9e03343f1a9e02..abe5a39ea528215bef55255dc86517ca901a9b67 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -33,8 +33,8 @@ import Mate.Strings
 foreign import ccall "dynamic"
    code_int :: FunPtr (CInt -> CInt -> IO CInt) -> (CInt -> CInt -> IO CInt)
 
-foreign import ccall "getMallocAddr"
-  getMallocAddr :: CUInt
+foreign import ccall "getMallocObjectAddr"
+  getMallocObjectAddr :: CUInt
 
 foreign import ccall "register_signal"
   register_signal :: IO ()
@@ -311,7 +311,7 @@ emitFromBB method cls hmap =  do
     callMalloc = do
         calladdr <- getCurrentOffset
         let w32_calladdr = 5 + calladdr
-        let malloaddr = (fromIntegral getMallocAddr :: Word32)
+        let malloaddr = (fromIntegral getMallocObjectAddr :: Word32)
         call (malloaddr - w32_calladdr)
         add esp (4 :: Word32)
         push eax

diff --git a/ffi/trap.c b/ffi/trap.c
index 1d18ebade214e270d77b06a4c3763f7ea2d85c25..8a4db6f0400b332cc85f09501e5d2080b3217cf6 100644 (file)
--- a/ffi/trap.c
+++ b/ffi/trap.c
@@ -24,6 +24,7 @@
 unsigned int getMethodEntry(unsigned int, unsigned int);
 unsigned int getStaticFieldAddr(unsigned int, void*);
 unsigned int getTrapType(unsigned int, unsigned int);
+unsigned int mallocObject(int);
 
 #ifdef DBG_TRAP
 #define dprintf(args...) do { printf (args); } while (0);
@@ -160,7 +161,7 @@ unsigned int getaddr(void)
        return (unsigned int) mainresult;
 }
 
-unsigned int getMallocAddr(void)
+unsigned int getMallocObjectAddr(void)
 {
-       return (unsigned int) malloc;
+       return (unsigned int) mallocObject;
 }