{-
// This is adapted from a benchmark written by John Ellis and Pete Kovac
// of Post Communications.
// It was modified by Hans Boehm of Silicon Graphics.
//
//         This is no substitute for real applications.  No actual application
//        is likely to behave in exactly this way.  However, this benchmark was
//        designed to be more representative of real applications than other
//        Java GC benchmarks of which we are aware.
//        It attempts to model those properties of allocation requests that
//        are important to current GC techniques.
//        It is designed to be used either to obtain a single overall performance
//        number, or to give a more detailed estimate of how collector
//        performance varies with object lifetimes.  It prints the time
//        required to allocate and collect balanced binary trees of various
//        sizes.  Smaller trees result in shorter object lifetimes.  Each cycle
//        allocates roughly the same amount of memory.
//        Two data structures are kept around during the entire process, so
//        that the measured performance is representative of applications
//        that maintain some live in-memory data.  One of these is a tree
//        containing many pointers.  The other is a large array containing
//        double precision floating point numbers.  Both should be of comparable
//        size.
//
//        The results are only really meaningful together with a specification
//        of how much memory was used.  It is possible to trade memory for
//        better time performance.  This benchmark should be run in a 32 MB
//        heap, though we don't currently know how to enforce that uniformly.
//
//        Unlike the original Ellis and Kovac benchmark, we do not attempt
//         measure pause times.  This facility should eventually be added back
//        in.  There are several reasons for omitting it for now.  The original
//        implementation depended on assumptions about the thread scheduler
//        that don't hold uniformly.  The results really measure both the
//        scheduler and GC.  Pause time measurements tend to not fit well with
//        current benchmark suites.  As far as we know, none of the current
//        commercial Java implementations seriously attempt to minimize GC pause
//        times.
//
//        Known deficiencies:
//                - No way to check on memory use
//                - No cyclic data structures
//                - No attempt to measure variation with object size
//                - Results are sensitive to locking cost, but we dont
//                  check for proper locking

class Node {
        Node left, right;
        int i, j;
        Node(Node l, Node r) { left = l; right = r; }
        Node() { }
}

public class GCBench {

        public static final int kStretchTreeDepth    = 18;        // about 16Mb
        public static final int kLongLivedTreeDepth  = 16;  // about 4Mb
        public static final int kArraySize  = 500000;  // about 4Mb
        public static final int kMinTreeDepth = 4;
        public static final int kMaxTreeDepth = 16;

        // Nodes used by a tree of a given size
        static int TreeSize(int i) {
                    return ((1 << (i + 1)) - 1);
        }

        // Number of iterations to use for a given tree depth
        static int NumIters(int i) {
                return 2 * TreeSize(kStretchTreeDepth) / TreeSize(i);
        }

        // Build tree top down, assigning to older objects.
        static void Populate(int iDepth, Node thisNode) {
                if (iDepth<=0) {
                        return;
                } else {
                        iDepth--;
                        thisNode.left  = new Node();
                        thisNode.right = new Node();
                        Populate (iDepth, thisNode.left);
                        Populate (iDepth, thisNode.right);
                }
        }

        // Build tree bottom-up
        static Node MakeTree(int iDepth) {
                if (iDepth<=0) {
                        return new Node();
                } else {
                        return new Node(MakeTree(iDepth-1),
                                        MakeTree(iDepth-1));
                }
        }

        static void PrintDiagnostics() {
                long lFreeMemory = Runtime.getRuntime().freeMemory();
                long lTotalMemory = Runtime.getRuntime().totalMemory();

                System.out.print(" Total memory available="
                                 + lTotalMemory + " bytes");
                System.out.println("  Free memory=" + lFreeMemory + " bytes");
        }

        static void TimeConstruction(int depth) {
                Node    root;
                long    tStart, tFinish;
                int         iNumIters = NumIters(depth);
                Node        tempTree;

                System.out.println("Creating " + iNumIters +
                                   " trees of depth " + depth);
                tStart = System.currentTimeMillis();
                for (int i = 0; i < iNumIters; ++i) {
                        tempTree = new Node();
                        Populate(depth, tempTree);
                        tempTree = null;
                }
                tFinish = System.currentTimeMillis();
                System.out.println("\tTop down construction took "
                                   + (tFinish - tStart) + "msecs");
                tStart = System.currentTimeMillis();
                for (int i = 0; i < iNumIters; ++i) {
                        tempTree = MakeTree(depth);
                        tempTree = null;
                }
                tFinish = System.currentTimeMillis();
                System.out.println("\tBottom up construction took "
                                   + (tFinish - tStart) + "msecs");
                
        }

        public static void main(String args[]) {
                Node        root;
                Node        longLivedTree;
                Node        tempTree;
                long        tStart, tFinish;
                long        tElapsed;


                System.out.println("Garbage Collector Test");
                System.out.println(
                        " Stretching memory with a binary tree of depth "
                        + kStretchTreeDepth);
                PrintDiagnostics();
                tStart = System.currentTimeMillis();

                // Stretch the memory space quickly
                tempTree = MakeTree(kStretchTreeDepth);
                tempTree = null;

                // Create a long lived object
                System.out.println(
                        " Creating a long-lived binary tree of depth " +
                          kLongLivedTreeDepth);
                longLivedTree = new Node();
                Populate(kLongLivedTreeDepth, longLivedTree);

                // Create long-lived array, filling half of it
                System.out.println(
                        " Creating a long-lived array of "
                        + kArraySize + " doubles");
                double array[] = new double[kArraySize];
                for (int i = 0; i < kArraySize/2; ++i) {
                        array[i] = 1.0/i;
                }
                PrintDiagnostics();

                for (int d = kMinTreeDepth; d <= kMaxTreeDepth; d += 2) {
                        TimeConstruction(d);
                }

                if (longLivedTree == null || array[1000] != 1.0/1000)
                        System.out.println("Failed");
                                        // fake reference to LongLivedTree
                                        // and array
                                        // to keep them from being optimized away

                tFinish = System.currentTimeMillis();
                tElapsed = tFinish-tStart;
                PrintDiagnostics();
                System.out.println("Completed in " + tElapsed + "ms.");
        }
} // class JavaGC
-}

import Text.Printf
import System.CPUTime
import Data.IORef
import Data.Array.IO
import System.Time        ( ClockTime(..) )
import Control.Monad         ( replicateM_ )
import System.IO
import System.Environment

class DeepSeq a where
  deepSeq :: a -> b -> b
  deepSeq = seq

instance DeepSeq Int

instance DeepSeq Tree where
  deepSeq Empty b = b
  deepSeq Node{left=l, right=r, i=i} b =
    deepSeq l $ deepSeq r $ deepSeq i b

treeSize i = 2^(i+1) - 1

numIters max i = 2 * treeSize max `quot` treeSize i

data Tree = Node { left, right :: Tree,  i :: Int } | Empty

makeTree 0      = Node { left = Empty, right = Empty, i = 0 }
makeTree iDepth = Node { left  = makeTree (iDepth-1),
                         right = makeTree (iDepth-1),
                         i = 0 }

data MutTree = MutNode (IORef MutTree) (IORef MutTree) Int | MutEmpty

newMutNode x = do
  l <- newIORef MutEmpty
  r <- newIORef MutEmpty
  return (MutNode l r x)

-- Build tree top down, assigning to older objects.
populate 0 node = return ()
populate iDepth (MutNode lref rref i) = do
  l <- newMutNode iDepth
  writeIORef lref l
  r <- newMutNode iDepth
  writeIORef rref r
  populate (iDepth-1) l
  populate (iDepth-1) r

ldepth MutEmpty = return 0
ldepth (MutNode l _ _) = do t <- readIORef l; ldepth t

timeConstruction max depth = do
  let iNumIters = numIters max depth
--  printf "Creating %d trees of depth %d\n" iNumIters depth
  tStart <- getCPUTime
  replicateM_ iNumIters $ do
        n <- newMutNode depth; populate depth n; touch n
  tFinish <- getCPUTime
--  printf "\tTop down construction took "
--  ptimediff stdout tStart tFinish
--  printf "\n"
  tStart <- getCPUTime
  replicateM_ iNumIters $ do
        let tempTree = makeTree depth
        deepSeq tempTree (return ())
        touch tempTree
  tFinish <- getCPUTime
--  printf "\tBottom-up construction took "
--  ptimediff stdout tStart tFinish
--  printf "\n"
  return ()

main = do
  args <- getArgs
  let
    [kLongLivedTreeDepth,
     kArraySize,
     kMinTreeDepth,
     kMaxTreeDepth] = map read args :: [Int]

  hSetBuffering stdout NoBuffering
--  printf "Garbage Collector Test\n"
  tStart <- getCPUTime

  -- Create a long lived object or two
--  printf " Creating a long-lived binary tree of depth %d\n" kLongLivedTreeDepth
  let longLivedTree1 = makeTree kLongLivedTreeDepth
  deepSeq longLivedTree1 (return ())

--  printf " Creating a long-lived mutable tree of depth %d\n" kLongLivedTreeDepth
  longLivedTree2 <- newMutNode kLongLivedTreeDepth;
  populate kLongLivedTreeDepth longLivedTree2

  -- Create long-lived array, filling half of it
--  printf " Creating a long-lived array of %d doubles\n" kArraySize
  array <- newArray (1,kArraySize) 0.0
  let _ = array :: IOArray Int Double
  sequence_ [ writeArray array i (1.0 / fromIntegral i)
            | i <- [ 1 .. kArraySize `quot` 2 ] ]

  sequence_ [ timeConstruction kMaxTreeDepth d
            | d <- [ kMinTreeDepth, kMinTreeDepth+2 .. kMaxTreeDepth ] ]

  touch longLivedTree1
  ldepth longLivedTree2
  touch array

-- Utils

ptimediff :: Handle -> Integer -> Integer -> IO ()
ptimediff hout t0 t1 =
  hPrintf hout "%d.%02d" secs (psecs `quot` 10^10)
  where  (secs,psecs) = (t1 - t0) `quotRem` (10^12)

touch :: a -> IO ()
touch a = a `seq` return ()
