| 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))) |