import Mate.ClassPool
import Mate.NativeMachine
+import Mate.GC.Boehm
+
main :: IO ()
main = do
args <- getArgs
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
mallocClassData,
mallocString,
mallocObject,
- getHeapMemory) where
+ getHeapMemory,
+ printMemoryUsage,
+ mallocStringVM,
+ mallocObjectVM) where
import Foreign
import Foreign.C
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
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 ()
return ()
getHeapMemory :: IO Int
-getHeapMemory = getHeapSize
+getHeapMemory = getHeapSizeGC
+
+foreign export ccall printMemoryUsage :: IO ()
+printMemoryUsage :: IO ()
+printMemoryUsage = getHeapMemory >>= print
import Mate.ClassPool
import Mate.Debug
import Mate.Utilities
+import Mate.GarbageAlloc
foreign import ccall "dynamic"
code_void :: FunPtr (IO ()) -> IO ()
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
case smethod of
"demoInterfaceCall" ->
return . funPtrToAddr $ demoInterfaceCallAddr
+ "printMemoryUsage" ->
+ return . funPtrToAddr $ printMemoryUsageAddr
_ ->
error $ "native-call: " ++ smethod ++ " not found."
else 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
-- 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
public class MateRuntime {
public static native void demoInterfaceCall(int val);
+ public static native void printMemoryUsage();
}
package tests;
+//import jmate.lang.MateRuntime;
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.");
}
}
arr = new int[0x400];
//System.out.println("foo");
}
+
+ public void foo()
+ {
+ }
}
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
# 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