GC: first working version of boehm gc. working with: 8af66bf9d36f75558ec49e0461099d5f...

diff --git a/Mate.hs b/Mate.hs
index 5ea2f7d200ae08d847a3677f54f3603fe3caf88f..96edb9633155c58b5850e689e489134eb5eb9030 100644 (file)
--- a/Mate.hs
+++ b/Mate.hs
@@ -22,6 +22,8 @@ import Mate.Types
 import Mate.ClassPool
 import Mate.NativeMachine
 
+import Mate.GC.Boehm
+
 main ::  IO ()
 main = do
   args <- getArgs
@@ -61,7 +63,8 @@ parseArgs _ _ = parseArgs ["-"] False
 
 
 executeMain :: B.ByteString -> Class Direct -> IO ()
-executeMain bclspath cls = do
+executeMain bclspath cls = do 
+  initGC --required on some platforms. [todo bernhard: maybe this should be moved somewhere else - maybe at a global place where vm initialization takes place
   let methods = classMethods cls; methods :: [Method Direct]
   case find (\x -> methodName x == "main") methods of
     Just m -> do

diff --git a/Mate/GarbageAlloc.hs b/Mate/GarbageAlloc.hs
index d993f93e68f2af865c3ee841e51fb0cfe21fe363..5dccda0f806332ec2e6cd7ba401d46865ea9b32d 100644 (file)
--- a/Mate/GarbageAlloc.hs
+++ b/Mate/GarbageAlloc.hs
@@ -5,7 +5,10 @@ module Mate.GarbageAlloc(
     mallocClassData,
     mallocString,
     mallocObject,
-    getHeapMemory)  where
+    getHeapMemory,
+    printMemoryUsage,
+    mallocStringVM,
+    mallocObjectVM)  where
 
 import Foreign
 import Foreign.C
@@ -21,13 +24,18 @@ import Mate.Debug
 mallocClassData :: Int -> IO (Ptr a)
 mallocClassData size = do
   printfStr "mallocClassData: %d\n" size
-  mallocBytesGC size
+  mem <- mallocBytes size
+  addRootGC mem (plusPtr mem size)
+  return mem
 
 mallocString :: Int -> IO (Ptr a)
 mallocString size = do
   printfStr "mallocString: %d\n" size
   mallocBytesGC size
 
+mallocStringVM :: Int -> IO (Ptr a)
+mallocStringVM = mallocBytes
+
 foreign export ccall mallocObject :: Int -> IO CPtrdiff
 mallocObject :: Int -> IO CPtrdiff
 mallocObject size = do
@@ -35,6 +43,12 @@ mallocObject size = do
   printfStr "mallocObject: %d\n" size
   return $ fromIntegral $ ptrToIntPtr ptr
 
+mallocObjectVM :: Int -> IO CPtrdiff
+mallocObjectVM size = do
+  ptr <- mallocBytes size
+  printfStr "mallocObject VM: %d\n" size
+  return $ fromIntegral $ ptrToIntPtr ptr
+
 -- TODO: delete me
 foreign export ccall demoInterfaceCall :: CUInt -> IO ()
 demoInterfaceCall :: CUInt -> IO ()
@@ -43,5 +57,9 @@ demoInterfaceCall val = do
   return ()
 
 getHeapMemory :: IO Int
-getHeapMemory = getHeapSize
+getHeapMemory = getHeapSizeGC
+
 
+foreign export ccall printMemoryUsage :: IO ()
+printMemoryUsage :: IO ()
+printMemoryUsage = getHeapMemory >>= print

diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs
index 73f47c090a76259fde609f4b1139a28a4191baca..da3e5e055808de09698423cc8173a4d3929178aa 100644 (file)
--- a/Mate/MethodPool.hs
+++ b/Mate/MethodPool.hs
@@ -32,6 +32,7 @@ import Mate.NativeMachine
 import Mate.ClassPool
 import Mate.Debug
 import Mate.Utilities
+import Mate.GarbageAlloc
 
 foreign import ccall "dynamic"
    code_void :: FunPtr (IO ()) -> IO ()
@@ -39,7 +40,9 @@ foreign import ccall "dynamic"
 foreign import ccall "&demoInterfaceCall"
   demoInterfaceCallAddr :: FunPtr (CUInt -> IO ())
 
-
+foreign import ccall "&printMemoryUsage"
+  printMemoryUsageAddr :: FunPtr (IO ())
+ 
 getMethodEntry :: CPtrdiff -> CPtrdiff -> IO CPtrdiff
 getMethodEntry signal_from methodtable = do
   mmap <- getMethodMap
@@ -73,6 +76,8 @@ getMethodEntry signal_from methodtable = do
                   case smethod of
                     "demoInterfaceCall" ->
                        return . funPtrToAddr $ demoInterfaceCallAddr
+                    "printMemoryUsage" ->
+                       return . funPtrToAddr $ printMemoryUsageAddr
                     _ ->
                        error $ "native-call: " ++ smethod ++ " not found."
                 else do

diff --git a/Mate/Strings.hs b/Mate/Strings.hs
index 05f6c50f8aeb7eee497f9d3d1177f6eb7319e819..e5f0fd99f21de81003b2f91b5bd43368f11e4f19 100644 (file)
--- a/Mate/Strings.hs
+++ b/Mate/Strings.hs
@@ -57,7 +57,7 @@ allocateJavaString str = do
   -- build object layout
   fsize <- getObjectSize "java/lang/String"
   printfStr "string: fsize: %d (should be 4 * 5)\n" fsize
-  tblptr <- mallocObject $ fromIntegral fsize
+  tblptr <- mallocObjectVM $ fromIntegral fsize
   let ptr = intPtrToPtr (fromIntegral tblptr) :: Ptr CPtrdiff
   mtbl <- getMethodTable "java/lang/String"
   poke ptr $ fromIntegral mtbl
@@ -65,7 +65,7 @@ allocateJavaString str = do
   -- build array layout
   let strlen = fromIntegral $ B.length str
   -- (+1) for \0, (+4) for length
-  newstr <- mallocString (strlen + 5)
+  newstr <- mallocStringVM (strlen + 5)
   BI.memset newstr 0 (fromIntegral $ strlen + 5)
   arr <- newArray ((map fromIntegral $ B.unpack str) :: [Word8])
   copyBytes (plusPtr newstr 4) arr strlen

diff --git a/jmate/lang/MateRuntime.java b/jmate/lang/MateRuntime.java
index 1a04df9602b1fbc43a1d2d2fe4dd6d5b30601407..56f3a10595a10fa6ce919b770342d90ab41e29e5 100644 (file)
--- a/jmate/lang/MateRuntime.java
+++ b/jmate/lang/MateRuntime.java
@@ -2,4 +2,5 @@ package jmate.lang;
 
 public class MateRuntime {
        public static native void demoInterfaceCall(int val);
+        public static native void printMemoryUsage();
 }

diff --git a/tests/Garbage1.java b/tests/Garbage1.java
index 4b36d86727b653910666c3b2ab9f91f9ca73c068..5ffea7b97300441f9acb5a1c6d2a875260a5e72a 100644 (file)
--- a/tests/Garbage1.java
+++ b/tests/Garbage1.java
@@ -1,5 +1,6 @@
 package tests;
 
+//import jmate.lang.MateRuntime;
 
 public class Garbage1
 {
@@ -9,13 +10,20 @@ public class Garbage1
 
        public static void main(String args[])
        {
+               //MateRuntime runtime = new MateRuntime();
+               System.out.println("a string object");
 
-               Big2 big2 = new Big2();
                for(int i=0;i<0x2800;i++)
                {
-                       big2 = new Big2();
+                       Big2 big2 = new Big2(); 
+                        if(i%0x1F==0) 
+                        { 
+                           //runtime.printMemoryUsage();
+                            System.out.printf("foo gah 0x%08x\n", i);
+                        }
+                        big2.foo();
                }
-               System.out.println("memory: todo");
+               System.out.println("done.");
        }
 }
 
@@ -28,4 +36,8 @@ class Big2
                arr = new int[0x400];
                //System.out.println("foo");
        }
+        
+        public void foo()
+        {
+        }
 }

diff --git a/tools/installhaskellenv.sh b/tools/installhaskellenv.sh
index 32b019093273a395840a0a57b789cb526ee59c9e..5bbe9914c2d5b36ff7a05b609a6012664aaf51fd 100755 (executable)
--- a/tools/installhaskellenv.sh
+++ b/tools/installhaskellenv.sh
@@ -11,6 +11,19 @@ function gitinstall {
        rm -rf tmprepo
 }
 
+#hs: i ran into the problem that cabal install does not execute
+#my Setup.hs - as workaround i invoke runhaskell Setup.hs etc directly
+function gitinstallWithCustomSetup {
+       url=$1
+       git clone $url tmprepo
+       cd tmprepo
+        runhaskell Setup.hs configure --user $CABAL_OPT
+        runhaskell Setup.hs build 
+        runhaskell Setup.hs install
+       cd ..
+       rm -rf tmprepo
+}
+
 rm -rf ~/.ghc ~/.cabal
 cabal update
 cabal install cabal-install $CABAL_OPT
@@ -28,7 +41,6 @@ cabal install disassembler $CABAL_OPT
 # cabal install harpy $CABAL_OPT
 gitinstall git://wien.tomnetworks.com/harpy.git
 
-# cabal install hs-boehmgc $CABAL_OPT 
-gitinstall git://wien.tomnetworks.com/hs-boehmgc.git 
+gitinstallWithCustomSetup git://wien.tomnetworks.com/hs-boehmgc.git 
 
 echo DONE