From 6f979304b8c4334737feeb5dd5e053c03a8a559c Mon Sep 17 00:00:00 2001
From: Bernhard Urban <lewurm@gmail.com>
Date: Thu, 10 May 2012 12:27:48 +0200
Subject: [PATCH] gc: factor out allocation

in order to have central place when starting with garbage collection.
---
 Mate/ClassPool.hs    |  8 ++++----
 Mate/GarbageAlloc.hs | 19 +++++++++++++++++++
 Mate/Strings.hs      |  4 ++--
 Mate/X86CodeGen.hs   |  6 +++---
 ffi/trap.c           |  5 +++--
 5 files changed, 31 insertions(+), 11 deletions(-)
 create mode 100644 Mate/GarbageAlloc.hs

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index 710b6a5..1f7d785 100644
--- 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
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 fb7f0af..6e54181 100644
--- 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 ea986d2..abe5a39 100644
--- 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 1d18eba..8a4db6f 100644
--- 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;
 }
-- 
2.25.1