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