mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
These GPLv2+-licensed GC benchmarks are available from http://www.ccs.neu.edu/home/will/GC/sourcecode.html .
21 lines
574 B
Scheme
21 lines
574 B
Scheme
; Dumb benchmark to test the reporting of words marked during gc.
|
|
; Example: (foo 1000000)
|
|
|
|
(define (ballast bytes)
|
|
(do ((bytes bytes (- bytes 8))
|
|
(x '() (cons bytes x)))
|
|
((zero? bytes) x)))
|
|
|
|
(define (words-benchmark bytes0 bytes1)
|
|
(let ((x (ballast bytes0)))
|
|
(do ((bytes1 bytes1 (- bytes1 8)))
|
|
((not (positive? bytes1))
|
|
(car (last-pair x)))
|
|
(cons (car x) bytes1))))
|
|
|
|
(define (foo n)
|
|
(collect)
|
|
(display-memstats (memstats))
|
|
(run-benchmark "foo" (lambda () (words-benchmark 1000000 n)) 1)
|
|
(display-memstats (memstats)))
|
|
|