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