gc-benchmarks/larceny/gcbench.sch

   1 ;  This is adapted from a benchmark written by John Ellis and Pete Kovac
   2 ;  of Post Communications.
   3 ;  It was modified by Hans Boehm of Silicon Graphics.
   4 ;  It was translated into Scheme by William D Clinger of Northeastern Univ;
   5 ;    the Scheme version uses (RUN-BENCHMARK <string> <thunk>)
   6 ;  It was later hacked by Lars T Hansen of Northeastern University;
   7 ;    this version has a fixed tree height but accepts a number of
   8 ;    iterations to run.
   9 ;
  10 ;  Modified 2000-02-15 / lth: changed gc-benchmark to only stretch once,
  11 ;     and to have a different interface (now accepts iteration numbers,
  12 ;     not tree height)
  13 ;  Last modified 2000-07-14 / lth -- fixed a buggy comment about storage
  14 ;     use in Larceny.
  15 ;
  16 ;       This is no substitute for real applications.  No actual application
  17 ;       is likely to behave in exactly this way.  However, this benchmark was
  18 ;       designed to be more representative of real applications than other
  19 ;       Java GC benchmarks of which we are aware.
  20 ;       It attempts to model those properties of allocation requests that
  21 ;       are important to current GC techniques.
  22 ;       It is designed to be used either to obtain a single overall performance
  23 ;       number, or to give a more detailed estimate of how collector
  24 ;       performance varies with object lifetimes.  It prints the time
  25 ;       required to allocate and collect balanced binary trees of various
  26 ;       sizes.  Smaller trees result in shorter object lifetimes.  Each cycle
  27 ;       allocates roughly the same amount of memory.
  28 ;       Two data structures are kept around during the entire process, so
  29 ;       that the measured performance is representative of applications
  30 ;       that maintain some live in-memory data.  One of these is a tree
  31 ;       containing many pointers.  The other is a large array containing
  32 ;       double precision floating point numbers.  Both should be of comparable
  33 ;       size.
  34 ;
  35 ;       The results are only really meaningful together with a specification
  36 ;       of how much memory was used.  It is possible to trade memory for
  37 ;       better time performance.  This benchmark should be run in a 32 MB
  38 ;       heap, though we don't currently know how to enforce that uniformly.
  39
  40 ; In the Java version, this routine prints the heap size and the amount
  41 ; of free memory.  There is no portable way to do this in Scheme; each
  42 ; implementation needs its own version.
  43
  44 (define (PrintDiagnostics)
  45   (display " Total memory available= ???????? bytes")
  46   (display "  Free memory= ???????? bytes")
  47   (newline))
  48
  49 (define (yes answer) #t)
  50
  51 ; Should we implement a Java class as procedures or hygienic macros?
  52 ; Take your pick.
  53
  54 (define-syntax let-class
  55   (syntax-rules
  56    ()
  57    ; Put this rule first to implement a class using hygienic macros.
  58    ((let-class (((method . args) . method-body) ...) . body)
  59     (letrec-syntax ((method (syntax-rules ()
  60                               ((method . args) (begin . method-body))))
  61                     ...)
  62       . body))
  63    ; Put this rule first to implement a class using procedures.
  64    ((let-class (((method . args) . method-body) ...) . body)
  65     (let () (define (method . args) . method-body) ... . body))
  66    ))
  67
  68
  69 (define stretch #t)                ; Controls whether stretching phase is run
  70
  71 (define (gcbench kStretchTreeDepth)
  72
  73   ; Use for inner calls to reduce noise.
  74
  75   (define (run-benchmark name iters thunk test)
  76     (do ((i 0 (+ i 1)))
  77         ((= i iters))
  78       (thunk)))
  79
  80   ;  Nodes used by a tree of a given size
  81   (define (TreeSize i)
  82     (- (expt 2 (+ i 1)) 1))
  83
  84   ;  Number of iterations to use for a given tree depth
  85   (define (NumIters i)
  86     (quotient (* 2 (TreeSize kStretchTreeDepth))
  87               (TreeSize i)))
  88
  89   ;  Parameters are determined by kStretchTreeDepth.
  90   ;  In Boehm's version the parameters were fixed as follows:
  91   ;    public static final int kStretchTreeDepth    = 18;  // about 16Mb
  92   ;    public static final int kLongLivedTreeDepth  = 16;  // about 4Mb
  93   ;    public static final int kArraySize  = 500000;       // about 4Mb
  94   ;    public static final int kMinTreeDepth = 4;
  95   ;    public static final int kMaxTreeDepth = 16;
  96   ;  wdc: In Larceny the storage numbers above would be 12 Mby, 3 Mby, 6 Mby.
  97   ;  lth: No they would not.  A flonum requires 16 bytes, so the size
  98   ;  of array + flonums would be 500,000*4 + 500,000*16=10 Mby.
  99
 100   (let* ((kLongLivedTreeDepth (- kStretchTreeDepth 2))
 101          (kArraySize          (* 4 (TreeSize kLongLivedTreeDepth)))
 102          (kMinTreeDepth       4)
 103          (kMaxTreeDepth       kLongLivedTreeDepth))
 104
 105     ; Elements 3 and 4 of the allocated vectors are useless.
 106
 107     (let-class (((make-node l r)
 108                  (let ((v (make-empty-node)))
 109                    (vector-set! v 0 l)
 110                    (vector-set! v 1 r)
 111                    v))
 112                 ((make-empty-node) (make-vector 4 0))
 113                 ((node.left node) (vector-ref node 0))
 114                 ((node.right node) (vector-ref node 1))
 115                 ((node.left-set! node x) (vector-set! node 0 x))
 116                 ((node.right-set! node x) (vector-set! node 1 x)))
 117
 118       ;  Build tree top down, assigning to older objects.
 119       (define (Populate iDepth thisNode)
 120         (if (<= iDepth 0)
 121             #f
 122             (let ((iDepth (- iDepth 1)))
 123               (node.left-set! thisNode (make-empty-node))
 124               (node.right-set! thisNode (make-empty-node))
 125               (Populate iDepth (node.left thisNode))
 126               (Populate iDepth (node.right thisNode)))))
 127
 128       ;  Build tree bottom-up
 129       (define (MakeTree iDepth)
 130         (if (<= iDepth 0)
 131             (make-empty-node)
 132             (make-node (MakeTree (- iDepth 1))
 133                        (MakeTree (- iDepth 1)))))
 134
 135       (define (TimeConstruction depth)
 136         (let ((iNumIters (NumIters depth)))
 137           (display (string-append "Creating "
 138                                   (number->string iNumIters)
 139                                   " trees of depth "
 140                                   (number->string depth)))
 141           (newline)
 142           (run-benchmark "GCBench: Top down construction"
 143                          1
 144                          (lambda ()
 145                            (do ((i 0 (+ i 1)))
 146                                ((>= i iNumIters))
 147                                (Populate depth (make-empty-node))))
 148                          yes)
 149           (run-benchmark "GCBench: Bottom up construction"
 150                          1
 151                          (lambda ()
 152                            (do ((i 0 (+ i 1)))
 153                                ((>= i iNumIters))
 154                                (MakeTree depth)))
 155                          yes)))
 156
 157       (define (main)
 158         (display "Garbage Collector Test")
 159         (newline)
 160         (if stretch
 161             (begin
 162               (display (string-append
 163                         " Stretching memory with a binary tree of depth "
 164                         (number->string kStretchTreeDepth)))
 165               (newline)))
 166         (PrintDiagnostics)
 167         (run-benchmark "GCBench: Main"
 168                        1
 169                        (lambda ()
 170                          ;  Stretch the memory space quickly
 171                          (if stretch
 172                              (MakeTree kStretchTreeDepth))
 173
 174                          ;  Create a long lived object
 175                          (display
 176                           (string-append
 177                            " Creating a long-lived binary tree of depth "
 178                            (number->string kLongLivedTreeDepth)))
 179                          (newline)
 180                          (let ((longLivedTree (make-empty-node)))
 181                            (Populate kLongLivedTreeDepth longLivedTree)
 182
 183                            ;  Create long-lived array, filling half of it
 184                            (display (string-append
 185                                      " Creating a long-lived array of "
 186                                      (number->string kArraySize)
 187                                      " inexact reals"))
 188                            (newline)
 189                            (let ((array (make-vector kArraySize 0.0)))
 190                              (do ((i 0 (+ i 1)))
 191                                  ((>= i (quotient kArraySize 2)))
 192                                  (vector-set! array i
 193                                               (/ 1.0 (exact->inexact i))))
 194                              (PrintDiagnostics)
 195
 196                              (do ((d kMinTreeDepth (+ d 2)))
 197                                  ((> d kMaxTreeDepth))
 198                                  (TimeConstruction d))
 199
 200                              (if (or (eq? longLivedTree '())
 201                                      (let ((n (min 1000
 202                                                    (- (quotient (vector-length array)
 203                                                                 2)
 204                                                       1))))
 205                                        (not (= (vector-ref array n)
 206                                                (/ 1.0 (exact->inexact n))))))
 207                                  (begin (display "Failed") (newline)))
 208                              ;  fake reference to LongLivedTree
 209                              ;  and array
 210                              ;  to keep them from being optimized away
 211                              )))
 212                        yes)
 213         (PrintDiagnostics))
 214
 215       (main))))
 216
 217 (define (gc-benchmark . rest)
 218   (let ((k 18)
 219         (n (if (null? rest) 1 (car rest))))
 220     (display "The garbage collector should touch about ")
 221     (display (expt 2 (- k 13)))
 222     (display " megabytes of heap storage.")
 223     (newline)
 224     (display "The use of more or less memory will skew the results.")
 225     (newline)
 226     (set! stretch #t)
 227     (run-benchmark (string-append "GCBench" (number->string k))
 228                    n
 229                    (lambda ()
 230                      (gcbench k)
 231                      (set! stretch #f))
 232                    yes)
 233     (set! stretch #t)))