124 lines
5.3 KiB
Common Lisp
124 lines
5.3 KiB
Common Lisp
;;; boehm-gc.lisp -- benchmark testing GC performance
|
|
;;
|
|
;; Time-stamp: <2002-11-22 emarsden>
|
|
;;
|
|
;; see <URL:http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_bench.html>
|
|
;; for original code in C, C++, Java and Scheme. This is adapted from
|
|
;; the Scheme version.
|
|
;;
|
|
;;
|
|
;; 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 32MB
|
|
;; heap, though we don't currently know how to enforce that uniformly.
|
|
|
|
|
|
(in-package :cl-bench.boehm-gc)
|
|
|
|
|
|
(defstruct node left right dummy1 dummy2)
|
|
|
|
;; build tree top down, assigning to older objects
|
|
(defun populate (depth thisNode)
|
|
(when (> depth 0)
|
|
(setf (node-left thisNode) (make-node))
|
|
(setf (node-right thisNode) (make-node))
|
|
(populate (1- depth) (node-left thisNode))
|
|
(populate (1- depth) (node-right thisNode))))
|
|
|
|
;; build tree bottom-up
|
|
(defun make-tree (depth)
|
|
(if (<= depth 0) (make-node)
|
|
(make-node :left (make-tree (- depth 1))
|
|
:right (make-tree (- depth 1)))))
|
|
|
|
;; nodes used by a tree of a given size
|
|
(defmacro tree-size (i) `(- (expt 2 (1+ ,i)) 1))
|
|
|
|
;; number of iterations to use for a given tree depth
|
|
(defmacro iteration-count (i)
|
|
`(floor (* 2 (tree-size stretch-tree-depth))
|
|
(tree-size ,i)))
|
|
|
|
(defun gcbench (stretch-tree-depth)
|
|
(declare (fixnum stretch-tree-depth))
|
|
|
|
;; Parameters are determined by stretch-tree-depth.
|
|
;; In Boehm's version the parameters were fixed as follows:
|
|
;; public static final int stretch-tree-depth = 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 (- stretch-tree-depth 2))
|
|
(kArraySize (* 4 (tree-size kLongLivedTreeDepth)))
|
|
(kMinTreeDepth 4)
|
|
(kMaxTreeDepth kLongLivedTreeDepth))
|
|
;; (format t "Stretching memory with a binary tree of depth ~d~%" stretch-tree-depth)
|
|
|
|
;; stretch the memory space quickly
|
|
(make-tree stretch-tree-depth)
|
|
|
|
;; Create a long lived object
|
|
;; (format t "Creating a long-lived binary tree of depth ~d~%" kLongLivedTreeDepth)
|
|
(let ((longLivedTree (make-node)))
|
|
(populate kLongLivedTreeDepth longLivedTree)
|
|
|
|
;; create long-lived array, filling half of it
|
|
;; (format t "Creating a long-lived array of ~d inexact reals~%" kArraySize)
|
|
(let ((array (make-array kArraySize :element-type 'single-float)))
|
|
(loop :for i :below (floor kArraySize 2)
|
|
:do (setf (aref array i) (/ 1.0 (1+ i))))
|
|
|
|
(do ((d kMinTreeDepth (+ d 2)))
|
|
((> d kMaxTreeDepth))
|
|
(let ((iteration-count (iteration-count d)))
|
|
;; (format t "~&Creating ~d trees of depth ~d~%" iteration-count d)
|
|
;; (format t "GCBench: Top down construction~%")
|
|
(dotimes (i iteration-count) (populate d (make-node)))
|
|
;; (format t "GCBench: Bottom up construction~%")
|
|
(dotimes (i iteration-count) (make-tree d))))
|
|
|
|
;; these are fake references to LongLivedTree and array to
|
|
;; keep them from being optimized away
|
|
(assert (not (null longLivedTree)))
|
|
(assert (let ((n (min 1000 (1- (floor (length array) 2)))))
|
|
(= (round (aref array n)) (round (/ 1.0 (1+ n))))))))))
|
|
|
|
(defun gc-benchmark (&optional (k 18))
|
|
;; (format t "The garbage collector should touch about ~d megabytes of heap storage.~%"
|
|
;; (expt 2 (- k 13)))
|
|
;; (format t "The use of more or less memory will skew the results.~%")
|
|
(gcbench k))
|
|
|
|
|
|
;; EOF
|