2 ; GCOld.sch x.x 00/08/03
3 ; translated from GCOld.java 2.0a 00/08/23
5 ; Copyright 2000 Sun Microsystems, Inc. All rights reserved.
9 ; Should be good enough for this benchmark.
14 (set! x (remainder (+ (* a x) c) m))
15 (remainder (quotient x 8) n)))
24 (loop (quotient q 16384)
25 (+ (* 16384 r) (random14 16384))
28 (if (and (exact? n) (integer? n) (< n 16384))
30 (loop n (random14 16384) n)))))
32 ; A TreeNode is a record with three fields: left, right, val.
33 ; The left and right fields contain a TreeNode or 0, and the
34 ; val field will contain the integer height of the tree.
36 (define-syntax newTreeNode
38 ((newTreeNode left right val)
39 (vector left right val))
43 (define-syntax TreeNode.left
46 (vector-ref node 0))))
48 (define-syntax TreeNode.right
50 ((TreeNode.right node)
51 (vector-ref node 1))))
53 (define-syntax TreeNode.val
56 (vector-ref node 2))))
59 (syntax-rules (TreeNode.left TreeNode.right TreeNode.val)
60 ((setf (TreeNode.left node) x)
61 (vector-set! node 0 x))
62 ((setf (TreeNode.right node) x)
63 (vector-set! node 1 x))
64 ((setf (TreeNode.val node) x)
65 (vector-set! node 2 x))))
68 ; live-data-size: in megabytes.
69 ; work: units of mutator non-allocation work per byte allocated,
70 ; (in unspecified units. This will affect the promotion rate
71 ; printed at the end of the run: more mutator work per step implies
72 ; fewer steps per second implies fewer bytes promoted per second.)
73 ; short/long ratio: ratio of short-lived bytes allocated to long-lived
75 ; pointer mutation rate: number of pointer mutations per step.
76 ; steps: number of steps to do.
79 (define (GCOld size workUnits promoteRate ptrMutRate steps)
81 (define (println . args)
82 (for-each display args)
85 ; Rounds an inexact real to two decimal places.
88 (/ (round (* 100.0 x)) 100.0))
90 ; Returns the height of the given tree.
95 (+ 1 (max (height (TreeNode.left t))
96 (height (TreeNode.right t))))))
98 ; Returns the length of the shortest path in the given tree.
100 (define (shortestPath t)
103 (+ 1 (min (shortestPath (TreeNode.left t))
104 (shortestPath (TreeNode.right t))))))
106 ; Returns the number of nodes in a balanced tree of the given height.
108 (define (heightToNodes h)
111 ; Returns the height of the largest balanced tree
112 ; that has no more than the given number of nodes.
114 (define (nodesToHeight nodes)
117 ((> (+ n n -1) nodes)
124 (null 0) ; Java's null
125 (pathBits 65536) ; to generate 16 random bits
128 (INSIGNIFICANT 999) ; this many bytes don't matter
130 (bytes/node 20) ; bytes per tree node in typical JVM
131 (words/dead 100) ; size of young garbage objects
133 ; Returns the number of bytes in a balanced tree of the given height.
137 (* bytes/node (heightToNodes h))))
139 ; Returns the height of the largest balanced tree
140 ; that occupies no more than the given number of bytes.
144 (nodesToHeight (/ bytes bytes/node))))
147 (treeSize (heightToBytes treeHeight))
149 (msg1 "Usage: java GCOld <size> <work> <ratio> <mutation> <steps>")
150 (msg2 " where <size> is the live storage in megabytes")
151 (msg3 " <work> is the mutator work per step (arbitrary units)")
152 (msg4 " <ratio> is the ratio of short-lived to long-lived allocation")
153 (msg5 " <mutation> is the mutations per step")
154 (msg6 " <steps> is the number of steps")
156 ; Counters (and global variables that discourage optimization).
172 ; Returns a newly allocated balanced binary tree of height h.
177 (let ((res (newTreeNode)))
178 (set! nodes (+ nodes 1))
179 (setf (TreeNode.left res) (makeTree (- h 1)))
180 (setf (TreeNode.right res) (makeTree (- h 1)))
181 (setf (TreeNode.val res) h)
184 ; Allocates approximately size megabytes of trees and stores
185 ; them into a global array.
188 ; Each tree will be about a megabyte.
189 (let ((ntrees (quotient (* size MEG) treeSize)))
190 (set! trees (make-vector ntrees null))
191 (println "Allocating " ntrees " trees.")
192 (println " (" (* ntrees treeSize) " bytes)")
195 (vector-set! trees i (makeTree treeHeight))
196 (doYoungGenAlloc (* promoteRate ntrees treeSize) words/dead))
197 (println " (" nodes " nodes)")))
199 ; Confirms that all trees are balanced and have the correct height.
202 (let ((ntrees (vector-length trees)))
205 (let* ((t (vector-ref trees i))
207 (h2 (shortestPath t)))
208 (if (or (not (= h1 treeHeight))
209 (not (= h2 treeHeight)))
210 (println "*****BUG: " h1 " " h2))))))
212 ; Called only by replaceTree (below) and by itself.
214 (define (replaceTreeWork full partial dir)
215 (let ((canGoLeft (and (not (eq? (TreeNode.left full) null))
216 (> (TreeNode.val (TreeNode.left full))
217 (TreeNode.val partial))))
218 (canGoRight (and (not (eq? (TreeNode.right full) null))
219 (> (TreeNode.val (TreeNode.right full))
220 (TreeNode.val partial)))))
221 (cond ((and canGoLeft canGoRight)
223 (replaceTreeWork (TreeNode.left full)
226 (replaceTreeWork (TreeNode.right full)
229 ((and (not canGoLeft) (not canGoRight))
231 (setf (TreeNode.left full) partial)
232 (setf (TreeNode.right full) partial)))
234 (setf (TreeNode.left full) partial))
236 (setf (TreeNode.right full) partial)))))
238 ; Given a balanced tree full and a smaller balanced tree partial,
239 ; replaces an appropriate subtree of full by partial, taking care
240 ; to preserve the shape of the full tree.
242 (define (replaceTree full partial)
243 (let ((dir (zero? (modulo (TreeNode.val partial) 2))))
244 (set! actuallyMut (+ actuallyMut 1))
245 (replaceTreeWork full partial dir)))
247 ; Allocates approximately n bytes of long-lived storage,
248 ; replacing oldest existing long-lived storage.
250 (define (oldGenAlloc n)
251 (let ((full (quotient n treeSize))
252 (partial (modulo n treeSize)))
253 ;(println "In oldGenAlloc, doing "
255 ; " full trees and one partial tree of size "
259 (vector-set! trees where (makeTree treeHeight))
261 (modulo (+ where 1) (vector-length trees))))
262 (let loop ((partial partial))
263 (if (> partial INSIGNIFICANT)
264 (let* ((h (bytesToHeight partial))
265 (newTree (makeTree h)))
266 (replaceTree (vector-ref trees where) newTree)
268 (modulo (+ where 1) (vector-length trees)))
269 (loop (- partial (heightToBytes h))))))))
271 ; Interchanges two randomly selected subtrees (of same size and depth).
273 (define (oldGenSwapSubtrees)
277 ; * A path to that depth.
278 (let* ((index1 (rnd (vector-length trees)))
279 (index2 (rnd (vector-length trees)))
280 (depth (rnd treeHeight))
281 (path (rnd pathBits))
282 (tn1 (vector-ref trees index1))
283 (tn2 (vector-ref trees index2)))
287 (begin (set! tn1 (TreeNode.left tn1))
288 (set! tn2 (TreeNode.left tn2)))
289 (begin (set! tn1 (TreeNode.right tn1))
290 (set! tn2 (TreeNode.right tn2))))
291 (set! path (quotient path 2)))
293 (let ((tmp (TreeNode.left tn1)))
294 (setf (TreeNode.left tn1) (TreeNode.left tn2))
295 (setf (TreeNode.left tn2) tmp))
296 (let ((tmp (TreeNode.right tn1)))
297 (setf (TreeNode.right tn1) (TreeNode.right tn2))
298 (setf (TreeNode.right tn2) tmp)))
299 (set! actuallyMut (+ actuallyMut 2))))
301 ; Update "n" old-generation pointers.
303 (define (oldGenMut n)
305 ((>= i (quotient n 2)))
306 (oldGenSwapSubtrees)))
308 ; Does the amount of mutator work appropriate for n bytes of young-gen
309 ; garbage allocation.
311 (define (doMutWork n)
312 (let ((limit (quotient (* workUnits n) 10)))
316 ; We don't want dead code elimination to eliminate this loop.
317 (set! mutatorSum (+ mutatorSum sum))))))
319 ; Allocate n bytes of young-gen garbage, in units of "nwords"
322 (define (doYoungGenAlloc n nwords)
323 (let ((nbytes (* nwords bytes/word)))
324 (do ((allocated 0 (+ allocated nbytes)))
326 (set! youngBytes (+ youngBytes allocated)))
327 (set! aexport (make-vector nwords 0)))))
329 ; Allocate "n" bytes of young-gen data; and do the
330 ; corresponding amount of old-gen allocation and pointer
333 ; oldGenAlloc may perform some mutations, so this code
334 ; takes those mutations into account.
337 (let ((mutations actuallyMut))
338 (doYoungGenAlloc n words/dead)
340 ; Now do old-gen allocation
341 (oldGenAlloc (quotient n promoteRate))
342 (oldGenMut (max 0 (- (+ mutations ptrMutRate) actuallyMut)))))
344 (println size " megabytes")
345 (println workUnits " work units per step.")
346 (println "promotion ratio is 1:" promoteRate)
347 (println "pointer mutation rate is " ptrMutRate)
348 (println steps " steps")
355 (println "Initialization complete...")
357 (run-benchmark "GCOld"
361 (do ((step 0 (+ step 1)))
364 (lambda (result) #t))
368 (println "Allocated " steps " Mb of young gen garbage")
369 (println " (actually allocated "
370 (round2 (/ youngBytes MEG))
372 (println "Promoted " (round2 (/ steps promoteRate)) " Mb")
373 (println " (actually promoted "
374 (round2 (/ (* nodes bytes/node) MEG))
376 (if (not (zero? ptrMutRate))
377 (println "Mutated " actuallyMut " pointers"))
379 ; This output serves mainly to discourage optimization.
381 (+ mutatorSum (vector-length aexport))))
383 (define (gcold-benchmark . args)
384 (define gcold-iters 1)
386 (GCOld 25 0 10 10 gcold-iters))