Commit | Line | Data |
---|---|---|
1b706edf LC |
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))) |