From 3573020fca0413c6d7823e2a1d70108f25766db0 Mon Sep 17 00:00:00 2001 From: Harald Steinlechner Date: Thu, 23 Aug 2012 17:45:47 +0200 Subject: [PATCH] GC: first working version of boehm gc. working with: 8af66bf9d36f75558ec49e0461099d5f41024574 of hs-boehmgc --- Mate.hs | 5 ++++- Mate/GarbageAlloc.hs | 24 +++++++++++++++++++++--- Mate/MethodPool.hs | 7 ++++++- Mate/Strings.hs | 4 ++-- jmate/lang/MateRuntime.java | 1 + tests/Garbage1.java | 18 +++++++++++++++--- tools/installhaskellenv.sh | 16 ++++++++++++++-- 7 files changed, 63 insertions(+), 12 deletions(-) diff --git a/Mate.hs b/Mate.hs index 5ea2f7d..96edb96 100644 --- 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 d993f93..5dccda0 100644 --- 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 73f47c0..da3e5e0 100644 --- 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 05f6c50..e5f0fd9 100644 --- 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 1a04df9..56f3a10 100644 --- 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 4b36d86..5ffea7b 100644 --- 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 32b0190..5bbe991 100755 --- 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 -- 2.25.1