summaryrefslogtreecommitdiff
path: root/benchmark-suite
diff options
context:
space:
mode:
Diffstat (limited to 'benchmark-suite')
-rw-r--r--benchmark-suite/ChangeLog-200889
-rw-r--r--benchmark-suite/Makefile.am24
-rw-r--r--benchmark-suite/README18
-rw-r--r--benchmark-suite/benchmark-suite/lib.scm493
-rw-r--r--benchmark-suite/benchmarks/0-reference.bm6
-rw-r--r--benchmark-suite/benchmarks/arithmetic.bm67
-rw-r--r--benchmark-suite/benchmarks/bytevector-io.bm52
-rw-r--r--benchmark-suite/benchmarks/bytevectors.bm99
-rw-r--r--benchmark-suite/benchmarks/chars.bm57
-rw-r--r--benchmark-suite/benchmarks/continuations.bm9
-rw-r--r--benchmark-suite/benchmarks/hash.bm53
-rw-r--r--benchmark-suite/benchmarks/if.bm55
-rw-r--r--benchmark-suite/benchmarks/logand.bm10
-rw-r--r--benchmark-suite/benchmarks/ports.bm95
-rw-r--r--benchmark-suite/benchmarks/r6rs-arithmetic.bm35
-rw-r--r--benchmark-suite/benchmarks/read.bm73
-rw-r--r--benchmark-suite/benchmarks/srfi-1.bm64
-rw-r--r--benchmark-suite/benchmarks/srfi-13.bm310
-rw-r--r--benchmark-suite/benchmarks/strings.bm537
-rw-r--r--benchmark-suite/benchmarks/structs.bm51
-rw-r--r--benchmark-suite/benchmarks/subr.bm66
-rw-r--r--benchmark-suite/benchmarks/vectors.bm51
-rw-r--r--benchmark-suite/benchmarks/vlists.bm103
-rw-r--r--benchmark-suite/benchmarks/write.bm52
-rwxr-xr-xbenchmark-suite/guile-benchmark220
-rw-r--r--benchmark-suite/results/neil-arudy93
26 files changed, 2782 insertions, 0 deletions
diff --git a/benchmark-suite/ChangeLog-2008 b/benchmark-suite/ChangeLog-2008
new file mode 100644
index 000000000..fcfedc2de
--- /dev/null
+++ b/benchmark-suite/ChangeLog-2008
@@ -0,0 +1,89 @@
+2008-04-17 Ludovic Courtès <ludo@gnu.org>
+
+ * Makefile.am (SCM_BENCHMARKS): Add `benchmarks/read.bm'.
+ * benchmarks/read.bm: New file.
+
+2008-01-22 Neil Jerram <neil@ossau.uklinux.net>
+
+ * COPYING: Removed.
+
+2006-11-17 Neil Jerram <neil@ossau.uklinux.net>
+
+ * README: Note need for subscription to bug-guile@gnu.org.
+
+2006-05-02 Marius Vollmer <mvo@zagadka.de>
+
+ * Makefile.am (SCM_BENCHMARKS_DIRS, dist-hook): Removed, they are
+ no longer needed and lead to unclean tarballs.
+
+2004-01-23 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
+
+ * lib.scm: Extracted '/i' to toplevel. Print the guile version
+ number before the benchmarks are run. Print the framework-time
+ per iteration as an inexact number.
+
+2004-01-06 Marius Vollmer <marius.vollmer@uni-dortmund.de>
+
+ * lib.scm (print-result, print-user-result): Handle exact
+ fractions.
+
+2003-05-27 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ * lib.scm: Fix some typos in the documentation.
+
+2002-09-14 Rob Browning <rlb@defaultvalue.org>
+
+ * .cvsignore: new file.
+
+2002-07-26 Marius Vollmer <marius.vollmer@uni-dortmund.de>
+
+ * Makefile.am (SCM_BENCHMARKS): List the real benchmarks, not foo
+ and bar.
+ (SCM_BENCHMARKS_DIRS): Uncommented, with an empty value.
+ (dist-hook): Use quotes so that an empty SCM_BENCHMARKS_DIRS works.
+
+2002-07-21 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ * lib.scm (print-result, print-user-result): Changed the
+ reporter's outputs to use symbols rather than strings to document
+ the individual values. Thanks to Neil Jerram for the suggestion.
+
+2002-07-21 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ * benchmarks/0-reference.bm: Added as a reference benchmark to be
+ used to calibrate iteration counts.
+
+ * lib.scm: Added documentation. Added some initialization
+ messages.
+
+ (benchmark-time-base, benchmark-total-time, benchmark-user-time,
+ benchmark-system-time, benchmark-frame-time, benchmark-core-time,
+ benchmark-user-time\interpreter, benchmark-core-time\interpreter):
+ Exported.
+
+ (benchmark-time-base, time-base): Renamed time-base to
+ benchmark-time-base and introduced new time-base as a short-cut.
+
+ (total-time, benchmark-total-time, user-time, benchmark-user-time,
+ system-time, benchmark-system-time, frame-time,
+ benchmark-frame-time, benchmark-time, benchmark-core-time,
+ user-time\interpreter, benchmark-user-time\interpreter,
+ benchmark-time\interpreter, benchmark-core-time\interpreter,
+ print-result, print-user-result): Renamed <foo>-time to
+ benchmark-<foo>-time. Exceptions: benchmark-time and
+ benchmark-time\interpreter were renamed to benchmark-core-time and
+ benchmark-core-time\interpreter, respectively.
+
+2002-07-20 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ * COPYING, README, Makefile.am, lib.scm, guile-benchmark: Copied
+ from the test-suite directory, renamed and adapted for use with
+ benchmarks.
+
+ * benchmarks/logand.bm, benchmarks/continuations.bm,
+ benchmarks/if.bm: Added as initial fairly stupid examples for
+ benchmarks.
+
+2002-07-20 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ * Log begins.
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
new file mode 100644
index 000000000..47bd0365d
--- /dev/null
+++ b/benchmark-suite/Makefile.am
@@ -0,0 +1,24 @@
+SCM_BENCHMARKS = benchmarks/0-reference.bm \
+ benchmarks/arithmetic.bm \
+ benchmarks/bytevector-io.bm \
+ benchmarks/bytevectors.bm \
+ benchmarks/chars.bm \
+ benchmarks/continuations.bm \
+ benchmarks/hash.bm \
+ benchmarks/if.bm \
+ benchmarks/logand.bm \
+ benchmarks/ports.bm \
+ benchmarks/r6rs-arithmetic.bm \
+ benchmarks/read.bm \
+ benchmarks/srfi-1.bm \
+ benchmarks/srfi-13.bm \
+ benchmarks/structs.bm \
+ benchmarks/subr.bm \
+ benchmarks/vectors.bm \
+ benchmarks/vlists.bm \
+ benchmarks/write.bm \
+ benchmarks/strings.bm
+
+EXTRA_DIST = guile-benchmark benchmark-suite/lib.scm \
+ $(SCM_BENCHMARKS) \
+ ChangeLog-2008
diff --git a/benchmark-suite/README b/benchmark-suite/README
new file mode 100644
index 000000000..186a74351
--- /dev/null
+++ b/benchmark-suite/README
@@ -0,0 +1,18 @@
+This directory contains some benchmarks for Guile, and some generic
+benchmarking support code.
+
+To run these benchmarks, you will need a version of Guile more recent
+than 15 Feb 1999 --- the benchmarks use the (ice-9 and-let*) and
+(ice-9 getopt-long) modules, which were added to Guile around then.
+
+For information about how to run the benchmark suite, read the usage
+instructions in the comments at the top of the guile-benchmark script.
+
+You can reference the file `lib.scm' from your own code as the module
+(benchmark-suite lib); it also has comments at the top and before each
+function explaining what's going on.
+
+Please write more Guile benchmarks, and send them to bug-guile@gnu.org.
+We'll merge them into the distribution. All benchmark suites must be
+licensed for our use under the GPL, but I don't think we're going to
+collect assignment papers for them.
diff --git a/benchmark-suite/benchmark-suite/lib.scm b/benchmark-suite/benchmark-suite/lib.scm
new file mode 100644
index 000000000..ae57cc02a
--- /dev/null
+++ b/benchmark-suite/benchmark-suite/lib.scm
@@ -0,0 +1,493 @@
+;;;; benchmark-suite/lib.scm --- generic support for benchmarking
+;;;; Copyright (C) 2002, 2006, 2011, 2012 Free Software Foundation, Inc.
+;;;;
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this software; see the file COPYING.LESSER.
+;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin
+;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmark-suite lib)
+ #:use-module (srfi srfi-9)
+ #:export (;; Controlling the execution.
+ iteration-factor
+ scale-iterations
+
+ ;; Running benchmarks.
+ run-benchmark
+ benchmark
+
+ ;; Naming groups of benchmarks in a regular fashion.
+ with-benchmark-prefix with-benchmark-prefix*
+ current-benchmark-prefix format-benchmark-name
+
+ ;; <benchmark-result> accessors
+ benchmark-result:name
+ benchmark-result:iterations
+ benchmark-result:real-time
+ benchmark-result:run-time
+ benchmark-result:gc-time
+ benchmark-result:core-time
+
+ ;; Reporting results in various ways.
+ report current-reporter
+ register-reporter unregister-reporter reporter-registered?
+ make-log-reporter
+ full-reporter
+ user-reporter))
+
+
+;;;; If you're using Emacs's Scheme mode:
+;;;; (put 'with-benchmark-prefix 'scheme-indent-function 1)
+;;;; (put 'benchmark 'scheme-indent-function 1)
+
+
+;;;; CORE FUNCTIONS
+;;;;
+;;;; The function (run-benchmark name iterations thunk) is the heart of the
+;;;; benchmarking environment. The first parameter NAME is a unique name for
+;;;; the benchmark to be executed (for an explanation of this parameter see
+;;;; below under ;;;; NAMES. The second parameter ITERATIONS is a positive
+;;;; integer value that indicates how often the thunk shall be executed (for
+;;;; an explanation of how iteration counts should be used, see below under
+;;;; ;;;; ITERATION COUNTS). For example:
+;;;;
+;;;; (run-benchmark "small integer addition" 100000 (lambda () (+ 1 1)))
+;;;;
+;;;; This will run the function (lambda () (+ 1 1)) a 100000 times (the
+;;;; iteration count can, however be scaled. See below for details). Some
+;;;; different time data for running the thunk for the given number of
+;;;; iterations is measured and reported.
+;;;;
+;;;; Convenience macro
+;;;;
+;;;; * (benchmark name iterations body) is a short form for
+;;;; (run-benchmark name iterations (lambda () body))
+
+
+;;;; NAMES
+;;;;
+;;;; Every benchmark in the benchmark suite has a unique name to be able to
+;;;; compare the results of individual benchmarks across several runs of the
+;;;; benchmark suite.
+;;;;
+;;;; A benchmark name is a list of printable objects. For example:
+;;;; ("ports.scm" "file" "read and write back list of strings")
+;;;; ("ports.scm" "pipe" "read")
+;;;;
+;;;; Benchmark names may contain arbitrary objects, but they always have
+;;;; the following properties:
+;;;; - Benchmark names can be compared with EQUAL?.
+;;;; - Benchmark names can be reliably stored and retrieved with the standard
+;;;; WRITE and READ procedures; doing so preserves their identity.
+;;;;
+;;;; For example:
+;;;;
+;;;; (benchmark "simple addition" 100000 (+ 2 2))
+;;;;
+;;;; In that case, the benchmark name is the list ("simple addition").
+;;;;
+;;;; The WITH-BENCHMARK-PREFIX syntax and WITH-BENCHMARK-PREFIX* procedure
+;;;; establish a prefix for the names of all benchmarks whose results are
+;;;; reported within their dynamic scope. For example:
+;;;;
+;;;; (begin
+;;;; (with-benchmark-prefix "basic arithmetic"
+;;;; (benchmark "addition" 100000 (+ 2 2))
+;;;; (benchmark "subtraction" 100000 (- 4 2)))
+;;;; (benchmark "multiplication" 100000 (* 2 2))))
+;;;;
+;;;; In that example, the three benchmark names are:
+;;;; ("basic arithmetic" "addition"),
+;;;; ("basic arithmetic" "subtraction"), and
+;;;; ("multiplication").
+;;;;
+;;;; WITH-BENCHMARK-PREFIX can be nested. Each WITH-BENCHMARK-PREFIX
+;;;; appends a new element to the current prefix:
+;;;;
+;;;; (with-benchmark-prefix "arithmetic"
+;;;; (with-benchmark-prefix "addition"
+;;;; (benchmark "integer" 100000 (+ 2 2))
+;;;; (benchmark "complex" 100000 (+ 2+3i 4+5i)))
+;;;; (with-benchmark-prefix "subtraction"
+;;;; (benchmark "integer" 100000 (- 2 2))
+;;;; (benchmark "complex" 100000 (- 2+3i 1+2i))))
+;;;;
+;;;; The four benchmark names here are:
+;;;; ("arithmetic" "addition" "integer")
+;;;; ("arithmetic" "addition" "complex")
+;;;; ("arithmetic" "subtraction" "integer")
+;;;; ("arithmetic" "subtraction" "complex")
+;;;;
+;;;; To print a name for a human reader, we DISPLAY its elements,
+;;;; separated by ": ". So, the last set of benchmark names would be
+;;;; reported as:
+;;;;
+;;;; arithmetic: addition: integer
+;;;; arithmetic: addition: complex
+;;;; arithmetic: subtraction: integer
+;;;; arithmetic: subtraction: complex
+;;;;
+;;;; The Guile benchmarks use with-benchmark-prefix to include the name of
+;;;; the source file containing the benchmark in the benchmark name, to
+;;;; provide each file with its own namespace.
+
+
+;;;; ITERATION COUNTS
+;;;;
+;;;; Every benchmark has to be given an iteration count that indicates how
+;;;; often it should be executed. The reason is, that in most cases a single
+;;;; execution of the benchmark code would not deliver usable timing results:
+;;;; The resolution of the system time is not arbitrarily fine. Thus, some
+;;;; benchmarks would be executed too quickly to be measured at all. A rule
+;;;; of thumb is, that the longer a benchmark runs, the more exact is the
+;;;; information about the execution time.
+;;;;
+;;;; However, execution time depends on several influences: First, the
+;;;; machine you are running the benchmark on. Second, the compiler you use.
+;;;; Third, which compiler options you use. Fourth, which version of guile
+;;;; you are using. Fifth, which guile options you are using (for example if
+;;;; you are using the debugging evaluator or not). There are even more
+;;;; influences.
+;;;;
+;;;; For this reason, the same number of iterations for a single benchmark may
+;;;; lead to completely different execution times in different
+;;;; constellations. For someone working on a slow machine, the default
+;;;; execution counts may lead to an inacceptable execution time of the
+;;;; benchmark suite. For someone on a very fast machine, however, it may be
+;;;; desireable to increase the number of iterations in order to increase the
+;;;; accuracy of the time data.
+;;;;
+;;;; For this reason, the benchmark suite allows to scale the number of
+;;;; executions by a global factor, stored in the exported variable
+;;;; iteration-factor. The default for iteration-factor is 1. A number of 2
+;;;; means, that all benchmarks are executed twice as often, which will also
+;;;; roughly double the execution time for the benchmark suite. Similarly, if
+;;;; iteration-factor holds a value of 0.5, only about half the execution time
+;;;; will be required.
+;;;;
+;;;; It is probably a good idea to choose the iteration count for each
+;;;; benchmark such that all benchmarks will take about the same time, for
+;;;; example one second. To achieve this, the benchmark suite holds an empty
+;;;; benchmark in the file 0-reference.bm named "reference benchmark for
+;;;; iteration counts". It's iteration count is calibrated to make the
+;;;; benchmark run about one second on Dirk's laptop :-) If you are adding
+;;;; benchmarks to the suite, it would be nice if you could calibrate the
+;;;; number of iterations such that each of your added benchmarks takes about
+;;;; as long to run as the reference benchmark. But: Don't be too accurate
+;;;; to figure out the correct iteration count.
+
+
+;;;; REPORTERS
+;;;;
+;;;; A reporter is a function which we apply to each benchmark outcome.
+;;;; Reporters can log results, print interesting results to the standard
+;;;; output, collect statistics, etc.
+;;;;
+;;;; A reporter function takes the following arguments: NAME ITERATIONS
+;;;; BEFORE AFTER GC-TIME. The argument NAME holds the name of the benchmark,
+;;;; ITERATIONS holds the actual number of iterations that were performed.
+;;;; BEFORE holds the result of the function (times) at the very beginning of
+;;;; the excution of the benchmark, AFTER holds the result of the function
+;;;; (times) after the execution of the benchmark. GC-TIME, finally, holds
+;;;; the difference of calls to (gc-run-time) before and after the execution
+;;;; of the benchmark.
+;;;;
+;;;; This library provides some standard reporters for logging results
+;;;; to a file, reporting interesting results to the user, (FIXME: and
+;;;; collecting totals).
+;;;;
+;;;; You can use the REGISTER-REPORTER function and friends to add whatever
+;;;; reporting functions you like. See under ;;;; TIMING DATA to see how the
+;;;; library helps you to extract relevant timing information from the values
+;;;; ITERATIONS, BEFORE, AFTER and GC-TIME. If you don't register any
+;;;; reporters, the library uses USER-REPORTER, which writes the most
+;;;; interesting results to the standard output.
+
+
+;;;; TIME CALCULATION
+;;;;
+;;;; The library uses the guile functions `get-internal-run-time',
+;;;; `get-internal-real-time', and `gc-run-time' to determine the
+;;;; execution time for a single benchmark. Based on these functions,
+;;;; Guile makes a <benchmark-result>, a record containing the elapsed
+;;;; run time, real time, gc time, and possibly other metrics. These
+;;;; times include the time needed to executed the benchmark code
+;;;; itself, but also the surrounding code that implements the loop to
+;;;; run the benchmark code for the given number of times. This is
+;;;; undesirable, since one would prefer to only get the timing data for
+;;;; the benchmarking code.
+;;;;
+;;;; To cope with this, the benchmarking framework uses a trick: During
+;;;; initialization of the library, the time for executing an empty
+;;;; benchmark is measured and stored. This is an estimate for the time
+;;;; needed by the benchmarking framework itself. For later benchmarks,
+;;;; this time can then be subtracted from the measured execution times.
+;;;; Note that for very short benchmarks, this may result in a negative
+;;;; number.
+;;;;
+;;;; The benchmarking framework provides the following accessors for
+;;;; <benchmark-result> values. Note that all time values are in
+;;;; internal time units; divide by internal-time-units-per-second to
+;;;; get seconds.
+;;;;
+;;;; benchmark-result:name : Return the name of the benchmark.
+;;;;
+;;;; benchmark-result:iterations : Return the number of iterations that
+;;;; this benchmark ran for.
+;;;;
+;;;; benchmark-result:real-time : Return the clock time elapsed while
+;;;; this benchmark executed.
+;;;;
+;;;; benchmark-result:run-time : Return the CPU time elapsed while this
+;;;; benchmark executed, both in user and kernel space.
+;;;;
+;;;; benchmark-result:gc-time : Return the approximate amount of time
+;;;; spent in garbage collection while this benchmark executed, both
+;;;; in user and kernel space.
+;;;;
+;;;; benchmark-result:core-time : Like benchmark-result:run-time, but
+;;;; also estimates the time spent by the framework for the number
+;;;; of iterations, and subtracts off that time from the result.
+;;;;
+
+;;;; This module is used when benchmarking different Guiles, and so it
+;;;; should run on all the Guiles of interest. Currently this set
+;;;; includes Guile 1.8, so be careful with introducing features that
+;;;; only Guile 2.0 supports.
+
+
+;;;; MISCELLANEOUS
+;;;;
+
+(define-record-type <benchmark-result>
+ (make-benchmark-result name iterations real-time run-time gc-time)
+ benchmark-result?
+ (name benchmark-result:name)
+ (iterations benchmark-result:iterations)
+ (real-time benchmark-result:real-time)
+ (run-time benchmark-result:run-time)
+ (gc-time benchmark-result:gc-time))
+
+;;; Perform a division and convert the result to inexact.
+(define (->seconds time)
+ (/ time 1.0 internal-time-units-per-second))
+
+;;; Scale the number of iterations according to the given scaling factor.
+(define iteration-factor 1)
+(define (scale-iterations iterations)
+ (let* ((i (inexact->exact (round (* iterations iteration-factor)))))
+ (if (< i 1) 1 i)))
+
+;;; Parameters.
+(cond-expand
+ (srfi-39 #t)
+ (else (use-modules (srfi srfi-39))))
+
+;;;; CORE FUNCTIONS
+;;;;
+
+;;; The central routine for executing benchmarks.
+;;; The idea is taken from Greg, the GNUstep regression test environment.
+(define benchmark-running? (make-parameter #f))
+(define (run-benchmark name iterations thunk)
+ (if (benchmark-running?)
+ (error "Nested calls to run-benchmark are not permitted."))
+ (if (not (and (integer? iterations) (exact? iterations)))
+ (error "Expected exact integral number of iterations"))
+ (parameterize ((benchmark-running? #t))
+ ;; Warm up the benchmark first. This will resolve any toplevel-ref
+ ;; forms.
+ (thunk)
+ (gc)
+ (let* ((before-gc-time (gc-run-time))
+ (before-real-time (get-internal-real-time))
+ (before-run-time (get-internal-run-time)))
+ (do ((i iterations (1- i)))
+ ((zero? i))
+ (thunk))
+ (let ((after-run-time (get-internal-run-time))
+ (after-real-time (get-internal-real-time))
+ (after-gc-time (gc-run-time)))
+ (report (make-benchmark-result (full-name name) iterations
+ (- after-real-time before-real-time)
+ (- after-run-time before-run-time)
+ (- after-gc-time before-gc-time)))))))
+
+;;; A short form for benchmarks.
+(cond-expand
+ (guile-2
+ (define-syntax-rule (benchmark name iterations body body* ...)
+ (run-benchmark name iterations (lambda () body body* ...))))
+ (else
+ (defmacro benchmark (name iterations body . rest)
+ `(run-benchmark ,name ,iterations (lambda () ,body ,@rest)))))
+
+
+;;;; BENCHMARK NAMES
+;;;;
+
+;;;; Turn a benchmark name into a nice human-readable string.
+(define (format-benchmark-name name)
+ (string-join name ": "))
+
+;;;; For a given benchmark-name, deliver the full name including all prefixes.
+(define (full-name name)
+ (append (current-benchmark-prefix) (list name)))
+
+;;; A parameter containing the current benchmark prefix, as a list.
+(define current-benchmark-prefix
+ (make-parameter '()))
+
+;;; Postpend PREFIX to the current name prefix while evaluting THUNK.
+;;; The name prefix is only changed within the dynamic scope of the
+;;; call to with-benchmark-prefix*. Return the value returned by THUNK.
+(define (with-benchmark-prefix* prefix thunk)
+ (parameterize ((current-benchmark-prefix (full-name prefix)))
+ (thunk)))
+
+;;; (with-benchmark-prefix PREFIX BODY ...)
+;;; Postpend PREFIX to the current name prefix while evaluating BODY ...
+;;; The name prefix is only changed within the dynamic scope of the
+;;; with-benchmark-prefix expression. Return the value returned by the last
+;;; BODY expression.
+(cond-expand
+ (guile-2
+ (define-syntax-rule (with-benchmark-prefix prefix body body* ...)
+ (with-benchmark-prefix* prefix (lambda () body body* ...))))
+ (else
+ (defmacro with-benchmark-prefix (prefix . body)
+ `(with-benchmark-prefix* ,prefix (lambda () ,@body)))))
+
+
+;;;; Benchmark results
+;;;;
+
+(define *calibration-result*
+ "<will be set during initialization>")
+
+(define (benchmark-overhead iterations accessor)
+ (* (/ iterations 1.0 (benchmark-result:iterations *calibration-result*))
+ (accessor *calibration-result*)))
+
+(define (benchmark-result:core-time result)
+ (- (benchmark-result:run-time result)
+ (benchmark-overhead (benchmark-result:iterations result)
+ benchmark-result:run-time)))
+
+
+;;;; REPORTERS
+;;;;
+
+;;; The global set of reporters.
+(define report-hook (make-hook 1))
+
+(define (default-reporter result)
+ (if (hook-empty? report-hook)
+ (user-reporter result)
+ (run-hook report-hook result)))
+
+(define current-reporter
+ (make-parameter default-reporter))
+
+(define (register-reporter reporter)
+ (add-hook! report-hook reporter))
+
+(define (unregister-reporter reporter)
+ (remove-hook! report-hook reporter))
+
+;;; Return true iff REPORTER is in the current set of reporter functions.
+(define (reporter-registered? reporter)
+ (if (memq reporter (hook->list report-hook)) #t #f))
+
+;;; Send RESULT to all currently registered reporter functions.
+(define (report result)
+ ((current-reporter) result))
+
+
+;;;; Some useful standard reporters:
+;;;; Log reporters write all benchmark results to a given log file.
+;;;; Full reporters write all benchmark results to the standard output.
+;;;; User reporters write some interesting results to the standard output.
+
+;;; Display a single benchmark result to the given port
+(define (print-result port result)
+ (let ((name (format-benchmark-name (benchmark-result:name result)))
+ (iterations (benchmark-result:iterations result))
+ (real-time (benchmark-result:real-time result))
+ (run-time (benchmark-result:run-time result))
+ (gc-time (benchmark-result:gc-time result))
+ (core-time (benchmark-result:core-time result)))
+ (write (list name iterations
+ 'total (->seconds real-time)
+ 'user (->seconds run-time)
+ 'system 0
+ 'frame (->seconds (- run-time core-time))
+ 'benchmark (->seconds core-time)
+ 'user/interp (->seconds (- run-time gc-time))
+ 'bench/interp (->seconds (- core-time gc-time))
+ 'gc (->seconds gc-time))
+ port)
+ (newline port)))
+
+;;; Return a reporter procedure which prints all results to the file
+;;; FILE, in human-readable form. FILE may be a filename, or a port.
+(define (make-log-reporter file)
+ (let ((port (if (output-port? file) file
+ (open-output-file file))))
+ (lambda (result)
+ (print-result port result)
+ (force-output port))))
+
+;;; A reporter that reports all results to the user.
+(define (full-reporter result)
+ (print-result (current-output-port) result))
+
+;;; Display interesting results of a single benchmark to the given port
+(define (print-user-result port result)
+ (let ((name (format-benchmark-name (benchmark-result:name result)))
+ (iterations (benchmark-result:iterations result))
+ (real-time (benchmark-result:real-time result))
+ (run-time (benchmark-result:run-time result))
+ (gc-time (benchmark-result:gc-time result))
+ (core-time (benchmark-result:core-time result)))
+ (write (list name iterations
+ 'real (->seconds real-time)
+ 'real/iteration (->seconds (/ real-time iterations))
+ 'run/iteration (->seconds (/ run-time iterations))
+ 'core/iteration (->seconds (/ core-time iterations))
+ 'gc (->seconds gc-time))
+ port)
+ (newline port)))
+
+;;; A reporter that reports interesting results to the user.
+(define (user-reporter result)
+ (print-user-result (current-output-port) result))
+
+
+;;;; Initialize the benchmarking system:
+;;;;
+
+(define (calibrate-benchmark-framework)
+ (display ";; running guile version ")
+ (display (version))
+ (newline)
+ (display ";; calibrating the benchmarking framework...")
+ (newline)
+ (parameterize ((current-reporter
+ (lambda (result)
+ (set! *calibration-result* result)
+ (display ";; calibration: ")
+ (print-user-result (current-output-port) result))))
+ (benchmark "empty initialization benchmark" 10000000 #t)))
+
+(calibrate-benchmark-framework)
diff --git a/benchmark-suite/benchmarks/0-reference.bm b/benchmark-suite/benchmarks/0-reference.bm
new file mode 100644
index 000000000..3d02ee7b1
--- /dev/null
+++ b/benchmark-suite/benchmarks/0-reference.bm
@@ -0,0 +1,6 @@
+
+(define-module (benchmarks 0-reference)
+ :use-module (benchmark-suite lib))
+
+(benchmark "reference benchmark for iteration counts" 330000
+ #t)
diff --git a/benchmark-suite/benchmarks/arithmetic.bm b/benchmark-suite/benchmarks/arithmetic.bm
new file mode 100644
index 000000000..e0a9bf3c1
--- /dev/null
+++ b/benchmark-suite/benchmarks/arithmetic.bm
@@ -0,0 +1,67 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;; Integer arithmetic.
+;;;
+;;; Copyright 2010, 2012 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks arithmetic)
+ #:use-module (benchmark-suite lib))
+
+(define-syntax repeat
+ (lambda (s)
+ ;; Construct an expression of the form `(OP (OP (OP SEED)))', with a
+ ;; depth of COUNT.
+ (syntax-case s (<>)
+ ((_ (op x <>) seed count) ;; binary OP
+ (number? (syntax->datum #'count))
+ (let loop ((count (syntax->datum #'count))
+ (result #'seed))
+ (if (= 0 count)
+ result
+ (loop (1- count)
+ (with-syntax ((result result))
+ #'(op x result))))))
+ ((_ (op <>) seed count) ;; unary OP
+ (number? (syntax->datum #'count))
+ (let loop ((count (syntax->datum #'count))
+ (result #'seed))
+ (if (= 0 count)
+ result
+ (loop (1- count)
+ (with-syntax ((result result))
+ #'(op result)))))))))
+
+
+(with-benchmark-prefix "fixnum"
+
+ (benchmark "1+" #e1e7
+ (repeat (1+ <>) 2 100))
+
+ (benchmark "1-" #e1e7
+ (repeat (1- <>) 2 100))
+
+ (benchmark "+" #e1e7
+ (repeat (+ 2 <>) 7 100))
+
+ (benchmark "-" #e1e7
+ (repeat (- 2 <>) 7 100))
+
+ (benchmark "*" #e1e7
+ (repeat (* 1 <>) 1 100))
+
+ (benchmark "/" #e1e7
+ (repeat (/ 2 <>) 1 100)))
diff --git a/benchmark-suite/benchmarks/bytevector-io.bm b/benchmark-suite/benchmarks/bytevector-io.bm
new file mode 100644
index 000000000..7ae7c0e02
--- /dev/null
+++ b/benchmark-suite/benchmarks/bytevector-io.bm
@@ -0,0 +1,52 @@
+;;; bytevector-io.bm --- Exercise bytevector I/O primitives. -*- Scheme -*-
+;;;
+;;; Copyright (C) 2008, 2017 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks bytevector-io)
+ :use-module (benchmark-suite lib)
+ :use-module (rnrs io ports)
+ :use-module (rnrs bytevectors))
+
+(define file-name
+ (tmpnam))
+
+(define %buffer-size
+ 7777)
+
+(define buf
+ (make-u8vector %buffer-size))
+
+
+(with-benchmark-prefix "bytevector i/o"
+
+ (benchmark "put-bytevector" 4000
+ (let ((output (open-output-file file-name)))
+ (put-bytevector output buf)
+ (close output)))
+
+ (benchmark "get-bytevector-n!" 20000
+ (let ((input (open-input-file file-name)))
+ (setvbuf input 'none)
+ (get-bytevector-n! input buf 0 (bytevector-length buf))
+ (close input)))
+
+ (benchmark "get-bytevector-n" 20000
+ (let ((input (open-input-file file-name)))
+ (setvbuf input 'none)
+ (get-bytevector-n input (bytevector-length buf))
+ (close input))))
diff --git a/benchmark-suite/benchmarks/bytevectors.bm b/benchmark-suite/benchmarks/bytevectors.bm
new file mode 100644
index 000000000..b30bb38cd
--- /dev/null
+++ b/benchmark-suite/benchmarks/bytevectors.bm
@@ -0,0 +1,99 @@
+;;; -*- mode: scheme; coding: iso-8859-1; -*-
+;;; R6RS Byte Vectors.
+;;;
+;;; Copyright 2009, 2010 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks bytevector)
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-4)
+ #:use-module (benchmark-suite lib))
+
+(define bv (make-bytevector 16384))
+
+(define %native-endianness
+ (native-endianness))
+
+(define %foreign-endianness
+ (if (eq? (native-endianness) (endianness little))
+ (endianness big)
+ (endianness little)))
+
+(define u8v (make-u8vector 16384))
+(define u16v (make-u16vector 8192))
+(define u32v (make-u32vector 4196))
+(define u64v (make-u64vector 2048))
+
+
+(with-benchmark-prefix "ref/set!"
+
+ (benchmark "bytevector-u8-ref" 1000000
+ (bytevector-u8-ref bv 0))
+
+ (benchmark "bytevector-u16-ref (foreign)" 1000000
+ (bytevector-u16-ref bv 0 %foreign-endianness))
+
+ (benchmark "bytevector-u16-ref (native)" 1000000
+ (bytevector-u16-ref bv 0 %native-endianness))
+
+ (benchmark "bytevector-u16-native-ref" 1000000
+ (bytevector-u16-native-ref bv 0))
+
+ (benchmark "bytevector-u32-ref (foreign)" 1000000
+ (bytevector-u32-ref bv 0 %foreign-endianness))
+
+ (benchmark "bytevector-u32-ref (native)" 1000000
+ (bytevector-u32-ref bv 0 %native-endianness))
+
+ (benchmark "bytevector-u32-native-ref" 1000000
+ (bytevector-u32-native-ref bv 0))
+
+ (benchmark "bytevector-u64-ref (foreign)" 1000000
+ (bytevector-u64-ref bv 0 %foreign-endianness))
+
+ (benchmark "bytevector-u64-ref (native)" 1000000
+ (bytevector-u64-ref bv 0 %native-endianness))
+
+ (benchmark "bytevector-u64-native-ref" 1000000
+ (bytevector-u16-native-ref bv 0)))
+
+
+(with-benchmark-prefix "lists"
+
+ (benchmark "bytevector->u8-list" 2000
+ (bytevector->u8-list bv))
+
+ (benchmark "bytevector->uint-list 16-bit" 2000
+ (bytevector->uint-list bv (native-endianness) 2))
+
+ (benchmark "bytevector->uint-list 64-bit" 2000
+ (bytevector->uint-list bv (native-endianness) 8)))
+
+
+(with-benchmark-prefix "SRFI-4" ;; for comparison
+
+ (benchmark "u8vector-ref" 1000000
+ (u8vector-ref u8v 0))
+
+ (benchmark "u16vector-ref" 1000000
+ (u16vector-ref u16v 0))
+
+ (benchmark "u32vector-ref" 1000000
+ (u32vector-ref u32v 0))
+
+ (benchmark "u64vector-ref" 1000000
+ (u64vector-ref u64v 0)))
diff --git a/benchmark-suite/benchmarks/chars.bm b/benchmark-suite/benchmarks/chars.bm
new file mode 100644
index 000000000..6ae0e60bd
--- /dev/null
+++ b/benchmark-suite/benchmarks/chars.bm
@@ -0,0 +1,57 @@
+;;; coding: latin1 -*- mode: scheme; coding: latin-1; -*-
+;;; chars.bm
+;;;
+;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks chars)
+ :use-module (benchmark-suite lib))
+
+
+(with-benchmark-prefix "chars"
+
+ (benchmark "char" 1000000
+ #\a)
+
+ (benchmark "octal" 1000000
+ #\123)
+
+ (benchmark "char? eq" 1000000
+ (char? #\a))
+
+ (benchmark "char=?" 1000000
+ (char=? #\a #\a))
+
+ (benchmark "char<?" 1000000
+ (char=? #\a #\a))
+
+ (benchmark "char-ci=?" 1000000
+ (char=? #\a #\a))
+
+ (benchmark "char-ci<? " 1000000
+ (char=? #\a #\a))
+
+ (benchmark "char->integer" 1000000
+ (char->integer #\a))
+
+ (benchmark "char-alphabetic?" 1000000
+ (char-upcase #\a))
+
+ (benchmark "char-numeric?" 1000000
+ (char-upcase #\a)))
+
diff --git a/benchmark-suite/benchmarks/continuations.bm b/benchmark-suite/benchmarks/continuations.bm
new file mode 100644
index 000000000..3ca498da5
--- /dev/null
+++ b/benchmark-suite/benchmarks/continuations.bm
@@ -0,0 +1,9 @@
+
+(define-module (benchmarks continuations)
+ :use-module (benchmark-suite lib))
+
+(define (callee continuation)
+ (continuation #t))
+
+(benchmark "call/cc" 12000
+ (call-with-current-continuation callee))
diff --git a/benchmark-suite/benchmarks/hash.bm b/benchmark-suite/benchmarks/hash.bm
new file mode 100644
index 000000000..9c2be57a1
--- /dev/null
+++ b/benchmark-suite/benchmarks/hash.bm
@@ -0,0 +1,53 @@
+;;; hash.bm --- Hash functions. -*- Scheme -*-
+;;;
+;;; Copyright (C) 2015 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks write)
+ #:use-module (benchmark-suite lib))
+
+(define %narrow-string
+ (make-string 30 #\a))
+
+(define %wide-string
+ (make-string 30 #\λ))
+
+(define %long-string
+ (make-string 300 #\x))
+
+(define-syntax repeat
+ (lambda (s)
+ (syntax-case s ()
+ ((_ 1 exp)
+ #'exp)
+ ((_ count exp)
+ (with-syntax ((count (- (syntax->datum #'count) 1)))
+ #'(begin
+ exp
+ (repeat count exp)))))))
+
+
+(with-benchmark-prefix "string-hash"
+
+ (benchmark "narrow string" 100000
+ (repeat 100 (string-hash %narrow-string)))
+
+ (benchmark "wide string" 100000
+ (repeat 100 (string-hash %wide-string)))
+
+ (benchmark "long string" 100000
+ (repeat 100 (string-hash %long-string))))
diff --git a/benchmark-suite/benchmarks/if.bm b/benchmark-suite/benchmarks/if.bm
new file mode 100644
index 000000000..70aa8debf
--- /dev/null
+++ b/benchmark-suite/benchmarks/if.bm
@@ -0,0 +1,55 @@
+
+(define-module (benchmarks if)
+ :use-module (benchmark-suite lib))
+
+(with-benchmark-prefix "if-<expr>-then-else"
+
+ (benchmark "executing then" 330000
+ (if (quote #t) #t #f))
+
+ (benchmark "executing else" 330000
+ (if (quote #f) #t #f)))
+
+(with-benchmark-prefix "if-<expr>-then"
+
+ (benchmark "executing then" 330000
+ (if (quote #t) #t))
+
+ (benchmark "executing else" 330000
+ (if (quote #f) #t)))
+
+(with-benchmark-prefix "if-<iloc>-then-else"
+
+ (let ((x #t))
+ (benchmark "executing then" 330000
+ (if x #t #f)))
+
+ (let ((x #f))
+ (benchmark "executing else" 330000
+ (if x #t #f))))
+
+(with-benchmark-prefix "if-<iloc>-then"
+
+ (let ((x #t))
+ (benchmark "executing then" 330000
+ (if x #t)))
+
+ (let ((x #f))
+ (benchmark "executing else" 330000
+ (if x #t))))
+
+(with-benchmark-prefix "if-<bool>-then-else"
+
+ (benchmark "executing then" 330000
+ (if #t #t #f))
+
+ (benchmark "executing else" 330000
+ (if #f #t #f)))
+
+(with-benchmark-prefix "if-<bool>-then"
+
+ (benchmark "executing then" 330000
+ (if #t #t))
+
+ (benchmark "executing else" 330000
+ (if #f #t)))
diff --git a/benchmark-suite/benchmarks/logand.bm b/benchmark-suite/benchmarks/logand.bm
new file mode 100644
index 000000000..c94ad3167
--- /dev/null
+++ b/benchmark-suite/benchmarks/logand.bm
@@ -0,0 +1,10 @@
+
+(define-module (benchmarks logand)
+ :use-module (benchmark-suite lib))
+
+(define bignum (1- (expt 2 128)))
+
+(let* ((i 0))
+ (benchmark "bignum" 130000
+ (logand i bignum)
+ (set! i (+ i 1))))
diff --git a/benchmark-suite/benchmarks/ports.bm b/benchmark-suite/benchmarks/ports.bm
new file mode 100644
index 000000000..417725531
--- /dev/null
+++ b/benchmark-suite/benchmarks/ports.bm
@@ -0,0 +1,95 @@
+;;; ports.bm --- Port I/O. -*- mode: scheme; coding: utf-8; -*-
+;;;
+;;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks ports)
+ #:use-module (ice-9 rdelim)
+ #:use-module (benchmark-suite lib))
+
+(define-syntax sequence
+ (lambda (s)
+ ;; Create a sequence `(begin EXPR ...)' with COUNT occurrences of EXPR.
+ (syntax-case s ()
+ ((_ expr count)
+ (number? (syntax->datum #'count))
+ (cons #'begin
+ (make-list (syntax->datum #'count) #'expr))))))
+
+(define (large-string s)
+ (string-concatenate (make-list (* iteration-factor 10000) s)))
+
+(define %latin1-port
+ (let ((p (open-input-string (large-string "hello, world"))))
+ (set-port-encoding! p "ISO-8859-1")
+ p))
+
+(define %utf8/ascii-port
+ (open-input-string (large-string "hello, world")))
+
+(define %utf8/wide-port
+ (open-input-string (large-string "안녕하세요")))
+
+
+(with-benchmark-prefix "peek-char"
+
+ (benchmark "latin-1 port" 700
+ (sequence (peek-char %latin1-port) 1000))
+
+ (benchmark "utf-8 port, ascii character" 700
+ (sequence (peek-char %utf8/ascii-port) 1000))
+
+ (benchmark "utf-8 port, Korean character" 700
+ (sequence (peek-char %utf8/wide-port) 1000)))
+
+(with-benchmark-prefix "char-ready?"
+
+ (benchmark "latin-1 port" 10000
+ (sequence (char-ready? %latin1-port) 1000))
+
+ (benchmark "utf-8 port, ascii character" 10000
+ (sequence (char-ready? %utf8/ascii-port) 1000))
+
+ (benchmark "utf-8 port, Korean character" 10000
+ (sequence (char-ready? %utf8/wide-port) 1000)))
+
+;; Keep the `read-char' benchmarks last as they consume input from the
+;; ports.
+
+(with-benchmark-prefix "read-char"
+
+ (benchmark "latin-1 port" 10000
+ (sequence (read-char %latin1-port) 1000))
+
+ (benchmark "utf-8 port, ascii character" 10000
+ (sequence (read-char %utf8/ascii-port) 1000))
+
+ (benchmark "utf-8 port, Korean character" 10000
+ (sequence (read-char %utf8/wide-port) 1000)))
+
+
+(with-benchmark-prefix "rdelim"
+
+ (let ((str (string-concatenate (make-list 1000 "one line\n"))))
+ (benchmark "read-line" 1000
+ (let ((port (open-input-string str)))
+ (sequence (read-line port) 1000))))
+
+ (let ((str (large-string "Hello, world.\n")))
+ (benchmark "read-string" 200
+ (let ((port (open-input-string str)))
+ (read-string port)))))
diff --git a/benchmark-suite/benchmarks/r6rs-arithmetic.bm b/benchmark-suite/benchmarks/r6rs-arithmetic.bm
new file mode 100644
index 000000000..309f0666b
--- /dev/null
+++ b/benchmark-suite/benchmarks/r6rs-arithmetic.bm
@@ -0,0 +1,35 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;; R6RS-specific arithmetic benchmarks
+;;;
+;;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (benchmarks r6rs-arithmetic)
+ #:use-module (benchmark-suite lib)
+ #:use-module (rnrs arithmetic fixnums))
+
+
+(with-benchmark-prefix "fixnum"
+
+ (benchmark "fixnum? [yes]" #e1e7
+ (fixnum? 10000))
+
+ (let ((n (+ most-positive-fixnum 100)))
+ (benchmark "fixnum? [no]" #e1e7
+ (fixnum? n)))
+
+ (benchmark "fxxor [2]" #e1e7
+ (fxxor 3 8)))
diff --git a/benchmark-suite/benchmarks/read.bm b/benchmark-suite/benchmarks/read.bm
new file mode 100644
index 000000000..a4ff9936f
--- /dev/null
+++ b/benchmark-suite/benchmarks/read.bm
@@ -0,0 +1,73 @@
+;;; read.bm --- Exercise the reader. -*- Scheme -*-
+;;;
+;;; Copyright (C) 2008, 2010, 2012 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks read)
+ :use-module (benchmark-suite lib))
+
+
+(define %files-to-load
+ ;; Various large Scheme files.
+ (map %search-load-path
+ '("ice-9/boot-9.scm" "ice-9/common-list.scm"
+ "ice-9/format.scm" "ice-9/optargs.scm"
+ "ice-9/session.scm" "ice-9/getopt-long.scm"
+ "ice-9/psyntax-pp.scm")))
+
+(define (load-file-with-reader file-name reader buffering)
+ (with-input-from-file file-name
+ (lambda ()
+ (apply setvbuf (current-input-port) buffering)
+ (let loop ((sexp (reader)))
+ (if (eof-object? sexp)
+ #t
+ (loop (reader)))))))
+
+(define (exercise-read buffering)
+ (for-each (lambda (file)
+ (load-file-with-reader file read buffering))
+ %files-to-load))
+
+(define small "\"hello, world!\"")
+(define large (string-append "\"" (make-string 1234 #\A) "\""))
+
+(fluid-set! %default-port-encoding "UTF-8") ; for string ports
+
+
+(with-benchmark-prefix "read"
+
+ (benchmark "'none" 5 ;; this one is very slow
+ (exercise-read (list 'none)))
+
+ (benchmark "'line" 10
+ (exercise-read (list 'line)))
+
+ (benchmark "'block 4096" 10
+ (exercise-read (list 'block 4096)))
+
+ (benchmark "'block 8192" 10
+ (exercise-read (list 'block 8192)))
+
+ (benchmark "'block 16384" 10
+ (exercise-read (list 'block 16384)))
+
+ (benchmark "small strings" 100000
+ (call-with-input-string small read))
+
+ (benchmark "large strings" 100000
+ (call-with-input-string large read)))
diff --git a/benchmark-suite/benchmarks/srfi-1.bm b/benchmark-suite/benchmarks/srfi-1.bm
new file mode 100644
index 000000000..67f79ca24
--- /dev/null
+++ b/benchmark-suite/benchmarks/srfi-1.bm
@@ -0,0 +1,64 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;; SRFI-1.
+;;;
+;;; Copyright 2010, 2011 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks srfi-1)
+ #:use-module (srfi srfi-1)
+ #:use-module (benchmark-suite lib))
+
+(define %big-list
+ (iota 1000000))
+
+(define %small-list
+ (iota 10))
+
+
+(with-benchmark-prefix "fold"
+
+ (benchmark "big" 30
+ (fold (lambda (x y) y) #f %big-list))
+
+ (benchmark "small" 2000000
+ (fold (lambda (x y) y) #f %small-list)))
+
+
+(with-benchmark-prefix "drop-while"
+
+ (benchmark "big" 30
+ (drop-while (lambda (n) #t) %big-list))
+
+ (benchmark "small" 2000000
+ (drop-while (lambda (n) #t) %small-list)))
+
+(with-benchmark-prefix "map"
+
+ (benchmark "big" 30
+ (map (lambda (x) x) %big-list))
+
+ (benchmark "small" 2000000
+ (map (lambda (x) x) %small-list)))
+
+(with-benchmark-prefix "for-each"
+
+ (benchmark "big" 30
+ (for-each (lambda (x) #f) %big-list))
+
+ (benchmark "small" 2000000
+ (for-each (lambda (x) #f) %small-list)))
+
diff --git a/benchmark-suite/benchmarks/srfi-13.bm b/benchmark-suite/benchmarks/srfi-13.bm
new file mode 100644
index 000000000..a9ee27615
--- /dev/null
+++ b/benchmark-suite/benchmarks/srfi-13.bm
@@ -0,0 +1,310 @@
+;;; coding: latin1 -*- mode: scheme; coding: latin-1; -*-
+;;; srfi-13.bm
+;;;
+;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks strings)
+ :use-module (benchmark-suite lib))
+
+(seed->random-state 1)
+
+(define short-string "Hi")
+(define medium-string
+"ARMA virumque cano, Troiae qui primus ab oris
+Italiam, fato profugus, Laviniaque venit")
+(define long-string
+ (string-tabulate
+ (lambda (n) (integer->char (+ 32 (random 90))))
+ 1000))
+
+(define short-chlist (string->list short-string))
+(define medium-chlist (string->list medium-string))
+(define long-chlist (string->list long-string))
+
+(define str1 (string-copy short-string))
+(define str2 (string-copy medium-string))
+(define str3 (string-copy long-string))
+
+
+(with-benchmark-prefix "strings"
+
+ (with-benchmark-prefix "predicates"
+
+ (benchmark "string?" 1190000
+ (string? short-string)
+ (string? medium-string)
+ (string? long-string))
+
+ (benchmark "null?" 969000
+ (string-null? short-string)
+ (string-null? medium-string)
+ (string-null? long-string))
+
+ (benchmark "any" 94000
+ (string-any #\a short-string)
+ (string-any #\a medium-string)
+ (string-any #\a long-string))
+
+ (benchmark "every" 94000
+ (string-every #\a short-string)
+ (string-every #\a medium-string)
+ (string-every #\a long-string)))
+
+ (with-benchmark-prefix "constructors"
+
+ (benchmark "string" 5000
+ (apply string short-chlist)
+ (apply string medium-chlist)
+ (apply string long-chlist))
+
+ (benchmark "list->" 4500
+ (list->string short-chlist)
+ (list->string medium-chlist)
+ (list->string long-chlist))
+
+ (benchmark "reverse-list->" 5000
+ (reverse-list->string short-chlist)
+ (reverse-list->string medium-chlist)
+ (reverse-list->string long-chlist))
+
+ (benchmark "make" 22000
+ (make-string 250 #\x))
+
+ (benchmark "tabulate" 17000
+ (string-tabulate integer->char 250))
+
+ (benchmark "join" 5500
+ (string-join (list short-string medium-string long-string) "|" 'suffix)))
+
+ (with-benchmark-prefix "list/string"
+ (benchmark "->list" 7300
+ (string->list short-string)
+ (string->list medium-string)
+ (string->list long-string))
+
+ (benchmark "split" 60000
+ (string-split short-string #\a)
+ (string-split medium-string #\a)
+ (string-split long-string #\a)))
+
+ (with-benchmark-prefix "selection"
+
+ (benchmark "ref" 660
+ (let loop ((k 0))
+ (if (< k (string-length short-string))
+ (begin
+ (string-ref short-string k)
+ (loop (+ k 1)))))
+ (let loop ((k 0))
+ (if (< k (string-length medium-string))
+ (begin
+ (string-ref medium-string k)
+ (loop (+ k 1)))))
+ (let loop ((k 0))
+ (if (< k (string-length long-string))
+ (begin
+ (string-ref long-string k)
+ (loop (+ k 1))))))
+
+ (benchmark "copy" 20000
+ (string-copy short-string)
+ (string-copy medium-string)
+ (string-copy long-string)
+ (substring/copy short-string 0 1)
+ (substring/copy medium-string 10 20)
+ (substring/copy long-string 100 200))
+
+ (benchmark "pad" 34000
+ (string-pad short-string 100)
+ (string-pad medium-string 100)
+ (string-pad long-string 100))
+
+ (benchmark "trim trim-right trim-both" 60000
+ (string-trim short-string char-alphabetic?)
+ (string-trim medium-string char-alphabetic?)
+ (string-trim long-string char-alphabetic?)
+ (string-trim-right short-string char-alphabetic?)
+ (string-trim-right medium-string char-alphabetic?)
+ (string-trim-right long-string char-alphabetic?)
+ (string-trim-both short-string char-alphabetic?)
+ (string-trim-both medium-string char-alphabetic?)
+ (string-trim-both long-string char-alphabetic?)))
+
+ (with-benchmark-prefix "modification"
+
+ (set! str1 (string-copy short-string))
+ (set! str2 (string-copy medium-string))
+ (set! str3 (string-copy long-string))
+
+ (benchmark "set!" 3000
+ (let loop ((k 1))
+ (if (< k (string-length short-string))
+ (begin
+ (string-set! str1 k #\x)
+ (loop (+ k 1)))))
+ (let loop ((k 20))
+ (if (< k (string-length medium-string))
+ (begin
+ (string-set! str2 k #\x)
+ (loop (+ k 1)))))
+ (let loop ((k 900))
+ (if (< k (string-length long-string))
+ (begin
+ (string-set! str3 k #\x)
+ (loop (+ k 1))))))
+
+ (set! str1 (string-copy short-string))
+ (set! str2 (string-copy medium-string))
+ (set! str3 (string-copy long-string))
+
+ (benchmark "sub-move!" 230000
+ (substring-move! short-string 0 2 str2 10)
+ (substring-move! medium-string 10 20 str3 20))
+
+ (set! str1 (string-copy short-string))
+ (set! str2 (string-copy medium-string))
+ (set! str3 (string-copy long-string))
+
+ (benchmark "fill!" 230000
+ (string-fill! str1 #\y 0 1)
+ (string-fill! str2 #\y 10 20)
+ (string-fill! str3 #\y 20 30))
+
+ (with-benchmark-prefix "comparison"
+
+ (benchmark "compare compare-ci" 140000
+ (string-compare short-string medium-string string<? string=? string>?)
+ (string-compare long-string medium-string string<? string=? string>?)
+ (string-compare-ci short-string medium-string string<? string=? string>?)
+ (string-compare-ci long-string medium-string string<? string=? string>?))
+
+ (benchmark "hash hash-ci" 1000
+ (string-hash short-string)
+ (string-hash medium-string)
+ (string-hash long-string)
+ (string-hash-ci short-string)
+ (string-hash-ci medium-string)
+ (string-hash-ci long-string))))
+
+ (with-benchmark-prefix "searching" 20000
+
+ (benchmark "prefix-length suffix-length" 270
+ (string-prefix-length short-string
+ (string-append short-string medium-string))
+ (string-prefix-length long-string
+ (string-append long-string medium-string))
+ (string-suffix-length short-string
+ (string-append medium-string short-string))
+ (string-suffix-length long-string
+ (string-append medium-string long-string))
+ (string-prefix-length-ci short-string
+ (string-append short-string medium-string))
+ (string-prefix-length-ci long-string
+ (string-append long-string medium-string))
+ (string-suffix-length-ci short-string
+ (string-append medium-string short-string))
+ (string-suffix-length-ci long-string
+ (string-append medium-string long-string)))
+
+ (benchmark "prefix? suffix?" 270
+ (string-prefix? short-string
+ (string-append short-string medium-string))
+ (string-prefix? long-string
+ (string-append long-string medium-string))
+ (string-suffix? short-string
+ (string-append medium-string short-string))
+ (string-suffix? long-string
+ (string-append medium-string long-string))
+ (string-prefix-ci? short-string
+ (string-append short-string medium-string))
+ (string-prefix-ci? long-string
+ (string-append long-string medium-string))
+ (string-suffix-ci? short-string
+ (string-append medium-string short-string))
+ (string-suffix-ci? long-string
+ (string-append medium-string long-string)))
+
+ (benchmark "index index-right rindex" 100000
+ (string-index short-string #\T)
+ (string-index medium-string #\T)
+ (string-index long-string #\T)
+ (string-index-right short-string #\T)
+ (string-index-right medium-string #\T)
+ (string-index-right long-string #\T)
+ (string-rindex short-string #\T)
+ (string-rindex medium-string #\T)
+ (string-rindex long-string #\T))
+
+ (benchmark "skip skip-right?" 100000
+ (string-skip short-string char-alphabetic?)
+ (string-skip medium-string char-alphabetic?)
+ (string-skip long-string char-alphabetic?)
+ (string-skip-right short-string char-alphabetic?)
+ (string-skip-right medium-string char-alphabetic?)
+ (string-skip-right long-string char-alphabetic?))
+
+ (benchmark "count" 10000
+ (string-count short-string char-alphabetic?)
+ (string-count medium-string char-alphabetic?)
+ (string-count long-string char-alphabetic?))
+
+ (benchmark "contains contains-ci" 34000
+ (string-contains short-string short-string)
+ (string-contains medium-string (substring medium-string 10 15))
+ (string-contains long-string (substring long-string 100 130))
+ (string-contains-ci short-string short-string)
+ (string-contains-ci medium-string (substring medium-string 10 15))
+ (string-contains-ci long-string (substring long-string 100 130)))
+
+ (set! str1 (string-copy short-string))
+ (set! str2 (string-copy medium-string))
+ (set! str3 (string-copy long-string))
+
+ (benchmark "upcase downcase upcase! downcase!" 600
+ (string-upcase short-string)
+ (string-upcase medium-string)
+ (string-upcase long-string)
+ (string-downcase short-string)
+ (string-downcase medium-string)
+ (string-downcase long-string)
+ (string-upcase! str1 0 1)
+ (string-upcase! str2 10 20)
+ (string-upcase! str3 100 130)
+ (string-downcase! str1 0 1)
+ (string-downcase! str2 10 20)
+ (string-downcase! str3 100 130)))
+
+ (with-benchmark-prefix "readers"
+
+ (benchmark "read token, method 1" 1200
+ (let ((buf (make-string 512)))
+ (let loop ((i 0))
+ (if (< i 512)
+ (begin
+ (string-set! buf i #\x)
+ (loop (+ i 1)))
+ buf))))
+
+ (benchmark "read token, method 2" 1200
+ (let ((lst '()))
+ (let loop ((i 0))
+ (set! lst (append! lst (list #\x)))
+ (if (< i 512)
+ (loop (+ i 1))
+ (list->string lst)))))))
diff --git a/benchmark-suite/benchmarks/strings.bm b/benchmark-suite/benchmarks/strings.bm
new file mode 100644
index 000000000..1fcdbd5a7
--- /dev/null
+++ b/benchmark-suite/benchmarks/strings.bm
@@ -0,0 +1,537 @@
+;;; -*- Mode: scheme; coding: utf-8; -*-
+;;; strings.bm
+;;;
+;;; Copyright (C) 2011 Free Software Foundation, Inc.
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks strings)
+ #:use-module (benchmark-suite lib)
+ #:use-module (ice-9 i18n))
+
+(use-modules (ice-9 i18n))
+
+(seed->random-state 1)
+
+;; Start from a known locale state
+(setlocale LC_ALL "C")
+
+(define char-set:cased (char-set-union char-set:lower-case
+ char-set:upper-case
+ char-set:title-case))
+(define *latin1*
+ (char-set->list (char-set-xor
+ (char-set-intersection (ucs-range->char-set 0 255)
+ char-set:cased)
+ (->char-set #\µ)))) ; Can't do a case-insensitive comparison of a string
+ ; with mu in fr_FR.iso88591 since it case-folds into a
+ ; non-Latin-1 character.
+
+(define *cased*
+ (char-set->list char-set:cased))
+
+(define (random-string c-list n)
+ (let ((len (length c-list)))
+ (apply string
+ (map
+ (lambda (x)
+ (list-ref c-list (random len)))
+ (iota n)))))
+
+(define (diff-at-start str)
+ (string-append "!" (substring str 1)))
+(define (diff-in-middle str)
+ (let ((x (floor (/ (string-length str) 2))))
+ (string-append (substring str 0 x)
+ "!"
+ (substring str (1+ x)))))
+(define (diff-at-end str)
+ (string-append (substring str 0 (1- (string-length str)))
+ "!"))
+
+(define short-latin1-string (random-string *latin1* 10))
+(define medium-latin1-string (random-string *latin1* 100))
+(define long-latin1-string (random-string *latin1* 1000))
+
+(define short-latin1-string-diff-at-start (diff-at-start short-latin1-string))
+(define medium-latin1-string-diff-at-start (diff-at-start medium-latin1-string))
+(define long-latin1-string-diff-at-start (diff-at-start long-latin1-string))
+
+(define short-latin1-string-diff-in-middle (diff-in-middle short-latin1-string))
+(define medium-latin1-string-diff-in-middle (diff-in-middle medium-latin1-string))
+(define long-latin1-string-diff-in-middle (diff-in-middle long-latin1-string))
+
+(define short-latin1-string-diff-at-end (diff-at-end short-latin1-string))
+(define medium-latin1-string-diff-at-end (diff-at-end medium-latin1-string))
+(define long-latin1-string-diff-at-end (diff-at-end long-latin1-string))
+
+(define short-cased-string (random-string *cased* 10))
+(define medium-cased-string (random-string *cased* 100))
+(define long-cased-string (random-string *cased* 1000))
+
+(define short-cased-string-diff-at-start (diff-at-start short-cased-string))
+(define medium-cased-string-diff-at-start (diff-at-start medium-cased-string))
+(define long-cased-string-diff-at-start (diff-at-start long-cased-string))
+
+(define short-cased-string-diff-in-middle (diff-in-middle short-cased-string))
+(define medium-cased-string-diff-in-middle (diff-in-middle medium-cased-string))
+(define long-cased-string-diff-in-middle (diff-in-middle long-cased-string))
+
+(define short-cased-string-diff-at-end (diff-at-end short-cased-string))
+(define medium-cased-string-diff-at-end (diff-at-end medium-cased-string))
+(define long-cased-string-diff-at-end (diff-at-end long-cased-string))
+
+(define %french-locale-name "fr_FR.ISO-8859-1")
+
+(define %french-utf8-locale-name "fr_FR.UTF-8")
+
+(define %french-locale
+ (false-if-exception
+ (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
+ %french-locale-name)))
+
+(define %french-utf8-locale
+ (false-if-exception
+ (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
+ %french-utf8-locale-name)))
+
+(define (under-locale-or-unresolved locale thunk)
+ ;; On non-GNU systems, an exception may be raised only when the locale is
+ ;; actually used rather than at `make-locale'-time. Thus, we must guard
+ ;; against both.
+ (if locale
+ (if (string-contains %host-type "-gnu")
+ (thunk)
+ (catch 'system-error thunk
+ (lambda (key . args)
+ (throw 'unresolved))))
+ (throw 'unresolved)))
+
+(define (under-french-locale-or-unresolved thunk)
+ (under-locale-or-unresolved %french-locale thunk))
+
+(define (under-french-utf8-locale-or-unresolved thunk)
+ (under-locale-or-unresolved %french-utf8-locale thunk))
+
+(define (string-op str1 str2)
+ (string<? str1 str2)
+ (string>? str1 str2))
+
+(define (string-ci-op str1 str2)
+ (string-ci<? str1 str2)
+ (string-ci>? str1 str2))
+
+(define (string-fr-op str1 str2)
+ (under-french-locale-or-unresolved
+ (lambda ()
+ (string-locale<? str1 str2 %french-locale)
+ (string-locale>? str1 str2 %french-locale))))
+
+(define (string-fr-utf8-op str1 str2)
+ (under-french-utf8-locale-or-unresolved
+ (lambda ()
+ (string-locale<? str1 str2 %french-utf8-locale)
+ (string-locale>? str1 str2 %french-utf8-locale))))
+
+(define (string-fr-ci-op str1 str2)
+ (under-french-locale-or-unresolved
+ (lambda ()
+ (string-locale-ci<? str1 str2 %french-locale)
+ (string-locale-ci>? str1 str2 %french-locale))))
+
+(define (string-fr-utf8-ci-op str1 str2)
+ (under-french-utf8-locale-or-unresolved
+ (lambda ()
+ (string-locale-ci<? str1 str2 %french-utf8-locale)
+ (string-locale-ci>? str1 str2 %french-utf8-locale))))
+
+
+(with-benchmark-prefix "string ops"
+
+ (with-benchmark-prefix "short Latin1"
+
+ (benchmark "compare initially differing strings" 100000
+ (string-op short-latin1-string short-latin1-string-diff-at-start))
+
+ (benchmark "compare medially differing strings" 100000
+ (string-op short-latin1-string short-latin1-string-diff-in-middle))
+
+ (benchmark "compare terminally differing strings" 100000
+ (string-op short-latin1-string short-latin1-string-diff-at-end))
+
+ (benchmark "compare identical strings" 100000
+ (string-op short-latin1-string short-latin1-string))
+
+ (benchmark "case compare initially differing strings" 100000
+ (string-ci-op short-latin1-string short-latin1-string-diff-at-start))
+
+ (benchmark "case compare medially differing strings" 100000
+ (string-ci-op short-latin1-string short-latin1-string-diff-in-middle))
+
+ (benchmark "case compare terminally differing strings" 100000
+ (string-ci-op short-latin1-string short-latin1-string-diff-at-end))
+
+ (benchmark "case compare identical strings" 100000
+ (string-ci-op short-latin1-string short-latin1-string))
+
+ (benchmark "French Latin-1 locale compare initially differing strings" 100000
+ (string-fr-op short-latin1-string short-latin1-string-diff-at-start))
+
+ (benchmark "French Latin-1 locale compare medially differing strings" 100000
+ (string-fr-op short-latin1-string short-latin1-string-diff-in-middle))
+
+ (benchmark "French Latin-1 locale compare terminally differing strings" 100000
+ (string-fr-op short-latin1-string short-latin1-string-diff-at-end))
+
+ (benchmark "French Latin-1 locale compare identical strings" 100000
+ (string-fr-op short-latin1-string short-latin1-string))
+
+ (benchmark "French Latin-1 locale case compare initially differing strings" 100000
+ (string-fr-ci-op short-latin1-string short-latin1-string-diff-at-start))
+
+ (benchmark "French Latin-1 locale case compare medially differing strings" 100000
+ (string-fr-ci-op short-latin1-string short-latin1-string-diff-in-middle))
+
+ (benchmark "French Latin-1 locale case compare terminally differing strings" 100000
+ (string-fr-ci-op short-latin1-string short-latin1-string-diff-at-end))
+
+ (benchmark "French Latin-1 locale case compare identical strings" 100000
+ (string-fr-ci-op short-latin1-string short-latin1-string))
+
+ (benchmark "French UTF-8 locale compare initially differing strings" 100000
+ (string-fr-utf8-op short-latin1-string short-latin1-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale compare medially differing strings" 100000
+ (string-fr-utf8-op short-latin1-string short-latin1-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale compare terminally differing strings" 100000
+ (string-fr-utf8-op short-latin1-string short-latin1-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale compare identical strings" 100000
+ (string-fr-utf8-op short-latin1-string short-latin1-string))
+
+ (benchmark "French UTF-8 locale case compare initially differing strings" 100000
+ (string-fr-utf8-ci-op short-latin1-string short-latin1-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale case compare medially differing strings" 100000
+ (string-fr-utf8-ci-op short-latin1-string short-latin1-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale case compare terminally differing strings" 100000
+ (string-fr-utf8-ci-op short-latin1-string short-latin1-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale case compare identical strings" 100000
+ (string-fr-utf8-ci-op short-latin1-string short-latin1-string)))
+
+ (with-benchmark-prefix "medium Latin1"
+
+ (benchmark "compare initially differing strings" 10000
+ (string-op medium-latin1-string medium-latin1-string-diff-at-start))
+
+ (benchmark "compare medially differing strings" 10000
+ (string-op medium-latin1-string medium-latin1-string-diff-in-middle))
+
+ (benchmark "compare terminally differing strings" 10000
+ (string-op medium-latin1-string medium-latin1-string-diff-at-end))
+
+ (benchmark "compare identical strings" 10000
+ (string-op medium-latin1-string medium-latin1-string))
+
+ (benchmark "case compare initially differing strings" 10000
+ (string-ci-op medium-latin1-string medium-latin1-string-diff-at-start))
+
+ (benchmark "case compare medially differing strings" 10000
+ (string-ci-op medium-latin1-string medium-latin1-string-diff-in-middle))
+
+ (benchmark "case compare terminally differing strings" 10000
+ (string-ci-op medium-latin1-string medium-latin1-string-diff-at-end))
+
+ (benchmark "case compare identical strings" 10000
+ (string-ci-op medium-latin1-string medium-latin1-string))
+
+ (benchmark "French Latin-1 locale compare initially differing strings" 10000
+ (string-fr-op medium-latin1-string medium-latin1-string-diff-at-start))
+
+ (benchmark "French Latin-1 locale compare medially differing strings" 10000
+ (string-fr-op medium-latin1-string medium-latin1-string-diff-in-middle))
+
+ (benchmark "French Latin-1 locale compare terminally differing strings" 10000
+ (string-fr-op medium-latin1-string medium-latin1-string-diff-at-end))
+
+ (benchmark "French Latin-1 locale compare identical strings" 10000
+ (string-fr-op medium-latin1-string medium-latin1-string))
+
+ (benchmark "French Latin-1 locale case compare initially differing strings" 10000
+ (string-fr-ci-op medium-latin1-string medium-latin1-string-diff-at-start))
+
+ (benchmark "French Latin-1 locale case compare medially differing strings" 10000
+ (string-fr-ci-op medium-latin1-string medium-latin1-string-diff-in-middle))
+
+ (benchmark "French Latin-1 locale case compare terminally differing strings" 10000
+ (string-fr-ci-op medium-latin1-string medium-latin1-string-diff-at-end))
+
+ (benchmark "French Latin-1 locale case compare identical strings" 10000
+ (string-fr-ci-op medium-latin1-string medium-latin1-string))
+
+ (benchmark "French UTF-8 locale compare initially differing strings" 10000
+ (string-fr-utf8-op medium-latin1-string medium-latin1-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale compare medially differing strings" 10000
+ (string-fr-utf8-op medium-latin1-string medium-latin1-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale compare terminally differing strings" 10000
+ (string-fr-utf8-op medium-latin1-string medium-latin1-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale compare identical strings" 10000
+ (string-fr-utf8-op medium-latin1-string medium-latin1-string))
+
+ (benchmark "French UTF-8 locale case compare initially differing strings" 10000
+ (string-fr-utf8-ci-op medium-latin1-string medium-latin1-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale case compare medially differing strings" 10000
+ (string-fr-utf8-ci-op medium-latin1-string medium-latin1-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale case compare terminally differing strings" 10000
+ (string-fr-utf8-ci-op medium-latin1-string medium-latin1-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale case compare identical strings" 10000
+ (string-fr-utf8-ci-op medium-latin1-string medium-latin1-string)))
+
+ (with-benchmark-prefix "long Latin1"
+
+ (benchmark "compare initially differing strings" 1000
+ (string-op long-latin1-string long-latin1-string-diff-at-start))
+
+ (benchmark "compare medially differing strings" 1000
+ (string-op long-latin1-string long-latin1-string-diff-in-middle))
+
+ (benchmark "compare terminally differing strings" 1000
+ (string-op long-latin1-string long-latin1-string-diff-at-end))
+
+ (benchmark "compare identical strings" 1000
+ (string-op long-latin1-string long-latin1-string))
+
+ (benchmark "case compare initially differing strings" 1000
+ (string-ci-op long-latin1-string long-latin1-string-diff-at-start))
+
+ (benchmark "case compare medially differing strings" 1000
+ (string-ci-op long-latin1-string long-latin1-string-diff-in-middle))
+
+ (benchmark "case compare terminally differing strings" 1000
+ (string-ci-op long-latin1-string long-latin1-string-diff-at-end))
+
+ (benchmark "case compare identical strings" 1000
+ (string-ci-op long-latin1-string long-latin1-string))
+
+ (benchmark "French Latin-1 locale compare initially differing strings" 1000
+ (string-fr-op long-latin1-string long-latin1-string-diff-at-start))
+
+ (benchmark "French Latin-1 locale compare medially differing strings" 1000
+ (string-fr-op long-latin1-string long-latin1-string-diff-in-middle))
+
+ (benchmark "French Latin-1 locale compare terminally differing strings" 1000
+ (string-fr-op long-latin1-string long-latin1-string-diff-at-end))
+
+ (benchmark "French Latin-1 locale compare identical strings" 1000
+ (string-fr-op long-latin1-string long-latin1-string))
+
+ (benchmark "French Latin-1 locale case compare initially differing strings" 1000
+ (string-fr-ci-op long-latin1-string long-latin1-string-diff-at-start))
+
+ (benchmark "French Latin-1 locale case compare medially differing strings" 1000
+ (string-fr-ci-op long-latin1-string long-latin1-string-diff-in-middle))
+
+ (benchmark "French Latin-1 locale case compare terminally differing strings" 1000
+ (string-fr-ci-op long-latin1-string long-latin1-string-diff-at-end))
+
+ (benchmark "French Latin-1 locale case compare identical strings" 1000
+ (string-fr-ci-op long-latin1-string long-latin1-string))
+
+ (benchmark "French UTF-8 locale compare initially differing strings" 1000
+ (string-fr-utf8-op long-latin1-string long-latin1-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale compare medially differing strings" 1000
+ (string-fr-utf8-op long-latin1-string long-latin1-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale compare terminally differing strings" 1000
+ (string-fr-utf8-op long-latin1-string long-latin1-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale compare identical strings" 1000
+ (string-fr-utf8-op long-latin1-string long-latin1-string))
+
+ (benchmark "French UTF-8 locale case compare initially differing strings" 1000
+ (string-fr-utf8-ci-op long-latin1-string long-latin1-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale case compare medially differing strings" 1000
+ (string-fr-utf8-ci-op long-latin1-string long-latin1-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale case compare terminally differing strings" 1000
+ (string-fr-utf8-ci-op long-latin1-string long-latin1-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale case compare identical strings" 1000
+ (string-fr-utf8-ci-op long-latin1-string long-latin1-string)))
+
+ (with-benchmark-prefix "short Unicode"
+
+ (benchmark "compare initially differing strings" 100000
+ (string-op short-cased-string short-cased-string-diff-at-start))
+
+ (benchmark "compare medially differing strings" 100000
+ (string-op short-cased-string short-cased-string-diff-in-middle))
+
+ (benchmark "compare terminally differing strings" 100000
+ (string-op short-cased-string short-cased-string-diff-at-end))
+
+ (benchmark "compare identical strings" 100000
+ (string-op short-cased-string short-cased-string))
+
+ (benchmark "case compare initially differing strings" 100000
+ (string-ci-op short-cased-string short-cased-string-diff-at-start))
+
+ (benchmark "case compare medially differing strings" 100000
+ (string-ci-op short-cased-string short-cased-string-diff-in-middle))
+
+ (benchmark "case compare terminally differing strings" 100000
+ (string-ci-op short-cased-string short-cased-string-diff-at-end))
+
+ (benchmark "case compare identical strings" 100000
+ (string-ci-op short-cased-string short-cased-string))
+
+ (benchmark "French UTF-8 locale compare initially differing strings" 100000
+ (string-fr-utf8-op short-cased-string short-cased-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale compare medially differing strings" 100000
+ (string-fr-utf8-op short-cased-string short-cased-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale compare terminally differing strings" 100000
+ (string-fr-utf8-op short-cased-string short-cased-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale compare identical strings" 100000
+ (string-fr-utf8-op short-cased-string short-cased-string))
+
+ (benchmark "French UTF-8 locale case compare initially differing strings" 100000
+ (string-fr-utf8-ci-op short-cased-string short-cased-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale case compare medially differing strings" 100000
+ (string-fr-utf8-ci-op short-cased-string short-cased-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale case compare terminally differing strings" 100000
+ (string-fr-utf8-ci-op short-cased-string short-cased-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale case compare identical strings" 100000
+ (string-fr-utf8-ci-op short-cased-string short-cased-string)))
+
+ (with-benchmark-prefix "medium Unicode"
+
+ (benchmark "compare initially differing strings" 10000
+ (string-op medium-cased-string medium-cased-string-diff-at-start))
+
+ (benchmark "compare medially differing strings" 10000
+ (string-op medium-cased-string medium-cased-string-diff-in-middle))
+
+ (benchmark "compare terminally differing strings" 10000
+ (string-op medium-cased-string medium-cased-string-diff-at-end))
+
+ (benchmark "compare identical strings" 10000
+ (string-op medium-cased-string medium-cased-string))
+
+ (benchmark "case compare initially differing strings" 10000
+ (string-ci-op medium-cased-string medium-cased-string-diff-at-start))
+
+ (benchmark "case compare medially differing strings" 10000
+ (string-ci-op medium-cased-string medium-cased-string-diff-in-middle))
+
+ (benchmark "case compare terminally differing strings" 10000
+ (string-ci-op medium-cased-string medium-cased-string-diff-at-end))
+
+ (benchmark "case compare identical strings" 10000
+ (string-ci-op medium-cased-string medium-cased-string))
+
+ (benchmark "French UTF-8 locale compare initially differing strings" 10000
+ (string-fr-utf8-op medium-cased-string medium-cased-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale compare medially differing strings" 10000
+ (string-fr-utf8-op medium-cased-string medium-cased-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale compare terminally differing strings" 10000
+ (string-fr-utf8-op medium-cased-string medium-cased-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale compare identical strings" 10000
+ (string-fr-utf8-op medium-cased-string medium-cased-string))
+
+ (benchmark "French UTF-8 locale case compare initially differing strings" 10000
+ (string-fr-utf8-ci-op medium-cased-string medium-cased-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale case compare medially differing strings" 10000
+ (string-fr-utf8-ci-op medium-cased-string medium-cased-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale case compare terminally differing strings" 10000
+ (string-fr-utf8-ci-op medium-cased-string medium-cased-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale case compare identical strings" 10000
+ (string-fr-utf8-ci-op medium-cased-string medium-cased-string)))
+
+ (with-benchmark-prefix "long Unicode"
+
+ (benchmark "compare initially differing strings" 1000
+ (string-op long-cased-string long-cased-string-diff-at-start))
+
+ (benchmark "compare medially differing strings" 1000
+ (string-op long-cased-string long-cased-string-diff-in-middle))
+
+ (benchmark "compare terminally differing strings" 1000
+ (string-op long-cased-string long-cased-string-diff-at-end))
+
+ (benchmark "compare identical strings" 1000
+ (string-op long-cased-string long-cased-string))
+
+ (benchmark "case compare initially differing strings" 1000
+ (string-ci-op long-cased-string long-cased-string-diff-at-start))
+
+ (benchmark "case compare medially differing strings" 1000
+ (string-ci-op long-cased-string long-cased-string-diff-in-middle))
+
+ (benchmark "case compare terminally differing strings" 1000
+ (string-ci-op long-cased-string long-cased-string-diff-at-end))
+
+ (benchmark "case compare identical strings" 1000
+ (string-ci-op long-cased-string long-cased-string))
+
+ (benchmark "French UTF-8 locale compare initially differing strings" 1000
+ (string-fr-utf8-op long-cased-string long-cased-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale compare medially differing strings" 1000
+ (string-fr-utf8-op long-cased-string long-cased-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale compare terminally differing strings" 1000
+ (string-fr-utf8-op long-cased-string long-cased-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale compare identical strings" 1000
+ (string-fr-utf8-op long-cased-string long-cased-string))
+
+ (benchmark "French UTF-8 locale case compare initially differing strings" 1000
+ (string-fr-utf8-ci-op long-cased-string long-cased-string-diff-at-start))
+
+ (benchmark "French UTF-8 locale case compare medially differing strings" 1000
+ (string-fr-utf8-ci-op long-cased-string long-cased-string-diff-in-middle))
+
+ (benchmark "French UTF-8 locale case compare terminally differing strings" 1000
+ (string-fr-utf8-ci-op long-cased-string long-cased-string-diff-at-end))
+
+ (benchmark "French UTF-8 locale case compare identical strings" 1000
+ (string-fr-utf8-ci-op long-cased-string long-cased-string))))
+
+
diff --git a/benchmark-suite/benchmarks/structs.bm b/benchmark-suite/benchmarks/structs.bm
new file mode 100644
index 000000000..465afbd24
--- /dev/null
+++ b/benchmark-suite/benchmarks/structs.bm
@@ -0,0 +1,51 @@
+;;; -*- mode: scheme; coding: iso-8859-1; -*-
+;;; Structs.
+;;;
+;;; Copyright 2009, 2017 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks structs)
+ :use-module (benchmark-suite lib))
+
+;; Note: Use `--iteration-factor' to change this.
+(define iterations 2000000)
+
+(define vtable2
+ (make-vtable "pwpw"))
+
+(define vtable7
+ (make-vtable (string-concatenate (make-list 7 "pw"))))
+
+
+(with-benchmark-prefix "constructors"
+
+ (benchmark "make-struct2" iterations
+ (make-struct/no-tail vtable2 1 2))
+
+ (benchmark "make-struct7" iterations
+ (make-struct/no-tail vtable7 1 2 3 4 5 6 7)))
+
+
+(with-benchmark-prefix "pairs" ;; for comparison
+ (benchmark "cons" iterations
+ (cons 1 2))
+
+ (benchmark "list" iterations
+ (list 1 2 3 4 5 6 7))
+
+ (benchmark "make-list" iterations
+ (make-list 7)))
diff --git a/benchmark-suite/benchmarks/subr.bm b/benchmark-suite/benchmarks/subr.bm
new file mode 100644
index 000000000..ea0045650
--- /dev/null
+++ b/benchmark-suite/benchmarks/subr.bm
@@ -0,0 +1,66 @@
+;;; subr.bm --- Measure the subr invocation cost. -*- Scheme -*-
+;;;
+;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks subrs)
+ :use-module (benchmark-suite lib))
+
+
+(define hook1 (make-hook 1))
+(define hook3 (make-hook 3))
+
+(with-benchmark-prefix "subr invocation"
+
+ (benchmark "simple subr" 700000
+ ;; 1 required argument, 0 optional arguments, no rest.
+ (1+ 0))
+
+ (benchmark "generic subr" 700000
+ ;; 2 required arguments, 4 optional arguments, no rest.
+
+ ;; In Guile 1.8 and earlier, such subrs are implemented as "compiled
+ ;; closures" (cclos). There, when a cclo/gsubr is called, the evaluator
+ ;; goes through `SCM_APPLY ()' and conses the arguments, which is more
+ ;; costly than the invocation of a "simple subr".
+ (string= "foo" "bar"))
+
+ (benchmark "generic subr with rest arg" 700000
+ ;; 1 required argument, 0 optional arguments, 1 rest.
+ (run-hook hook1 1))
+
+ (benchmark "generic subr with rest arg and 3+ parameters" 700000
+ ;; 1 required argument, 0 optional arguments, 1 rest.
+
+ ;; The evaluator considers calls with 3 and more parameters as a general
+ ;; form and always stores the arguments into a list.
+ (run-hook hook3 1 2 3)))
+
+
+(with-benchmark-prefix "subr application"
+
+ (benchmark "simple subr" 700000
+ (apply 1+ '(0)))
+
+ (benchmark "generic subr" 700000
+ (apply string= "foo" '("bar")))
+
+ (benchmark "generic subr with rest arg" 700000
+ (apply run-hook hook1 '(1)))
+
+ (benchmark "generic subr with rest arg and 3+ parameters" 700000
+ (run-hook hook3 1 2 '(3))))
diff --git a/benchmark-suite/benchmarks/vectors.bm b/benchmark-suite/benchmarks/vectors.bm
new file mode 100644
index 000000000..4e47e008c
--- /dev/null
+++ b/benchmark-suite/benchmarks/vectors.bm
@@ -0,0 +1,51 @@
+;;; -*- mode: scheme; coding: iso-8859-1; -*-
+;;; Vectors.
+;;;
+;;; Copyright 2009 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks vectors)
+ :use-module (benchmark-suite lib))
+
+;; Note: Use `--iteration-factor' to change this.
+(define iterations 1000000)
+
+
+(with-benchmark-prefix "constructors"
+
+ (benchmark "vector (opcode)" iterations
+ (vector 1 2 3 4 5 6 7))
+
+ (benchmark "vector (procedure)" iterations
+ (let ((v vector))
+ (v 1 2 3 4 5 6 7)))
+
+ (benchmark "make-vector" iterations
+ (make-vector 7)))
+
+
+(with-benchmark-prefix "pairs" ;; for comparison
+
+ (benchmark "list (opcode)" iterations
+ (list 1 2 3 4 5 6 7))
+
+ (benchmark "list (procedure)" iterations
+ (let ((l list))
+ (l 1 2 3 4 5 6 7)))
+
+ (benchmark "make-list" iterations
+ (make-list 7)))
diff --git a/benchmark-suite/benchmarks/vlists.bm b/benchmark-suite/benchmarks/vlists.bm
new file mode 100644
index 000000000..329c78623
--- /dev/null
+++ b/benchmark-suite/benchmarks/vlists.bm
@@ -0,0 +1,103 @@
+;;; -*- mode: scheme; coding: iso-8859-1; -*-
+;;; VLists.
+;;;
+;;; Copyright 2009 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks vlists)
+ :use-module (srfi srfi-1)
+ :use-module (ice-9 vlist)
+ :use-module (benchmark-suite lib))
+
+;; Note: Use `--iteration-factor' to change this.
+(define iterations 2000000)
+
+;; The size of large lists.
+(define %list-size 700000)
+
+(define %big-list (make-list %list-size))
+(define %big-vlist (list->vlist %big-list))
+
+(define-syntax comparative-benchmark
+ (syntax-rules ()
+ ((_ benchmark-name iterations
+ ((api ((name value) ...)))
+ body ...)
+ (benchmark (format #f "~A (~A)" benchmark-name 'api)
+ iterations
+ (let ((name value) ...)
+ body ...)))
+ ((_ benchmark-name iterations
+ ((api bindings) apis ...)
+ body ...)
+ (begin
+ (comparative-benchmark benchmark-name iterations
+ ((api bindings))
+ body ...)
+ (comparative-benchmark benchmark-name iterations
+ (apis ...)
+ body ...)))))
+
+
+(with-benchmark-prefix "constructors"
+
+ (comparative-benchmark "cons" 2
+ ((srfi-1 ((cons cons) (null '())))
+ (vlist ((cons vlist-cons) (null vlist-null))))
+ (let loop ((i %list-size)
+ (r null))
+ (and (> i 0)
+ (loop (1- i) (cons #t r)))))
+
+
+ (comparative-benchmark "acons" 2
+ ((srfi-1 ((acons alist-cons) (null '())))
+ (vlist ((acons vhash-cons) (null vlist-null))))
+ (let loop ((i %list-size)
+ (r null))
+ (if (zero? i)
+ r
+ (loop (1- i) (acons i i r))))))
+
+
+(define %big-alist
+ (let loop ((i %list-size) (res '()))
+ (if (zero? i)
+ res
+ (loop (1- i) (alist-cons i i res)))))
+(define %big-vhash
+ (let loop ((i %list-size) (res vlist-null))
+ (if (zero? i)
+ res
+ (loop (1- i) (vhash-cons i i res)))))
+
+
+(with-benchmark-prefix "iteration"
+
+ (comparative-benchmark "fold" 2
+ ((srfi-1 ((fold fold) (lst %big-list)))
+ (vlist ((fold vlist-fold) (lst %big-vlist))))
+ (fold (lambda (x y) y) #t lst))
+
+ (comparative-benchmark "assoc" 70
+ ((srfi-1 ((assoc assoc) (alst %big-alist)))
+ (vhash ((assoc vhash-assoc) (alst %big-vhash))))
+ (let loop ((i (quotient %list-size 3)))
+ (and (> i 0)
+ (begin
+ (assoc i alst)
+ (loop (- i 5000)))))))
diff --git a/benchmark-suite/benchmarks/write.bm b/benchmark-suite/benchmarks/write.bm
new file mode 100644
index 000000000..46f5c8d1c
--- /dev/null
+++ b/benchmark-suite/benchmarks/write.bm
@@ -0,0 +1,52 @@
+;;; write.bm --- Exercise the printer. -*- Scheme -*-
+;;;
+;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks write)
+ #:use-module (benchmark-suite lib))
+
+(define %len 50000)
+
+(define %string-with-escapes
+ (list->string (map integer->char (iota %len))))
+
+(define %string-without-escapes
+ (make-string %len #\a))
+
+;; Use Unicode-capable ports.
+(fluid-set! %default-port-encoding "UTF-8")
+
+(define %null
+ (%make-void-port OPEN_WRITE))
+
+
+(with-benchmark-prefix "write"
+
+ (benchmark "string with escapes" 50
+ (write %string-with-escapes %null))
+
+ (benchmark "string without escapes" 50
+ (write %string-without-escapes %null)))
+
+(with-benchmark-prefix "display"
+
+ (benchmark "string with escapes" 1000
+ (display %string-with-escapes %null))
+
+ (benchmark "string without escapes" 1000
+ (display %string-without-escapes %null)))
diff --git a/benchmark-suite/guile-benchmark b/benchmark-suite/guile-benchmark
new file mode 100755
index 000000000..da2b2a1ad
--- /dev/null
+++ b/benchmark-suite/guile-benchmark
@@ -0,0 +1,220 @@
+#!../libguile/guile \
+-e main -s
+!#
+
+;;;; guile-benchmark --- run the Guile benchmark suite
+;;;; Adapted from code by Jim Blandy <jimb@red-bean.com> --- May 1999
+;;;;
+;;;; Copyright (C) 2002, 2006, 2010 Free Software Foundation, Inc.
+;;;;
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this software; see the file COPYING.LESSER.
+;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin
+;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+;;;; Usage: [guile -e main -s] guile-benchmark [OPTIONS] [BENCHMARK ...]
+;;;;
+;;;; Run benchmarks from the Guile benchmark suite. Report timing
+;;;; results to the standard output, along with a summary of all
+;;;; the results. Record each reported benchmark outcome in the log
+;;;; file, `benchmarks.log'.
+;;;;
+;;;; Normally, guile-benchmark scans the benchmark directory, and
+;;;; executes all files whose names end in `.bm'. (It assumes they contain
+;;;; Scheme code.) However, you can have it execute specific benchmarks by
+;;;; listing their filenames on the command line.
+;;;;
+;;;; The option `--benchmark-suite' can be given to specify the benchmark
+;;;; directory. If no such option is given, the benchmark directory is
+;;;; taken from the environment variable BENCHMARK_SUITE_DIR (if defined),
+;;;; otherwise a default directory that is hardcoded in this file is
+;;;; used (see "Installation" below).
+;;;;
+;;;; If present, the `--iteration-factor FACTOR' option tells
+;;;; `guile-benchmark' to multiply the number of iterations given with
+;;;; each single benchmark by the value of FACTOR. This allows to
+;;;; reduce or increase the total time for benchmarking.
+;;;;
+;;;; If present, the `--log-file LOG' option tells `guile-benchmark' to put
+;;;; the log output in a file named LOG.
+;;;;
+;;;; If present, the `--debug' option will enable a debugging mode.
+;;;;
+;;;;
+;;;; Installation:
+;;;;
+;;;; If you change the #! line at the top of this script to point at
+;;;; the Guile interpreter you want to run, you can call this script
+;;;; as an executable instead of having to pass it as a parameter to
+;;;; guile via "guile -e main -s guile-benchmark". Further, you can edit
+;;;; the definition of default-benchmark-suite to point to the parent
+;;;; directory of the `benchmarks' tree, which makes it unnecessary to set
+;;;; the environment variable `BENCHMARK_SUITE_DIR'.
+;;;;
+;;;;
+;;;; Shortcomings:
+;;;;
+;;;; At the moment, due to a simple-minded implementation, benchmark files
+;;;; must live in the benchmark directory, and you must specify their names
+;;;; relative to the top of the benchmark directory. If you want to send
+;;;; me a patch that fixes this, but still leaves sane benchmark names in
+;;;; the log file, that would be great. At the moment, all the benchmarks
+;;;; I care about are in the benchmark directory, though.
+;;;;
+;;;; It would be nice if you could specify the Guile interpreter you
+;;;; want to benchmark on the command line. As it stands, if you want to
+;;;; change which Guile interpreter you're benchmarking, you need to edit
+;;;; the #! line at the top of this file, which is stupid.
+
+
+;;; User configurable settings:
+(define default-benchmark-suite
+ (string-append (getenv "HOME") "/bogus-path/benchmark-suite"))
+
+
+(use-modules (benchmark-suite lib)
+ (ice-9 getopt-long)
+ (ice-9 and-let-star)
+ (ice-9 rdelim))
+
+
+;;; Variables that will receive their actual values later.
+(define benchmark-suite default-benchmark-suite)
+
+(define tmp-dir #f)
+
+
+;;; General utilities, that probably should be in a library somewhere.
+
+;;; Enable debugging
+(define (enable-debug-mode)
+ (write-line %load-path)
+ (set! %load-verbosely #t)
+ (debug-enable 'backtrace 'debug))
+
+;;; Traverse the directory tree at ROOT, applying F to the name of
+;;; each file in the tree, including ROOT itself. For a subdirectory
+;;; SUB, if (F SUB) is true, we recurse into SUB. Do not follow
+;;; symlinks.
+(define (for-each-file f root)
+
+ ;; A "hard directory" is a path that denotes a directory and is not a
+ ;; symlink.
+ (define (file-is-hard-directory? filename)
+ (eq? (stat:type (lstat filename)) 'directory))
+
+ (let visit ((root root))
+ (let ((should-recur (f root)))
+ (if (and should-recur (file-is-hard-directory? root))
+ (let ((dir (opendir root)))
+ (let loop ()
+ (let ((entry (readdir dir)))
+ (cond
+ ((eof-object? entry) #f)
+ ((or (string=? entry ".")
+ (string=? entry "..")
+ (string=? entry "CVS")
+ (string=? entry "RCS"))
+ (loop))
+ (else
+ (visit (string-append root "/" entry))
+ (loop))))))))))
+
+
+;;; The benchmark driver.
+
+
+;;; Localizing benchmark files and temporary data files.
+
+(define (data-file-name filename)
+ (in-vicinity tmp-dir filename))
+
+(define (benchmark-file-name benchmark)
+ (in-vicinity benchmark-suite benchmark))
+
+;;; Return a list of all the benchmark files in the benchmark tree.
+(define (enumerate-benchmarks benchmark-dir)
+ (let ((root-len (+ 1 (string-length benchmark-dir)))
+ (benchmarks '()))
+ (for-each-file (lambda (file)
+ (if (string-suffix? ".bm" file)
+ (let ((short-name
+ (substring file root-len)))
+ (set! benchmarks (cons short-name benchmarks))))
+ #t)
+ benchmark-dir)
+
+ ;; for-each-file presents the files in whatever order it finds
+ ;; them in the directory. We sort them here, so they'll always
+ ;; appear in the same order. This makes it easier to compare benchmark
+ ;; log files mechanically.
+ (sort benchmarks string<?)))
+
+(define (main args)
+ (let ((options (getopt-long args
+ `((benchmark-suite
+ (single-char #\t)
+ (value #t))
+ (iteration-factor
+ (single-char #\t)
+ (value #t))
+ (log-file
+ (single-char #\l)
+ (value #t))
+ (debug
+ (single-char #\d))))))
+ (define (opt tag default)
+ (let ((pair (assq tag options)))
+ (if pair (cdr pair) default)))
+
+ (if (opt 'debug #f)
+ (enable-debug-mode))
+
+ (set! benchmark-suite
+ (or (opt 'benchmark-suite #f)
+ (getenv "BENCHMARK_SUITE_DIR")
+ default-benchmark-suite))
+
+ (set! iteration-factor
+ (string->number (opt 'iteration-factor "1")))
+
+ ;; directory where temporary files are created.
+ (set! tmp-dir (getcwd))
+
+ (let* ((benchmarks
+ (let ((foo (opt '() '())))
+ (if (null? foo)
+ (enumerate-benchmarks benchmark-suite)
+ foo)))
+ (log-file
+ (opt 'log-file "benchmarks.log")))
+
+ ;; Open the log file.
+ (let ((log-port (open-output-file log-file)))
+
+ ;; Register some reporters.
+ (register-reporter (make-log-reporter log-port))
+ (register-reporter user-reporter)
+
+ ;; Run the benchmarks.
+ (for-each (lambda (benchmark)
+ (with-benchmark-prefix benchmark
+ (load (benchmark-file-name benchmark))))
+ benchmarks)
+ (close-port log-port)))))
+
+
+;;; Local Variables:
+;;; mode: scheme
+;;; End:
diff --git a/benchmark-suite/results/neil-arudy b/benchmark-suite/results/neil-arudy
new file mode 100644
index 000000000..7b61d399c
--- /dev/null
+++ b/benchmark-suite/results/neil-arudy
@@ -0,0 +1,93 @@
+Benchmarking /home/neil/SW/Guile/git/meta/guile ...
+with GUILE_LOAD_PATH=/home/neil/SW/Guile/git/benchmark-suite
+;; running guile version 1.9.3
+;; calibrating the benchmarking framework...
+;; framework time per iteration: 5.7220458984375e-7
+("0-reference.bm: reference benchmark for iteration counts" 330000 user 0.2 benchmark 0.0111724853515625 bench/interp 0.0111724853515625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u8-ref" 1000000 user 0.73 benchmark 0.15779541015625 bench/interp 0.15779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u16-ref (foreign)" 1000000 user 0.82 benchmark 0.24779541015625 bench/interp 0.24779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u16-ref (native)" 1000000 user 0.78 benchmark 0.20779541015625 bench/interp 0.20779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u16-native-ref" 1000000 user 0.72 benchmark 0.14779541015625 bench/interp 0.14779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u32-ref (foreign)" 1000000 user 1.61 benchmark 1.03779541015625 bench/interp 1.03779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u32-ref (native)" 1000000 user 0.8 benchmark 0.22779541015625 bench/interp 0.22779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u32-native-ref" 1000000 user 0.74 benchmark 0.16779541015625 bench/interp 0.16779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u64-ref (foreign)" 1000000 user 1.86 benchmark 1.28779541015625 bench/interp 1.28779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u64-ref (native)" 1000000 user 0.81 benchmark 0.23779541015625 bench/interp 0.23779541015625 gc 0.0)
+("bytevectors.bm: ref/set!: bytevector-u64-native-ref" 1000000 user 0.73 benchmark 0.15779541015625 bench/interp 0.15779541015625 gc 0.0)
+("bytevectors.bm: lists: bytevector->u8-list" 2000 user 9.87 benchmark 9.86885559082031 bench/interp 9.86885559082031 gc 0.0)
+("bytevectors.bm: lists: bytevector->uint-list 16-bit" 2000 user 4.48 benchmark 4.47885559082031 bench/interp 4.47885559082031 gc 0.0)
+("bytevectors.bm: lists: bytevector->uint-list 64-bit" 2000 user 3.75 benchmark 3.74885559082031 bench/interp 3.74885559082031 gc 0.0)
+("bytevectors.bm: SRFI-4: u8vector-ref" 1000000 user 1.88 benchmark 1.30779541015625 bench/interp 1.30779541015625 gc 0.0)
+("bytevectors.bm: SRFI-4: u16vector-ref" 1000000 user 1.9 benchmark 1.32779541015625 bench/interp 1.32779541015625 gc 0.0)
+("bytevectors.bm: SRFI-4: u32vector-ref" 1000000 user 1.88 benchmark 1.30779541015625 bench/interp 1.30779541015625 gc 0.0)
+("bytevectors.bm: SRFI-4: u64vector-ref" 1000000 user 1.98 benchmark 1.40779541015625 bench/interp 1.40779541015625 gc 0.0)
+("chars.bm: chars: char" 1000000 user 0.63 benchmark 0.05779541015625 bench/interp 0.05779541015625 gc 0.0)
+("chars.bm: chars: octal" 1000000 user 0.64 benchmark 0.06779541015625 bench/interp 0.06779541015625 gc 0.0)
+("chars.bm: chars: char? eq" 1000000 user 1.19 benchmark 0.61779541015625 bench/interp 0.61779541015625 gc 0.0)
+("chars.bm: chars: char=?" 1000000 user 1.45 benchmark 0.87779541015625 bench/interp 0.87779541015625 gc 0.0)
+("chars.bm: chars: char<?" 1000000 user 1.45 benchmark 0.87779541015625 bench/interp 0.87779541015625 gc 0.0)
+("chars.bm: chars: char-ci=?" 1000000 user 1.45 benchmark 0.87779541015625 bench/interp 0.87779541015625 gc 0.0)
+("chars.bm: chars: char-ci<? " 1000000 user 1.45 benchmark 0.87779541015625 bench/interp 0.87779541015625 gc 0.0)
+("chars.bm: chars: char->integer" 1000000 user 1.2 benchmark 0.62779541015625 bench/interp 0.62779541015625 gc 0.0)
+("chars.bm: chars: char-alphabetic?" 1000000 user 1.36 benchmark 0.78779541015625 bench/interp 0.78779541015625 gc 0.0)
+("chars.bm: chars: char-numeric?" 1000000 user 1.36 benchmark 0.78779541015625 bench/interp 0.78779541015625 gc 0.0)
+("continuations.bm: call/cc" 300 user 0.03 benchmark 0.0298283386230469 bench/interp 0.0298283386230469 gc 0.0)
+("if.bm: if-<expr>-then-else: executing then" 330000 user 0.23 benchmark 0.0411724853515625 bench/interp 0.0411724853515625 gc 0.0)
+("if.bm: if-<expr>-then-else: executing else" 330000 user 0.23 benchmark 0.0411724853515625 bench/interp 0.0411724853515625 gc 0.0)
+("if.bm: if-<expr>-then: executing then" 330000 user 0.23 benchmark 0.0411724853515625 bench/interp 0.0411724853515625 gc 0.0)
+("if.bm: if-<expr>-then: executing else" 330000 user 0.24 benchmark 0.0511724853515625 bench/interp 0.0511724853515625 gc 0.0)
+("if.bm: if-<iloc>-then-else: executing then" 330000 user 0.25 benchmark 0.0611724853515625 bench/interp 0.0611724853515625 gc 0.0)
+("if.bm: if-<iloc>-then-else: executing else" 330000 user 0.24 benchmark 0.0511724853515625 bench/interp 0.0511724853515625 gc 0.0)
+("if.bm: if-<iloc>-then: executing then" 330000 user 0.24 benchmark 0.0511724853515625 bench/interp 0.0511724853515625 gc 0.0)
+("if.bm: if-<iloc>-then: executing else" 330000 user 0.24 benchmark 0.0511724853515625 bench/interp 0.0511724853515625 gc 0.0)
+("if.bm: if-<bool>-then-else: executing then" 330000 user 0.23 benchmark 0.0411724853515625 bench/interp 0.0411724853515625 gc 0.0)
+("if.bm: if-<bool>-then-else: executing else" 330000 user 0.23 benchmark 0.0411724853515625 bench/interp 0.0411724853515625 gc 0.0)
+("if.bm: if-<bool>-then: executing then" 330000 user 0.24 benchmark 0.0511724853515625 bench/interp 0.0511724853515625 gc 0.0)
+("if.bm: if-<bool>-then: executing else" 330000 user 0.23 benchmark 0.0411724853515625 bench/interp 0.0411724853515625 gc 0.0)
+("logand.bm: bignum" 130000 user 0.48 benchmark 0.405613403320312 bench/interp 0.405613403320312 gc 0.0)
+("read.bm: read: _IONBF" 5 user 12.71 benchmark 12.7099971389771 bench/interp 12.7099971389771 gc 0.0)
+("read.bm: read: _IOLBF" 10 user 20.32 benchmark 20.3199942779541 bench/interp 20.3199942779541 gc 0.0)
+("read.bm: read: _IOFBF 4096" 10 user 20.34 benchmark 20.3399942779541 bench/interp 20.3399942779541 gc 0.0)
+("read.bm: read: _IOFBF 8192" 10 user 20.36 benchmark 20.3599942779541 bench/interp 20.3599942779541 gc 0.0)
+("read.bm: read: _IOFBF 16384" 10 user 20.34 benchmark 20.3399942779541 bench/interp 20.3399942779541 gc 0.0)
+("srfi-13.bm: strings: predicates: string?" 1190000 user 2.98 benchmark 2.29907653808594 bench/interp 2.29907653808594 gc 0.0)
+("srfi-13.bm: strings: predicates: null?" 969000 user 2.56 benchmark 2.00553375244141 bench/interp 2.00553375244141 gc 0.0)
+("srfi-13.bm: strings: predicates: any" 94000 user 1.89 benchmark 1.83621276855469 bench/interp 1.83621276855469 gc 0.0)
+("srfi-13.bm: strings: predicates: every" 94000 user 1.53 benchmark 1.47621276855469 bench/interp 1.47621276855469 gc 0.0)
+("srfi-13.bm: strings: constructors: string" 5000 user 2.02 benchmark 2.01713897705078 bench/interp 2.01713897705078 gc 0.0)
+("srfi-13.bm: strings: constructors: list->" 4500 user 0.3 benchmark 0.297425079345703 bench/interp 0.297425079345703 gc 0.0)
+("srfi-13.bm: strings: constructors: reverse-list->" 5000 user 0.58 benchmark 0.577138977050781 bench/interp 0.577138977050781 gc 0.0)
+("srfi-13.bm: strings: constructors: make" 22000 user 0.52 benchmark 0.507411499023438 bench/interp 0.507411499023438 gc 0.0)
+("srfi-13.bm: strings: constructors: tabulate" 17000 user 0.57 benchmark 0.560272521972656 bench/interp 0.560272521972656 gc 0.0)
+("srfi-13.bm: strings: constructors: join" 5500 user 0.46 benchmark 0.456852874755859 bench/interp 0.456852874755859 gc 0.0)
+("srfi-13.bm: strings: list/string: ->list" 7300 user 2.36 benchmark 2.35582290649414 bench/interp 2.35582290649414 gc 0.0)
+("srfi-13.bm: strings: list/string: split" 60000 user 1.87 benchmark 1.83566772460938 bench/interp 1.83566772460938 gc 0.0)
+("srfi-13.bm: strings: selection: ref" 660 user 1.5 benchmark 1.4996223449707 bench/interp 1.4996223449707 gc 0.0)
+("srfi-13.bm: strings: selection: copy" 1100 user 0.04 benchmark 0.0393705749511719 bench/interp 0.0393705749511719 gc 0.0)
+("srfi-13.bm: strings: selection: pad" 6800 user 0.17 benchmark 0.166109008789063 bench/interp 0.166109008789063 gc 0.0)
+("srfi-13.bm: strings: selection: trim trim-right trim-both" 60000 user 2.67 benchmark 2.63566772460937 bench/interp 2.63566772460937 gc 0.0)
+("srfi-13.bm: strings: modification: set!" 3000 user 1.42 benchmark 1.41828338623047 bench/interp 1.41828338623047 gc 0.0)
+("srfi-13.bm: strings: modification: sub-move!" 230000 user 1.88 benchmark 1.74839294433594 bench/interp 1.74839294433594 gc 0.0)
+("srfi-13.bm: strings: modification: fill!" 230000 user 2.31 benchmark 2.17839294433594 bench/interp 2.17839294433594 gc 0.0)
+("srfi-13.bm: strings: modification: comparison: compare compare-ci" 140000 user 1.93 benchmark 1.84989135742187 bench/interp 1.84989135742187 gc 0.0)
+("srfi-13.bm: strings: modification: comparison: hash hash-ci" 1000 user 0.27 benchmark 0.269427795410156 bench/interp 0.269427795410156 gc 0.0)
+("srfi-13.bm: strings: searching: prefix-length suffix-length" 270 user 0.2 benchmark 0.199845504760742 bench/interp 0.199845504760742 gc 0.0)
+("srfi-13.bm: strings: searching: prefix? suffix?" 270 user 0.2 benchmark 0.199845504760742 bench/interp 0.199845504760742 gc 0.0)
+("srfi-13.bm: strings: searching: index index-right rindex" 100000 user 3.48 benchmark 3.42277954101562 bench/interp 3.42277954101562 gc 0.0)
+("srfi-13.bm: strings: searching: skip skip-right?" 100000 user 2.14 benchmark 2.08277954101563 bench/interp 2.08277954101563 gc 0.0)
+("srfi-13.bm: strings: searching: count" 10000 user 9.35 benchmark 9.34427795410156 bench/interp 9.34427795410156 gc 0.0)
+("srfi-13.bm: strings: searching: contains contains-ci" 34000 user 2.29 benchmark 2.27054504394531 bench/interp 2.27054504394531 gc 0.0)
+("srfi-13.bm: strings: searching: upcase downcase upcase! downcase!" 600 user 0.2 benchmark 0.199656677246094 bench/interp 0.199656677246094 gc 0.0)
+("srfi-13.bm: strings: readers: read token, method 1" 1200 user 1.26 benchmark 1.25931335449219 bench/interp 1.25931335449219 gc 0.0)
+("srfi-13.bm: strings: readers: read token, method 2" 1200 user 2.03 benchmark 2.02931335449219 bench/interp 2.02931335449219 gc 0.0)
+("subr.bm: subr invocation: simple subr" 700000 user 0.47 benchmark 0.069456787109375 bench/interp 0.069456787109375 gc 0.0)
+("subr.bm: subr invocation: generic subr" 700000 user 1.75 benchmark 1.34945678710938 bench/interp 1.34945678710938 gc 0.0)
+("subr.bm: subr invocation: generic subr with rest arg" 700000 user 1.39 benchmark 0.989456787109375 bench/interp 0.989456787109375 gc 0.0)
+("subr.bm: subr invocation: generic subr with rest arg and 3+ parameters" 700000 user 1.86 benchmark 1.45945678710938 bench/interp 1.45945678710938 gc 0.0)
+("subr.bm: subr application: simple subr" 700000 user 0.91 benchmark 0.509456787109375 bench/interp 0.509456787109375 gc 0.0)
+("subr.bm: subr application: generic subr" 700000 user 1.8 benchmark 1.39945678710938 bench/interp 1.39945678710938 gc 0.0)
+("subr.bm: subr application: generic subr with rest arg" 700000 user 1.44 benchmark 1.03945678710937 bench/interp 1.03945678710937 gc 0.0)
+("subr.bm: subr application: generic subr with rest arg and 3+ parameters" 700000 user 1.89 benchmark 1.48945678710937 bench/interp 1.48945678710937 gc 0.0)
+("uniform-vector-read.bm: uniform-vector-read!: uniform-vector-write" 500 user 0.12 benchmark 0.119713897705078 bench/interp 0.119713897705078 gc 0.0)
+("uniform-vector-read.bm: uniform-vector-read!: uniform-vector-read!" 500 user 0.02 benchmark 0.0197138977050781 bench/interp 0.0197138977050781 gc 0.0)
+("uniform-vector-read.bm: uniform-vector-read!: string port" 5000 user 2.49 benchmark 2.48713897705078 bench/interp 2.48713897705078 gc 0.0)