From b786a5bbf825f61e04ccd9a54f93cb1e40ac67d9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 2 Mar 2009 00:18:34 +0100
Subject: [PATCH] Add subr invocation benchmark.

* benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add `subr.bm'.
---
 benchmark-suite/Makefile.am        |  1 +
 benchmark-suite/benchmarks/subr.bm | 46 ++++++++++++++++++++++++++++++
 2 files changed, 47 insertions(+)
 create mode 100644 benchmark-suite/benchmarks/subr.bm

diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index 5357cf050..e65e8bcb2 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -3,6 +3,7 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm		\
                  benchmarks/if.bm			\
                  benchmarks/logand.bm			\
 		 benchmarks/read.bm			\
+		 benchmarks/subr.bm			\
 		 benchmarks/uniform-vector-read.bm
 
 EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS)	\
diff --git a/benchmark-suite/benchmarks/subr.bm b/benchmark-suite/benchmarks/subr.bm
new file mode 100644
index 000000000..fbb9ed386
--- /dev/null
+++ b/benchmark-suite/benchmarks/subr.bm
@@ -0,0 +1,46 @@
+;;; 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 General Public License as published by
+;;; the Free Software Foundation; either version 2, 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this software; see the file COPYING.  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))
+
+
+(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")))
+
+
+(with-benchmark-prefix "subr application"
+
+  (benchmark "simple subr" 700000
+    (apply 1+ '(0)))
+
+  (benchmark "generic subr" 700000
+    (apply string= "foo" '("bar"))))