code:
This is version 1.8.7 of Guile, Project GNU's extension language
library.  Guile is an interpreter for Scheme, packaged as a library
that you can link into your applications to give them their own
scripting language.  Guile will eventually support other languages as
well, giving users of Guile-based applications a choice of languages.

Please send bug reports to bug-guile@gnu.org.

See the LICENSE file for the specific terms that apply to Guile.

Additional INSTALL instructions ===========================================

Generic instructions for configuring and compiling Guile can be found
in the INSTALL file.  Guile specific information and configure options
can be found below, including instructions for installing SLIB.

Guile requires a few external packages and can optionally use a number
of external packages such as `readline' when they are available.
Guile expects to be able to find these packages in the default
compiler setup, it does not try to make any special arrangements
itself.  For example, for the `readline' package, Guile expects to be
able to find the include file <readline/readline.h>, without passing
any special `-I' options to the compiler.

If you installed an external package, and you used the --prefix
installation option to install it somewhere else than /usr/local, you
must arrange for your compiler to find it by default.  If that
compiler is gcc, one convenient way of making such arrangements is to
use the --with-local-prefix option during installation, naming the
same directory as you used in the --prefix option of the package.  In
particular, it is not good enough to use the same --prefix option when
you install gcc and the package; you need to use the
--with-local-prefix option as well.  See the gcc documentation for
more details.

Required External Packages ================================================

Guile requires the following external packages:

  - GNU MP, at least version 4.1

    GNU MP is used for bignum arithmetic.  It is available from
    http://swox.com/gmp

  - libltdl from libtool, at least from libtool version 1.5.6

    libltdl is used for loading extensions at run-time.  It is
    available from http://www.gnu.org/software/libtool/

Guile specific flags Accepted by Configure =================================

If you run the configure script with no arguments, it should examine
your system and set things up appropriately.  However, there are a few
switches specific to Guile you may find useful in some circumstances.

--without-threads  ---  Build without thread support

  Build a Guile executable and library that supports multi-threading.

  The default is to enable threading support when your operating
  system offsers 'POSIX threads'.  When you do not want threading, use
  `--without-threads'.

--enable-deprecated=LEVEL

  Guile may contain features that are `deprecated'.  When a feature is
  deprecated, it means that it is still there, but that there is a
  better way of achieving the same thing, and we'd rather have you use
  this better way.  This allows us to eventually remove the old
  implementation and helps to keep Guile reasonably clean of historic
  baggage.

  Deprecated features are considered harmful; using them is likely a
  bug.  See below for the related notion of `discouraged' features,
  which are OK but have fallen out of favor.

  See the file NEWS for a list of features that are currently
  deprecated.  Each entry will also tell you what you should replace
  your code with.

  To give you some help with this process, and to encourage (OK,
  nudge) people to switch to the newer methods, Guile can emit
  warnings or errors when you use a deprecated feature.  There is
  quite a range of possibilities, from being completely silent to
  giving errors at link time.  What exactly happens is determined both
  by the value of the `--enable-deprecated' configuration option when
  Guile was built, and by the GUILE_WARN_DEPRECATED environment
  variable.

  It works like this:

    When Guile has been configured with `--enable-deprecated=no' (or,
    equivalently, with `--disable-deprecated') then all deprecated
    features are omitted from Guile.  You will get "undefined
    reference", "variable unbound" or similar errors when you try to
    use them.

    When `--enable-deprecated=LEVEL' has been specified (for LEVEL not
    "no"), LEVEL will be used as the default value of the environment
    variable GUILE_WARN_DEPRECATED.  A value of "yes" is changed to
    "summary" and "shutup" is changed to "no", however.

    When GUILE_WARN_DEPRECATED has the value "no", nothing special
    will happen when a deprecated feature is used.

    When GUILE_WARN_DEPRECATED has the value "summary", and a
    deprecated feature has been used, Guile will print this message at
    exit:

      Some deprecated features have been used.  Set the environment
      variable GUILE_WARN_DEPRECATED to "detailed" and rerun the
      program to get more information.  Set it to "no" to suppress
      this message.

    When GUILE_WARN_DEPRECATED has the value "detailed", a detailed
    warning is emitted immediatly for the first use of a deprecated
    feature.

  The default is `--enable-deprecated=yes'.

  In addition to setting GUILE_WARN_DEPRECATED in the environment, you
  can also use (debug-enable 'warn-deprecated) and (debug-disable
  'warn-deprecated) to enable and disable the detailed messaged at run
  time.

--disable-discouraged

  In addition to deprecated features, Guile can also contain things
  that are merely `discouraged'.  It is OK to continue to use these
  features in old code, but new code should avoid them since there are
  better alternatives.

  There is nothing wrong with a discouraged feature per se, but they
  might have strange names, or be non-standard, for example.  Avoiding
  them will make your code better.

--disable-shared  ---  Do not build shared libraries.
--disable-static  ---  Do not build static libraries.

  Normally, both static and shared libraries will be built if your
  system supports them.

--enable-debug-freelist  ---  Enable freelist debugging.

  This enables a debugging version of scm_cell and scm_double_cell,
  and also registers an extra primitive, the setter
  `gc-set-debug-check-freelist!'.

  Configure with the --enable-debug-freelist option to enable the
  gc-set-debug-check-freelist! primitive, and then use:

  (gc-set-debug-check-freelist! #t)  # turn on checking of the freelist
  (gc-set-debug-check-freelist! #f)  # turn off checking

  Checking of the freelist forces a traversal of the freelist and a
  garbage collection before each allocation of a cell.  This can slow
  down the interpreter dramatically, so the setter should be used to
  turn on this extra processing only when necessary.

--enable-debug-malloc  ---  Enable malloc debugging.

  Include code for debugging of calls to scm_malloc, scm_realloc, etc.

  It records the number of allocated objects of each kind.  This is
  useful when searching for memory leaks.

  A Guile compiled with this option provides the primitive
  `malloc-stats' which returns an alist with pairs of kind and the
  number of objects of that kind.

--enable-guile-debug  ---  Include internal debugging functions
--disable-posix       ---  omit posix interfaces
--disable-networking  ---  omit networking interfaces
--disable-regex       ---  omit regular expression interfaces

Cross building Guile  =====================================================

Guile can be cross-compiled for Windows using the i586-mingw32msvc
cross-compiler.  To do this, you first need to cross-build Guile's
prerequisites - GNU MP and libtool/libltdl (as described above) - and
then cross-build Guile itself.

For each of these steps, configure using an invocation like this:

CPPFLAGS=-I/usr/local/i586-mingw32msvc/include \
LDFLAGS=-L/usr/local/i586-mingw32msvc/lib \
GUILE_FOR_BUILD=/usr/local/bin/guile \
./configure --prefix=/usr/local/i586-mingw32msvc --host=i586-mingw32msvc

Then run `make' - which should complete without any errors - and `sudo
make install'.  (`make check' doesn't work when cross-compiling,
because the built DLLs and program cannot be run on GNU/Linux.)

The `GUILE_FOR_BUILD=...' setting is needed because some later steps
of the build process use Guile itself.  In the non-cross-compiling
case this is the version of Guile that has just been built.  When
cross-compiling, you have to set GUILE_FOR_BUILD to tell the build
where it can find a native version of Guile, to use for these steps.

Cross-compiling for other hosts may also work, using the following
instructions; but this has not been recently tested.

To configure Guile for cross building, for example for Cygwin:

    ./configure --host=i686-pc-cygwin --disable-shared

A C compiler for the build system is required.  The default is
"PATH=/usr/bin:$PATH cc".  If that doesn't suit it can be specified
with the CC_FOR_BUILD variable in the usual way, for instance

    ./configure --host=m68k-unknown-linux-gnu CC_FOR_BUILD=/my/local/gcc

Guile for the build system can be specified similarly with the
GUILE_FOR_BUILD variable, it defaults to just "guile".

Using Guile Without Installing It =========================================

The top directory of the Guile sources contains a script called
"pre-inst-guile" that can be used to run the Guile that has just been
built.

Installing SLIB ===========================================================

In order to use SLIB from Guile you basically only need to put the
`slib' directory _in_ one of the directories on Guile's load path.

The standard installation is:

  1. Obtain slib from http://www-swiss.ai.mit.edu/~jaffer/SLIB.html

  2. Put it in Guile's data directory, that is the directory printed when
     you type

       guile-config info pkgdatadir

     at the shell prompt.  This is normally `/usr/local/share/guile', so the
     directory will normally have full path `/usr/local/share/guile/slib'.

  3. Start guile as a user with write access to the data directory and type

       (use-modules (ice-9 slib))

     at the Guile prompt.  This will generate the slibcat catalog next to
     the slib directory.

SLIB's `require' is provided by the Guile module (ice-9 slib).

Example:

  (use-modules (ice-9 slib))
  (require 'primes)
  (prime? 7)

Guile Documentation ==================================================

If you've never used Scheme before, then the Guile Tutorial
(guile-tut.info) is a good starting point.  The Guile Reference Manual
(guile.info) is the primary documentation for Guile.  The Goops object
system is documented separately (goops.info).  A copy of the R5RS
Scheme specification is included too (r5rs.info).

Info format versions of this documentation are installed as part of
the normal build process.  The texinfo sources are under the doc
directory, and other formats like Postscript, PDF, DVI or HTML can be
generated from them with Tex and Texinfo tools.

The doc directory also includes an example-smob subdirectory which has
the example code from the "Defining New Types (Smobs)" chapter of the
reference manual.

The Guile WWW page is at

  http://www.gnu.org/software/guile/guile.html

It contains a link to the Guile FAQ.

About This Distribution ==============================================

Interesting files include:

- LICENSE, which contains the exact terms of the Guile license.
- COPYING, which contains the terms of the GNU General Public License.
- INSTALL, which contains general instructions for building/installing Guile.
- NEWS, which describes user-visible changes since the last release of Guile.

Files are usually installed according to the prefix specified to
configure, /usr/local by default.  Building and installing gives you:

Executables, in ${prefix}/bin:

 guile --- a stand-alone interpreter for Guile.  With no arguments, this
 	is a simple interactive Scheme interpreter.  It can also be used
 	as an interpreter for script files; see the NEWS file for details.
 guile-config --- a Guile script which provides the information necessary
 	to link your programs against the Guile library.
 guile-snarf --- a script to parse declarations in your C code for
 	Scheme-visible C functions, Scheme objects to be used by C code,
 	etc.

Libraries, in ${prefix}/lib.  Depending on the platform and options
        given to configure, you may get shared libraries in addition
	to or instead of these static libraries:

 libguile.a --- an object library containing the Guile interpreter,
 	You can use Guile in your own programs by linking against this.
 libguilereadline.a --- an object library containing glue code for the
        GNU readline library.

 libguile-srfi-*.a --- various SRFI support libraries

Header files, in ${prefix}/include:

 libguile.h, guile/gh.h, libguile/*.h --- for libguile.
 guile-readline/readline.h --- for guile-readline.

Support files, in ${prefix}/share/guile/<version>:

 ice-9/* --- run-time support for Guile: the module system,
 	read-eval-print loop, some R4RS code and other infrastructure.
 oop/* --- the Guile Object-Oriented Programming System (GOOPS)
 scripts/* --- executable modules, i.e., scheme programs that can be both
 	called as an executable from the shell, and loaded and used as a
 	module from scheme code.  See scripts/README for more info.
 srfi/* --- SRFI support modules.  See srfi/README for more info.

Automake macros, in ${prefix}/share/aclocal:

 guile.m4

Documentation in Info format, in ${prefix}/info:

 guile --- Guile reference manual.

 guile-tut --- Guile tutorial.

 GOOPS --- GOOPS reference manual.

 r5rs --- Revised(5) Report on the Algorithmic Language Scheme.

The Guile source tree is laid out as follows:

libguile:
	The Guile Scheme interpreter --- both the object library
	for you to link with your programs, and the executable you can run.
ice-9:  Guile's module system, initialization code, and other infrastructure.
guile-config:
	Source for the guile-config script.
guile-readline:
        The glue code for using GNU readline with Guile.  This
        will be build when configure can find a recent enough readline
        library on your system.
doc:	Documentation (see above).

Git Repository Access ================================================

Guile's source code is stored in a Git repository at Savannah.  Anyone
can access it using `git-clone' from one of the following URLs:

  git://git.sv.gnu.org/guile.git
  http://git.sv.gnu.org/r/guile.git

Developers with a Savannah SSH account can also access it from:

  ssh://git.sv.gnu.org/srv/git/guile.git

The repository can also be browsed on-line at the following address:

  http://git.sv.gnu.org/gitweb/?p=guile.git

For more information on Git, please see:

  http://git.or.cz/

Please send problem reports to <bug-guile@gnu.org>.

path: README

license: unknown


code:
Contributors since the last release:

	    Rob Browning
        Ludovic Courtès
         Julian Graham
         Stefan Jahn
           Neil Jerram
        Gregory Marton
        Antoine Mathys
      Thien-Thi Nguyen
        Han-Wen Nienhuys
         Jose A Ortega Ruiz
	  Kevin Ryde
	   Bill Schottstaedt
        Richard Todd

Sponsors since the last release:

      The Linux Developers Group

For fixes or providing information which led to a fix:

          David Allouche
	 Martin Baulig
        Fabrice Bauzac
        Sylvain Beucler
          Carlo Bramini
            Rob Browning
         Adrian Bunk
        Michael Carmack
        Stephen Compall
          Brian Crowder
    Christopher Cramer
          David Diffenbaugh
          Hyper Division
      Alexandre Duret-Lutz
           Nils Durner
         John W Eaton
	Clinton Ebadi
          David Fang
          Barry Fishman
        Charles Gagnon
          Peter Gavin
           Eric Gillespie, Jr
         Didier Godefroy
  Panicz Maciej Godek
           John Goerzen
           Mike Gran
         Szavai Gyula
         Roland Haeder
	   Sven Hartrumpf
	   Eric Hanchrow
	   Judy Hawkins
            Sam Hocevar
	Patrick Horgan
           Ales Hvezda
          Peter Ivanyi
       Wolfgang Jaehrling
         Aubrey Jaffer
           Paul Jarc
          Steve Juranich
        Richard Kim
          Bruce Korb
           René Köcher
       Matthias Köppe
           Matt Kraai
         Daniel Kraft
            Jay Krell
           Jeff Long
	  Marco Maggi
        Gregory Marton
      Kjetil S. Matheussen
        Antoine Mathys
            Dan McMahill
          Roger Mc Murtrie
          Scott McPeak
            Tim Mooney
        Han-Wen Nienhuys
            Jan Nieuwenhuizen
         Hrvoje Nikšić
         Stefan Nordhausen
         Roland Orre
	  Peter O'Gorman
         Pieter Pareit
           Jack Pavlovsky
           Arno Peters
	    Ron Peterson
          David Pirotte
            Ken Raeburn
        Andreas Rottmann
           Hugh Sasse
         Werner Scheinast
	   Bill Schottstaedt
	  Frank Schwidom
         Thiemo Seufer
          Scott Shedden
           Alex Shinn
         Daniel Skarda
          Cesar Strauss
         Rainer Tammer
        Richard Todd
          Issac Trotts
           Greg Troxel
       Aaron M. Ucko
        Stephen Uitti
        Momchil Velikov
	  Linas Vepstas
     Panagiotis Vossos
        Neil W. Van Dyke
          Aaron VanDevender
	Andreas Vögele
        Michael Talbot-Wilson
        Michael Tuexen
            Jon Wilson
           Andy Wingo
          Keith Wright

;; Local Variables:
;; coding: utf-8
;; End:

path: THANKS


code:
dnl  On the NeXT, #including <utime.h> doesn't give you a definition for
dnl  struct utime, unless you #define _POSIX_SOURCE.

AC_DEFUN([GUILE_STRUCT_UTIMBUF], [
  AC_CACHE_CHECK([whether we need POSIX to get struct utimbuf],
    guile_cv_struct_utimbuf_needs_posix,
    [AC_TRY_CPP([
#ifdef __EMX__
#include <sys/utime.h>
#else
#include <utime.h>
#endif
struct utime blah;
],
                guile_cv_struct_utimbuf_needs_posix=no,
		guile_cv_struct_utimbuf_needs_posix=yes)])
  if test "$guile_cv_struct_utimbuf_needs_posix" = yes; then
     AC_DEFINE([UTIMBUF_NEEDS_POSIX], 1,
       [Define this if <utime.h> doesn't define struct utimbuf unless
        _POSIX_SOURCE is defined.  See GUILE_STRUCT_UTIMBUF in aclocal.m4.])
  fi])

dnl
dnl Apparently, at CMU they have a weird version of libc.h that is
dnl installed in /usr/local/include and conflicts with unistd.h.
dnl In these situations, we should not #include libc.h.
dnl This test arranges to #define LIBC_H_WITH_UNISTD_H iff libc.h is
dnl present on the system, and is safe to #include.
dnl
AC_DEFUN([GUILE_HEADER_LIBC_WITH_UNISTD],
  [
    AC_CHECK_HEADERS(libc.h unistd.h)
    AC_CACHE_CHECK(
      [whether libc.h and unistd.h can be included together],
      guile_cv_header_libc_with_unistd,
      [
        if test "$ac_cv_header_libc_h" = "no"; then
          guile_cv_header_libc_with_unistd="no"
        elif test "$ac_cv_header_unistd_h" = "no"; then
          guile_cv_header_libc_with_unistd="yes"
        else
          AC_TRY_COMPILE(
	    [
#             include <libc.h>
#             include <unistd.h>
	    ],
	    [],
	    [guile_cv_header_libc_with_unistd=yes],
	    [guile_cv_header_libc_with_unistd=no]
          )
        fi
      ]
    )
    if test "$guile_cv_header_libc_with_unistd" = yes; then
      AC_DEFINE(LIBC_H_WITH_UNISTD_H, 1,
        [Define this if we should include <libc.h> when we've already
         included <unistd.h>.  On some systems, they conflict, and libc.h
         should be omitted.  See GUILE_HEADER_LIBC_WITH_UNISTD in
         aclocal.m4.])
    fi
  ]
)

dnl This is needed when we want to check for the same function repeatedly
dnl with other parameters, such as libraries, varying.
dnl
dnl GUILE_NAMED_CHECK_FUNC(FUNCTION, TESTNAME,
dnl                        [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
AC_DEFUN([GUILE_NAMED_CHECK_FUNC],
[AC_MSG_CHECKING([for $1])
AC_CACHE_VAL(ac_cv_func_$1_$2,
[AC_TRY_LINK(
dnl Don't include <ctype.h> because on OSF/1 3.0 it includes <sys/types.h>
dnl which includes <sys/select.h> which contains a prototype for
dnl select.  Similarly for bzero.
[/* System header to define __stub macros and hopefully few prototypes,
    which can conflict with char $1(); below.  */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error.  */
#ifdef __cplusplus
extern "C"
#endif
/* We use char because int might match the return type of a gcc2
    builtin and then its argument prototype would still apply.  */
char $1();
], [
/* The GNU C library defines this for functions which it implements
    to always fail with ENOSYS.  Some functions are actually named
    something starting with __ and the normal name is an alias.  */
#if defined (__stub_$1) || defined (__stub___$1)
choke me
#else
$1();
#endif
], eval "ac_cv_func_$1_$2=yes", eval "ac_cv_func_$1_$2=no")])
if eval "test \"`echo '$ac_cv_func_'$1'_'$2`\" = yes"; then
  AC_MSG_RESULT(yes)
  ifelse([$3], , :, [$3])
else
  AC_MSG_RESULT(no)
ifelse([$4], , , [$4
])dnl
fi
])

dnl Available from the Autoconf Macro Archive at:
dnl http://autoconf-archive.cryp.to/acx_pthread.html
dnl
AC_DEFUN([ACX_PTHREAD], [
AC_REQUIRE([AC_CANONICAL_HOST])
AC_LANG_SAVE
AC_LANG_C
acx_pthread_ok=no

# We used to check for pthread.h first, but this fails if pthread.h
# requires special compiler flags (e.g. on True64 or Sequent).
# It gets checked for in the link test anyway.

# First of all, check if the user has set any of the PTHREAD_LIBS,
# etcetera environment variables, and if threads linking works using
# them:
if test x"$PTHREAD_LIBS$PTHREAD_CFLAGS" != x; then
        save_CFLAGS="$CFLAGS"
        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
        save_LIBS="$LIBS"
        LIBS="$PTHREAD_LIBS $LIBS"
        AC_MSG_CHECKING([for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS])
        AC_TRY_LINK_FUNC(pthread_join, acx_pthread_ok=yes)
        AC_MSG_RESULT($acx_pthread_ok)
        if test x"$acx_pthread_ok" = xno; then
                PTHREAD_LIBS=""
                PTHREAD_CFLAGS=""
        fi
        LIBS="$save_LIBS"
        CFLAGS="$save_CFLAGS"
fi

# We must check for the threads library under a number of different
# names; the ordering is very important because some systems
# (e.g. DEC) have both -lpthread and -lpthreads, where one of the
# libraries is broken (non-POSIX).

# Create a list of thread flags to try.  Items starting with a "-" are
# C compiler flags, and other items are library names, except for "none"
# which indicates that we try without any flags at all, and "pthread-config"
# which is a program returning the flags for the Pth emulation library.

acx_pthread_flags="pthreads none -Kthread -kthread lthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config"

# The ordering *is* (sometimes) important.  Some notes on the
# individual items follow:

# pthreads: AIX (must check this before -lpthread)
# none: in case threads are in libc; should be tried before -Kthread and
#       other compiler flags to prevent continual compiler warnings
# -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h)
# -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able)
# lthread: LinuxThreads port on FreeBSD (also preferred to -pthread)
# -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads)
# -pthreads: Solaris/gcc
# -mthreads: Mingw32/gcc, Lynx/gcc
# -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it
#      doesn't hurt to check since this sometimes defines pthreads too;
#      also defines -D_REENTRANT)
#      ... -mt is also the pthreads flag for HP/aCC
# pthread: Linux, etcetera
# --thread-safe: KAI C++
# pthread-config: use pthread-config program (for GNU Pth library)

case "${host_cpu}-${host_os}" in
        *solaris*)

        # On Solaris (at least, for some versions), libc contains stubbed
        # (non-functional) versions of the pthreads routines, so link-based
        # tests will erroneously succeed.  (We need to link with -pthreads/-mt/
        # -lpthread.)  (The stubs are missing pthread_cleanup_push, or rather
        # a function called by this macro, so we could check for that, but
        # who knows whether they'll stub that too in a future libc.)  So,
        # we'll just look for -pthreads and -lpthread first:

        acx_pthread_flags="-pthreads pthread -mt -pthread $acx_pthread_flags"
        ;;
esac

if test x"$acx_pthread_ok" = xno; then
for flag in $acx_pthread_flags; do

        case $flag in
                none)
                AC_MSG_CHECKING([whether pthreads work without any flags])
                ;;

                -*)
                AC_MSG_CHECKING([whether pthreads work with $flag])
                PTHREAD_CFLAGS="$flag"
                ;;

                pthread-config)
                AC_CHECK_PROG(acx_pthread_config, pthread-config, yes, no)
                if test x"$acx_pthread_config" = xno; then continue; fi
                PTHREAD_CFLAGS="`pthread-config --cflags`"
                PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`"
                ;;

                *)
                AC_MSG_CHECKING([for the pthreads library -l$flag])
                PTHREAD_LIBS="-l$flag"
                ;;
        esac

        save_LIBS="$LIBS"
        save_CFLAGS="$CFLAGS"
        LIBS="$PTHREAD_LIBS $LIBS"
        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"

        # Check for various functions.  We must include pthread.h,
        # since some functions may be macros.  (On the Sequent, we
        # need a special flag -Kthread to make this header compile.)
        # We check for pthread_join because it is in -lpthread on IRIX
        # while pthread_create is in libc.  We check for pthread_attr_init
        # due to DEC craziness with -lpthreads.  We check for
        # pthread_cleanup_push because it is one of the few pthread
        # functions on Solaris that doesn't have a non-functional libc stub.
        # We try pthread_create on general principles.
        AC_TRY_LINK([#include <pthread.h>],
                    [pthread_t th; pthread_join(th, 0);
                     pthread_attr_init(0); pthread_cleanup_push(0, 0);
                     pthread_create(0,0,0,0); pthread_cleanup_pop(0); ],
                    [acx_pthread_ok=yes])

        LIBS="$save_LIBS"
        CFLAGS="$save_CFLAGS"

        AC_MSG_RESULT($acx_pthread_ok)
        if test "x$acx_pthread_ok" = xyes; then
                break;
        fi

        PTHREAD_LIBS=""
        PTHREAD_CFLAGS=""
done
fi

# Various other checks:
if test "x$acx_pthread_ok" = xyes; then
        save_LIBS="$LIBS"
        LIBS="$PTHREAD_LIBS $LIBS"
        save_CFLAGS="$CFLAGS"
        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"

        # Detect AIX lossage: JOINABLE attribute is called UNDETACHED.
        AC_MSG_CHECKING([for joinable pthread attribute])
        attr_name=unknown
        for attr in PTHREAD_CREATE_JOINABLE PTHREAD_CREATE_UNDETACHED; do
            AC_TRY_LINK([#include <pthread.h>], [int attr=$attr; return attr;],
                        [attr_name=$attr; break])
        done
        AC_MSG_RESULT($attr_name)
        if test "$attr_name" != PTHREAD_CREATE_JOINABLE; then
            AC_DEFINE_UNQUOTED(PTHREAD_CREATE_JOINABLE, $attr_name,
                               [Define to necessary symbol if this constant
                                uses a non-standard name on your system.])
        fi

        AC_MSG_CHECKING([if more special flags are required for pthreads])
        flag=no
        case "${host_cpu}-${host_os}" in
            *-aix* | *-freebsd* | *-darwin*) flag="-D_THREAD_SAFE";;
            *solaris* | *-osf* | *-hpux*) flag="-D_REENTRANT";;
        esac
        AC_MSG_RESULT(${flag})
        if test "x$flag" != xno; then
            PTHREAD_CFLAGS="$flag $PTHREAD_CFLAGS"
        fi

        LIBS="$save_LIBS"
        CFLAGS="$save_CFLAGS"

        # More AIX lossage: must compile with xlc_r or cc_r
        if test x"$GCC" != xyes; then
          AC_CHECK_PROGS(PTHREAD_CC, xlc_r cc_r, ${CC})
        else
          PTHREAD_CC=$CC
        fi
else
        PTHREAD_CC="$CC"
fi

AC_SUBST(PTHREAD_LIBS)
AC_SUBST(PTHREAD_CFLAGS)
AC_SUBST(PTHREAD_CC)

# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$acx_pthread_ok" = xyes; then
        ifelse([$1],,AC_DEFINE(HAVE_PTHREAD,1,[Define if you have POSIX threads libraries and header files.]),[$1])
        :
else
        acx_pthread_ok=no
        $2
fi
AC_LANG_RESTORE
])dnl ACX_PTHREAD


code:
2002-04-10  Rob Browning  <rlb@defaultvalue.org>

	* .cvsignore: add Makefile and Makefile.in.

2002-04-01  Thien-Thi Nguyen  <ttn@giblet.glug.org>

	* maintainer-dirs: Remove "if MAINTAINER_MODE" conditional.

2002-03-30  Thien-Thi Nguyen  <ttn@giblet.glug.org>

	* maintainer-dirs: New file.

	* Makefile.am (am_frags): Add "maintainer-dirs".

2002-02-26  Thien-Thi Nguyen  <ttn@giblet.glug.org>

	* pre-inst-guile, Makefile.am, README: New files.


code:
## Process this file with Automake to create Makefile.in
##
##  	Copyright (C) 2002, 2006, 2008 Free Software Foundation, Inc.
##
##   This file is part of GUILE.
##
##   GUILE 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.
##
##   GUILE 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 GUILE; see the file COPYING.  If not, write
##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
##   Floor, Boston, MA 02110-1301 USA

AUTOMAKE_OPTIONS = gnu

am_frags = pre-inst-guile maintainer-dirs

EXTRA_DIST = $(am_frags) ChangeLog-2008

## Makefile.am ends here


code:
data directory: automake frags

do not name files using extension ".am", as automake is overzealous sometimes.

path: am/README


code:
## am/maintainer-dirs --- define workbook and mscripts vars

##	Copyright (C) 2002, 2006 Free Software Foundation
##
##   This file is part of GUILE.
##
##   GUILE 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.
##
##   GUILE 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 GUILE; see the file COPYING.  If not, write
##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
##   Floor, Boston, MA 02110-1301 USA

## Commentary:

## This fragment defines two variables: workbook and mscripts.
## It can be included in any Makefile.am by adding the line:
##   include $(top_srcdir)/am/maintainer-dirs
## See $(workbook)/build/maintainer-dirs.text for more info.

## Code:

workbook	= $(top_srcdir_absolute)/../workbook
mscripts	= $(top_srcdir_absolute)/../scripts

## am/maintainer-dirs ends here

path: am/maintainer-dirs


code:
## am/pre-inst-guile --- define preinstguile and preinstguiletool vars

##	Copyright (C) 2002, 2006 Free Software Foundation
##
##   This file is part of GUILE.
##
##   GUILE 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.
##
##   GUILE 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 GUILE; see the file COPYING.  If not, write
##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
##   Floor, Boston, MA 02110-1301 USA

## Commentary:

## This fragment defines two variables: preinstguile, preinstguiletool.
## It can be included in any Makefile.am by adding the line:
##   include $(top_srcdir)/am/pre-inst-guile
## See devel/build/pre-inst-guile.text (CVS only) for more info.

## Code:

preinstguile     = $(top_builddir_absolute)/pre-inst-guile
preinstguiletool = GUILE="$(preinstguile)" $(top_srcdir)/scripts

## am/pre-inst-guile ends here

path: am/pre-inst-guile


code:
#!/bin/sh
# Usage: sh -x ./autogen.sh

set -e

[ -f GUILE-VERSION ] || {
  echo "autogen.sh: run this command only at the top of guile-core."
  exit 1
}

######################################################################
### update infrastructure

autoreconf -i --force --verbose

echo "Now run configure and make."


code:
#! /bin/sh
# Usage: benchmark-guile [-i GUILE-INTERPRETER] [GUILE-BENCHMARK-ARGS]
# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/pre-inst-guile.
# See ${top_srcdir}/benchmark-suite/guile-benchmark for documentation on GUILE-BENCHMARK-ARGS.
#
# Example invocations:
# ./benchmark-guile
# ./benchmark-guile numbers.bm
# ./benchmark-guile -i /usr/local/bin/guile
# ./benchmark-guile -i /usr/local/bin/guile numbers.bm

set -e

top_builddir=@top_builddir_absolute@
top_srcdir=@top_srcdir_absolute@

BENCHMARK_SUITE_DIR=${top_srcdir}/benchmark-suite

if [ x"$1" = x-i ] ; then
    guile=$2
    shift
    shift
else
    guile=${top_builddir}/pre-inst-guile
fi

GUILE_LOAD_PATH=$BENCHMARK_SUITE_DIR
export GUILE_LOAD_PATH

if [ -f "$guile" -a -x "$guile" ] ; then
    echo Benchmarking $guile ... "$@"
    echo with GUILE_LOAD_PATH=$GUILE_LOAD_PATH
else
    echo ERROR: Cannot execute $guile
    exit 1
fi

# documentation searching ignores GUILE_LOAD_PATH.
if [ ! -f guile-procedures.txt ] ; then
   @LN_S@ libguile/guile-procedures.txt .
fi

exec $guile \
    -e main -s "$BENCHMARK_SUITE_DIR/guile-benchmark" \
    --benchmark-suite "$BENCHMARK_SUITE_DIR/benchmarks" \
    --log-file benchmark-guile.log "$@"

# benchmark-guile ends here


code:
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-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.


code:
SCM_BENCHMARKS = benchmarks/0-reference.bm		\
	         benchmarks/continuations.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)	\
	     ChangeLog-2008


code:
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.

path: benchmark-suite/README


code:
(benchmark "reference benchmark for iteration counts" 330000
  #t)


code:
(define (callee continuation)
  (continuation #t))

(benchmark "call/cc" 300
  (call-with-current-continuation callee))


code:
(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)))


code:
(define bignum (1- (expt 2 128)))

(let* ((i 0))
  (benchmark "bignum" 130000
    (logand i bignum)
    (set! i (+ i 1))))


code:
;;; read.bm --- Exercise the reader.               -*- Scheme -*-
;;;
;;; Copyright (C) 2008 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 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")))

(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))

(with-benchmark-prefix "read"

  (benchmark "_IONBF" 5  ;; this one is very slow
    (exercise-read (list _IONBF)))

  (benchmark "_IOLBF" 100
    (exercise-read (list _IOLBF)))

  (benchmark "_IOFBF 4096" 100
    (exercise-read (list _IOFBF 4096)))

  (benchmark "_IOFBF 8192" 100
    (exercise-read (list _IOFBF 8192)))

  (benchmark "_IOFBF 16384" 100
    (exercise-read (list _IOFBF 16384))))


code:
;;; 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))

(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))))


code:
;;; uniform-vector-read.bm --- Exercise binary I/O primitives.  -*- Scheme -*-
;;;
;;; Copyright (C) 2008 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 uniform-vector-read)
  :use-module (benchmark-suite lib)
  :use-module (srfi srfi-4))

(define file-name
  (tmpnam))

(define %buffer-size
  7777)

(define buf
  (make-u8vector %buffer-size))

(define str
  (make-string %buffer-size))

(with-benchmark-prefix "uniform-vector-read!"

  (benchmark "uniform-vector-write" 500
    (let ((output (open-output-file file-name)))
      (uniform-vector-write buf output)
      (close output)))

  (benchmark "uniform-vector-read!" 500
    (let ((input (open-input-file file-name)))
      (setvbuf input _IONBF)
      (uniform-vector-read! buf input)
      (close input)))

  (benchmark "string port" 5000
    (let ((input (open-input-string str)))
      (uniform-vector-read! buf input)
      (close input))))


code:
#!../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 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

;;;; 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 (has-suffix? file ".bm")
			 (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:

path: benchmark-suite/guile-benchmark


code:
;;;; benchmark-suite/lib.scm --- generic support for benchmarking
;;;; Copyright (C) 2002, 2006 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 (benchmark-suite lib)
  :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

 ;; Computing timing results
 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

 ;; Reporting results in various ways.
 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
;;;; postpends 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 (times) and (gc-run-time) to
;;;; determine the execution time for a single benchmark.  Based on these
;;;; functions, the values of BEFORE, AFTER and GC-TIME are computed, which
;;;; are then passed to the reporter functions.  All three values BEFORE,
;;;; AFTER and GC-TIME 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.
;;;;
;;;; In order to simplify the time calculation for users who want to write
;;;; their own reporters, benchmarking framework provides the following
;;;; definitions:
;;;;
;;;; benchmark-time-base : This variable holds the number of time units that
;;;;     make up a second.  By deviding the results of each of the functions
;;;;     below by this value, you get the corresponding time in seconds.  For
;;;;     example (/ (benchmark-total-time before after) benchmark-time-base)
;;;;     will give you the total time in seconds.
;;;; benchmark-total-time : this function takes two arguments BEFORE and AFTER
;;;;     and computes the total time between the two timestamps.  The result
;;;;     of this function is what the time command of the unix command line
;;;;     would report as real time.
;;;; benchmark-user-time : this function takes two arguments BEFORE and AFTER
;;;;     and computes the time spent in the benchmarking process between the
;;;;     two timestamps.  That means, the time consumed by other processes
;;;;     running on the same machine is not part of the resulting time,
;;;;     neither is time spent within the operating system.  The result of
;;;;     this function is what the time command of the unix command line would
;;;;     report as user time.
;;;; benchmark-system-time : similar to benchmark-user-time, but here the time
;;;;     spent within the operating system is given.  The result of this
;;;;     function is what the time command of the unix command line would
;;;;     report as system time.
;;;; benchmark-frame-time : this function takes the argument ITERATIONS.  It
;;;;     reports the part of the user time that is consumed by the
;;;;     benchmarking framework itself to run some benchmark for the given
;;;;     number of iterations.  You can think of this as the time that would
;;;;     still be consumed, even if the benchmarking code itself was empty.
;;;;     This value does not include any time for garbage collection, even if
;;;;     it is the benchmarking framework which is responsible for causing a
;;;;     garbage collection.
;;;; benchmark-core-time : this function takes three arguments ITERATIONS,
;;;;     BEFORE and AFTER.  It reports the part of the user time that is
;;;;     actually spent within the benchmarking code.  That is, the time
;;;;     needed for the benchmarking framework is subtracted from the user
;;;;     time.  This value, however, includes all garbage collection times,
;;;;     even if some part of the gc-time had actually to be attributed to the
;;;;     benchmarking framework.
;;;; benchmark-user-time\interpreter : this function takes three arguments
;;;;     BEFORE AFTER and GC-TIME.  It reports the part of the user time that
;;;;     is spent in the interpreter (and not in garbage collection).
;;;; benchmark-core-time\interpreter : this function takes four arguments
;;;;     ITERATIONS, BEFORE, AFTER.   and GC-TIME.  It reports the part of the
;;;;     benchmark-core-time that is spent in the interpreter (and not in
;;;;     garbage collection).  This value is most probably the one you are
;;;;     interested in, except if you are doing some garbage collection
;;;;     checks.
;;;;
;;;; There is no function to calculate the garbage-collection time, since the
;;;; garbage collection time is already passed as an argument GC-TIME to the
;;;; reporter functions.

;;;; MISCELLANEOUS
;;;;

;;; Perform a division and convert the result to inexact.
(define (i/ a b)
  (exact->inexact (/ a b)))

;;; 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)))

;;;; CORE FUNCTIONS
;;;;

;;; The central routine for executing benchmarks.
;;; The idea is taken from Greg, the GNUstep regression test environment.
(define run-benchmark #f)
(let ((benchmark-running #f))
  (define (local-run-benchmark name iterations thunk)
    (if benchmark-running
	(error "Nested calls to run-benchmark are not permitted.")
	(let ((benchmark-name (full-name name))
	      (iterations (scale-iterations iterations)))
	  (set! benchmark-running #t)
	  (let ((before #f) (after #f) (gc-time #f))
	    (gc)
	    (set! gc-time (gc-run-time))
	    (set! before (times))
	    (do ((i 0 (+ i 1)))
		((= i iterations))
	      (thunk))
	    (set! after (times))
	    (set! gc-time (- (gc-run-time) gc-time))
	    (report benchmark-name iterations before after gc-time))
	  (set! benchmark-running #f))))
  (set! run-benchmark local-run-benchmark))

;;; A short form for benchmarks.
(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)
  (call-with-output-string
   (lambda (port)
     (let loop ((name name)
		(separator ""))
       (if (pair? name)
	   (begin
	     (display separator port)
	     (display (car name) port)
	     (loop (cdr name) ": ")))))))

;;;; For a given benchmark-name, deliver the full name including all prefixes.
(define (full-name name)
  (append (current-benchmark-prefix) (list name)))

;;; A fluid containing the current benchmark prefix, as a list.
(define prefix-fluid (make-fluid))
(fluid-set! prefix-fluid '())
(define (current-benchmark-prefix)
  (fluid-ref prefix-fluid))

;;; 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)
  (with-fluids ((prefix-fluid
		 (append (fluid-ref prefix-fluid) (list 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.
(defmacro with-benchmark-prefix (prefix . body)
  `(with-benchmark-prefix* ,prefix (lambda () ,@body)))

;;;; TIME CALCULATION
;;;;

(define benchmark-time-base
  internal-time-units-per-second)

(define time-base ;; short-cut, not exported
  benchmark-time-base)

(define frame-time/iteration
  "<will be set during initialization>")

(define (benchmark-total-time before after)
  (- (tms:clock after) (tms:clock before)))

(define (benchmark-user-time before after)
  (- (tms:utime after) (tms:utime before)))

(define (benchmark-system-time before after)
  (- (tms:stime after) (tms:stime before)))

(define (benchmark-frame-time iterations)
  (* iterations frame-time/iteration))

(define (benchmark-core-time iterations before after)
  (- (benchmark-user-time before after) (benchmark-frame-time iterations)))

(define (benchmark-user-time\interpreter before after gc-time)
  (- (benchmark-user-time before after) gc-time))

(define (benchmark-core-time\interpreter iterations before after gc-time)
  (- (benchmark-core-time iterations before after) gc-time))

;;;; REPORTERS
;;;;

;;; The global list of reporters.
(define reporters '())

;;; The default reporter, to be used only if no others exist.
(define default-reporter #f)

;;; Add the procedure REPORTER to the current set of reporter functions.
;;; Signal an error if that reporter procedure object is already registered.
(define (register-reporter reporter)
  (if (memq reporter reporters)
      (error "register-reporter: reporter already registered: " reporter))
  (set! reporters (cons reporter reporters)))

;;; Remove the procedure REPORTER from the current set of reporter
;;; functions.  Signal an error if REPORTER is not currently registered.
(define (unregister-reporter reporter)
  (if (memq reporter reporters)
      (set! reporters (delq! reporter reporters))
      (error "unregister-reporter: reporter not registered: " reporter)))

;;; Return true iff REPORTER is in the current set of reporter functions.
(define (reporter-registered? reporter)
  (if (memq reporter reporters) #t #f))

;;; Send RESULT to all currently registered reporter functions.
(define (report . args)
  (if (pair? reporters)
      (for-each (lambda (reporter) (apply reporter args))
		reporters)
      (apply default-reporter args)))

;;;; 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 name iterations before after gc-time)
  (let* ((name (format-benchmark-name name))
	 (total-time (benchmark-total-time before after))
	 (user-time (benchmark-user-time before after))
	 (system-time (benchmark-system-time before after))
	 (frame-time (benchmark-frame-time iterations))
	 (benchmark-time (benchmark-core-time iterations before after))
	 (user-time\interpreter
	  (benchmark-user-time\interpreter before after gc-time))
	 (benchmark-core-time\interpreter
	  (benchmark-core-time\interpreter iterations before after gc-time)))
    (write (list name iterations
		 'total (i/ total-time time-base)
		 'user (i/ user-time time-base)
		 'system (i/ system-time time-base)
		 'frame (i/ frame-time time-base)
		 'benchmark (i/ benchmark-time time-base)
		 'user/interp (i/ user-time\interpreter time-base)
		 'bench/interp (i/ benchmark-core-time\interpreter time-base)
		 'gc (i/ gc-time time-base))
	   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 args
      (apply print-result port args)
      (force-output port))))

;;; A reporter that reports all results to the user.
(define (full-reporter . args)
  (apply print-result (current-output-port) args))

;;; Display interesting results of a single benchmark to the given port
(define (print-user-result port name iterations before after gc-time)
  (let* ((name (format-benchmark-name name))
	 (user-time (benchmark-user-time before after))
	 (benchmark-time (benchmark-core-time iterations before after))
	 (benchmark-core-time\interpreter
	  (benchmark-core-time\interpreter iterations before after gc-time)))
    (write (list name iterations
		 'user (i/ user-time time-base)
		 'benchmark (i/ benchmark-time time-base)
		 'bench/interp (i/ benchmark-core-time\interpreter time-base)
		 'gc (i/ gc-time time-base))
	   port)
    (newline port)))

;;; A reporter that reports interesting results to the user.
(define (user-reporter . args)
  (apply print-user-result (current-output-port) args))

;;;; Initialize the benchmarking system:
;;;;

;;; First, display version information
(display ";; running guile version " (current-output-port))
(display (version) (current-output-port))
(newline (current-output-port))

;;; Second, make sure the benchmarking routines are compiled.
(define (null-reporter . args) #t)
(set! default-reporter null-reporter)
(benchmark "empty initialization benchmark" 2 #t)

;;; Third, initialize the system constants
(display ";; calibrating the benchmarking framework..." (current-output-port))
(newline (current-output-port))
(define (initialization-reporter name iterations before after gc-time)
  (let* ((frame-time (- (tms:utime after) (tms:utime before) gc-time 3)))
    (set! frame-time/iteration (/ frame-time iterations))
    (display ";; framework time per iteration: " (current-output-port))
    (display (i/ frame-time/iteration time-base) (current-output-port))
    (newline (current-output-port))))
(set! default-reporter initialization-reporter)
(benchmark "empty initialization benchmark" 524288 #t)

;;; Finally, set the default reporter
(set! default-reporter user-reporter)


code:
#! /bin/sh
# Output a system dependent set of variables, describing how to set the
# run time search path of shared libraries in an executable.
#
#   Copyright 1996-2008 Free Software Foundation, Inc.
#   Taken from GNU libtool, 2001
#   Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
#
#   This file is free software; the Free Software Foundation gives
#   unlimited permission to copy and/or distribute it, with or without
#   modifications, as long as this notice is preserved.
#
# The first argument passed to this file is the canonical host specification,
#    CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
# or
#    CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
# The environment variables CC, GCC, LDFLAGS, LD, with_gnu_ld
# should be set by the caller.
#
# The set of defined variables is at the end of this script.

# Known limitations:
# - On IRIX 6.5 with CC="cc", the run time search patch must not be longer
#   than 256 bytes, otherwise the compiler driver will dump core. The only
#   known workaround is to choose shorter directory names for the build
#   directory and/or the installation directory.

# All known linkers require a `.a' archive for static linking (except MSVC,
# which needs '.lib').
libext=a
shrext=.so

host="$1"
host_cpu=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
host_vendor=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
host_os=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`

# Code taken from libtool.m4's _LT_CC_BASENAME.

for cc_temp in $CC""; do
  case $cc_temp in
    compile | *[\\/]compile | ccache | *[\\/]ccache ) ;;
    distcc | *[\\/]distcc | purify | *[\\/]purify ) ;;
    \-*) ;;
    *) break;;
  esac
done
cc_basename=`echo "$cc_temp" | sed -e 's%^.*/%%'`

# Code taken from libtool.m4's AC_LIBTOOL_PROG_COMPILER_PIC.

wl=
if test "$GCC" = yes; then
  wl='-Wl,'
else
  case "$host_os" in
    aix*)
      wl='-Wl,'
      ;;
    darwin*)
      case $cc_basename in
        xlc*)
          wl='-Wl,'
          ;;
      esac
      ;;
    mingw* | cygwin* | pw32* | os2*)
      ;;
    hpux9* | hpux10* | hpux11*)
      wl='-Wl,'
      ;;
    irix5* | irix6* | nonstopux*)
      wl='-Wl,'
      ;;
    newsos6)
      ;;
    linux* | k*bsd*-gnu)
      case $cc_basename in
        icc* | ecc*)
          wl='-Wl,'
          ;;
        pgcc | pgf77 | pgf90)
          wl='-Wl,'
          ;;
        ccc*)
          wl='-Wl,'
          ;;
        como)
          wl='-lopt='
          ;;
        *)
          case `$CC -V 2>&1 | sed 5q` in
            *Sun\ C*)
              wl='-Wl,'
              ;;
          esac
          ;;
      esac
      ;;
    osf3* | osf4* | osf5*)
      wl='-Wl,'
      ;;
    rdos*)
      ;;
    solaris*)
      wl='-Wl,'
      ;;
    sunos4*)
      wl='-Qoption ld '
      ;;
    sysv4 | sysv4.2uw2* | sysv4.3*)
      wl='-Wl,'
      ;;
    sysv4*MP*)
      ;;
    sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
      wl='-Wl,'
      ;;
    unicos*)
      wl='-Wl,'
      ;;
    uts4*)
      ;;
  esac
fi

# Code taken from libtool.m4's AC_LIBTOOL_PROG_LD_SHLIBS.

hardcode_libdir_flag_spec=
hardcode_libdir_separator=
hardcode_direct=no
hardcode_minus_L=no

case "$host_os" in
  cygwin* | mingw* | pw32*)
    # FIXME: the MSVC++ port hasn't been tested in a loooong time
    # When not using gcc, we currently assume that we are using
    # Microsoft Visual C++.
    if test "$GCC" != yes; then
      with_gnu_ld=no
    fi
    ;;
  interix*)
    # we just hope/assume this is gcc and not c89 (= MSVC++)
    with_gnu_ld=yes
    ;;
  openbsd*)
    with_gnu_ld=no
    ;;
esac

ld_shlibs=yes
if test "$with_gnu_ld" = yes; then
  # Set some defaults for GNU ld with shared library support. These
  # are reset later if shared libraries are not supported. Putting them
  # here allows them to be overridden if necessary.
  # Unlike libtool, we use -rpath here, not --rpath, since the documented
  # option of GNU ld is called -rpath, not --rpath.
  hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
  case "$host_os" in
    aix[3-9]*)
      # On AIX/PPC, the GNU linker is very broken
      if test "$host_cpu" != ia64; then
        ld_shlibs=no
      fi
      ;;
    amigaos*)
      hardcode_libdir_flag_spec='-L$libdir'
      hardcode_minus_L=yes
      # Samuel A. Falvo II <kc5tja@dolphin.openprojects.net> reports
      # that the semantics of dynamic libraries on AmigaOS, at least up
      # to version 4, is to share data among multiple programs linked
      # with the same dynamic library.  Since this doesn't match the
      # behavior of shared libraries on other platforms, we cannot use
      # them.
      ld_shlibs=no
      ;;
    beos*)
      if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then
        :
      else
        ld_shlibs=no
      fi
      ;;
    cygwin* | mingw* | pw32*)
      # hardcode_libdir_flag_spec is actually meaningless, as there is
      # no search path for DLLs.
      hardcode_libdir_flag_spec='-L$libdir'
      if $LD --help 2>&1 | grep 'auto-import' > /dev/null; then
        :
      else
        ld_shlibs=no
      fi
      ;;
    interix[3-9]*)
      hardcode_direct=no
      hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
      ;;
    gnu* | linux* | k*bsd*-gnu)
      if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then
        :
      else
        ld_shlibs=no
      fi
      ;;
    netbsd*)
      ;;
    solaris*)
      if $LD -v 2>&1 | grep 'BFD 2\.8' > /dev/null; then
        ld_shlibs=no
      elif $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then
        :
      else
        ld_shlibs=no
      fi
      ;;
    sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*)
      case `$LD -v 2>&1` in
        *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*)
          ld_shlibs=no
          ;;
        *)
          if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then
            hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-rpath,$libdir`'
          else
            ld_shlibs=no
          fi
          ;;
      esac
      ;;
    sunos4*)
      hardcode_direct=yes
      ;;
    *)
      if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then
        :
      else
        ld_shlibs=no
      fi
      ;;
  esac
  if test "$ld_shlibs" = no; then
    hardcode_libdir_flag_spec=
  fi
else
  case "$host_os" in
    aix3*)
      # Note: this linker hardcodes the directories in LIBPATH if there
      # are no directories specified by -L.
      hardcode_minus_L=yes
      if test "$GCC" = yes; then
        # Neither direct hardcoding nor static linking is supported with a
        # broken collect2.
        hardcode_direct=unsupported
      fi
      ;;
    aix[4-9]*)
      if test "$host_cpu" = ia64; then
        # On IA64, the linker does run time linking by default, so we don't
        # have to do anything special.
        aix_use_runtimelinking=no
      else
        aix_use_runtimelinking=no
        # Test if we are trying to use run time linking or normal
        # AIX style linking. If -brtl is somewhere in LDFLAGS, we
        # need to do runtime linking.
        case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*)
          for ld_flag in $LDFLAGS; do
            if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
              aix_use_runtimelinking=yes
              break
            fi
          done
          ;;
        esac
      fi
      hardcode_direct=yes
      hardcode_libdir_separator=':'
      if test "$GCC" = yes; then
        case $host_os in aix4.[012]|aix4.[012].*)
          collect2name=`${CC} -print-prog-name=collect2`
          if test -f "$collect2name" && \
            strings "$collect2name" | grep resolve_lib_name >/dev/null
          then
            # We have reworked collect2
            :
          else
            # We have old collect2
            hardcode_direct=unsupported
            hardcode_minus_L=yes
            hardcode_libdir_flag_spec='-L$libdir'
            hardcode_libdir_separator=
          fi
          ;;
        esac
      fi
      # Begin _LT_AC_SYS_LIBPATH_AIX.
      echo 'int main () { return 0; }' > conftest.c
      ${CC} ${LDFLAGS} conftest.c -o conftest
      aix_libpath=`dump -H conftest 2>/dev/null | sed -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0  *\(.*\)$/\1/; p; }
}'`
      if test -z "$aix_libpath"; then
        aix_libpath=`dump -HX64 conftest 2>/dev/null | sed -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0  *\(.*\)$/\1/; p; }
}'`
      fi
      if test -z "$aix_libpath"; then
        aix_libpath="/usr/lib:/lib"
      fi
      rm -f conftest.c conftest
      # End _LT_AC_SYS_LIBPATH_AIX.
      if test "$aix_use_runtimelinking" = yes; then
        hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath"
      else
        if test "$host_cpu" = ia64; then
          hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib'
        else
          hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath"
        fi
      fi
      ;;
    amigaos*)
      hardcode_libdir_flag_spec='-L$libdir'
      hardcode_minus_L=yes
      # see comment about different semantics on the GNU ld section
      ld_shlibs=no
      ;;
    bsdi[45]*)
      ;;
    cygwin* | mingw* | pw32*)
      # When not using gcc, we currently assume that we are using
      # Microsoft Visual C++.
      # hardcode_libdir_flag_spec is actually meaningless, as there is
      # no search path for DLLs.
      hardcode_libdir_flag_spec=' '
      libext=lib
      ;;
    darwin* | rhapsody*)
      hardcode_direct=no
      if test "$GCC" = yes ; then
        :
      else
        case $cc_basename in
          xlc*)
            ;;
          *)
            ld_shlibs=no
            ;;
        esac
      fi
      ;;
    dgux*)
      hardcode_libdir_flag_spec='-L$libdir'
      ;;
    freebsd1*)
      ld_shlibs=no
      ;;
    freebsd2.2*)
      hardcode_libdir_flag_spec='-R$libdir'
      hardcode_direct=yes
      ;;
    freebsd2*)
      hardcode_direct=yes
      hardcode_minus_L=yes
      ;;
    freebsd* | dragonfly*)
      hardcode_libdir_flag_spec='-R$libdir'
      hardcode_direct=yes
      ;;
    hpux9*)
      hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
      hardcode_libdir_separator=:
      hardcode_direct=yes
      # hardcode_minus_L: Not really in the search PATH,
      # but as the default location of the library.
      hardcode_minus_L=yes
      ;;
    hpux10*)
      if test "$with_gnu_ld" = no; then
        hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
        hardcode_libdir_separator=:
        hardcode_direct=yes
        # hardcode_minus_L: Not really in the search PATH,
        # but as the default location of the library.
        hardcode_minus_L=yes
      fi
      ;;
    hpux11*)
      if test "$with_gnu_ld" = no; then
        hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
        hardcode_libdir_separator=:
        case $host_cpu in
          hppa*64*|ia64*)
            hardcode_direct=no
            ;;
          *)
            hardcode_direct=yes
            # hardcode_minus_L: Not really in the search PATH,
            # but as the default location of the library.
            hardcode_minus_L=yes
            ;;
        esac
      fi
      ;;
    irix5* | irix6* | nonstopux*)
      hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
      hardcode_libdir_separator=:
      ;;
    netbsd*)
      hardcode_libdir_flag_spec='-R$libdir'
      hardcode_direct=yes
      ;;
    newsos6)
      hardcode_direct=yes
      hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
      hardcode_libdir_separator=:
      ;;
    openbsd*)
      if test -f /usr/libexec/ld.so; then
        hardcode_direct=yes
        if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
          hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
        else
          case "$host_os" in
            openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*)
              hardcode_libdir_flag_spec='-R$libdir'
              ;;
            *)
              hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
              ;;
          esac
        fi
      else
        ld_shlibs=no
      fi
      ;;
    os2*)
      hardcode_libdir_flag_spec='-L$libdir'
      hardcode_minus_L=yes
      ;;
    osf3*)
      hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
      hardcode_libdir_separator=:
      ;;
    osf4* | osf5*)
      if test "$GCC" = yes; then
        hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
      else
        # Both cc and cxx compiler support -rpath directly
        hardcode_libdir_flag_spec='-rpath $libdir'
      fi
      hardcode_libdir_separator=:
      ;;
    solaris*)
      hardcode_libdir_flag_spec='-R$libdir'
      ;;
    sunos4*)
      hardcode_libdir_flag_spec='-L$libdir'
      hardcode_direct=yes
      hardcode_minus_L=yes
      ;;
    sysv4)
      case $host_vendor in
        sni)
          hardcode_direct=yes # is this really true???
          ;;
        siemens)
          hardcode_direct=no
          ;;
        motorola)
          hardcode_direct=no #Motorola manual says yes, but my tests say they lie
          ;;
      esac
      ;;
    sysv4.3*)
      ;;
    sysv4*MP*)
      if test -d /usr/nec; then
        ld_shlibs=yes
      fi
      ;;
    sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*)
      ;;
    sysv5* | sco3.2v5* | sco5v6*)
      hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`'
      hardcode_libdir_separator=':'
      ;;
    uts4*)
      hardcode_libdir_flag_spec='-L$libdir'
      ;;
    *)
      ld_shlibs=no
      ;;
  esac
fi

# Check dynamic linker characteristics
# Code taken from libtool.m4's AC_LIBTOOL_SYS_DYNAMIC_LINKER.
# Unlike libtool.m4, here we don't care about _all_ names of the library, but
# only about the one the linker finds when passed -lNAME. This is the last
# element of library_names_spec in libtool.m4, or possibly two of them if the
# linker has special search rules.
library_names_spec=      # the last element of library_names_spec in libtool.m4
libname_spec='lib$name'
case "$host_os" in
  aix3*)
    library_names_spec='$libname.a'
    ;;
  aix[4-9]*)
    library_names_spec='$libname$shrext'
    ;;
  amigaos*)
    library_names_spec='$libname.a'
    ;;
  beos*)
    library_names_spec='$libname$shrext'
    ;;
  bsdi[45]*)
    library_names_spec='$libname$shrext'
    ;;
  cygwin* | mingw* | pw32*)
    shrext=.dll
    library_names_spec='$libname.dll.a $libname.lib'
    ;;
  darwin* | rhapsody*)
    shrext=.dylib
    library_names_spec='$libname$shrext'
    ;;
  dgux*)
    library_names_spec='$libname$shrext'
    ;;
  freebsd1*)
    ;;
  freebsd* | dragonfly*)
    case "$host_os" in
      freebsd[123]*)
        library_names_spec='$libname$shrext$versuffix' ;;
      *)
        library_names_spec='$libname$shrext' ;;
    esac
    ;;
  gnu*)
    library_names_spec='$libname$shrext'
    ;;
  hpux9* | hpux10* | hpux11*)
    case $host_cpu in
      ia64*)
        shrext=.so
        ;;
      hppa*64*)
        shrext=.sl
        ;;
      *)
        shrext=.sl
        ;;
    esac
    library_names_spec='$libname$shrext'
    ;;
  interix[3-9]*)
    library_names_spec='$libname$shrext'
    ;;
  irix5* | irix6* | nonstopux*)
    library_names_spec='$libname$shrext'
    case "$host_os" in
      irix5* | nonstopux*)
        libsuff= shlibsuff=
        ;;
      *)
        case $LD in
          *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") libsuff= shlibsuff= ;;
          *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") libsuff=32 shlibsuff=N32 ;;
          *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") libsuff=64 shlibsuff=64 ;;
          *) libsuff= shlibsuff= ;;
        esac
        ;;
    esac
    ;;
  linux*oldld* | linux*aout* | linux*coff*)
    ;;
  linux* | k*bsd*-gnu)
    library_names_spec='$libname$shrext'
    ;;
  knetbsd*-gnu)
    library_names_spec='$libname$shrext'
    ;;
  netbsd*)
    library_names_spec='$libname$shrext'
    ;;
  newsos6)
    library_names_spec='$libname$shrext'
    ;;
  nto-qnx*)
    library_names_spec='$libname$shrext'
    ;;
  openbsd*)
    library_names_spec='$libname$shrext$versuffix'
    ;;
  os2*)
    libname_spec='$name'
    shrext=.dll
    library_names_spec='$libname.a'
    ;;
  osf3* | osf4* | osf5*)
    library_names_spec='$libname$shrext'
    ;;
  rdos*)
    ;;
  solaris*)
    library_names_spec='$libname$shrext'
    ;;
  sunos4*)
    library_names_spec='$libname$shrext$versuffix'
    ;;
  sysv4 | sysv4.3*)
    library_names_spec='$libname$shrext'
    ;;
  sysv4*MP*)
    library_names_spec='$libname$shrext'
    ;;
  sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
    library_names_spec='$libname$shrext'
    ;;
  uts4*)
    library_names_spec='$libname$shrext'
    ;;
esac

sed_quote_subst='s/\(["`$\\]\)/\\\1/g'
escaped_wl=`echo "X$wl" | sed -e 's/^X//' -e "$sed_quote_subst"`
shlibext=`echo "$shrext" | sed -e 's,^\.,,'`
escaped_libname_spec=`echo "X$libname_spec" | sed -e 's/^X//' -e "$sed_quote_subst"`
escaped_library_names_spec=`echo "X$library_names_spec" | sed -e 's/^X//' -e "$sed_quote_subst"`
escaped_hardcode_libdir_flag_spec=`echo "X$hardcode_libdir_flag_spec" | sed -e 's/^X//' -e "$sed_quote_subst"`

LC_ALL=C sed -e 's/^\([a-zA-Z0-9_]*\)=/acl_cv_\1=/' <<EOF

# How to pass a linker flag through the compiler.
wl="$escaped_wl"

# Static library suffix (normally "a").
libext="$libext"

# Shared library suffix (normally "so").
shlibext="$shlibext"

# Format of library name prefix.
libname_spec="$escaped_libname_spec"

# Library names that the linker finds when passed -lNAME.
library_names_spec="$escaped_library_names_spec"

# Flag to hardcode \$libdir into a binary during linking.
# This must work even if \$libdir does not exist.
hardcode_libdir_flag_spec="$escaped_hardcode_libdir_flag_spec"

# Whether we need a single -rpath flag with a separated argument.
hardcode_libdir_separator="$hardcode_libdir_separator"

# Set to yes if using DIR/libNAME.so during linking hardcodes DIR into the
# resulting binary.
hardcode_direct="$hardcode_direct"

# Set to yes if using the -LDIR flag during linking hardcodes DIR into the
# resulting binary.
hardcode_minus_L="$hardcode_minus_L"

EOF


code:
#! /bin/sh
# Usage: check-guile [-i GUILE-INTERPRETER] [GUILE-TEST-ARGS]
# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/pre-inst-guile.
# See ${top_srcdir}/test-suite/guile-test for documentation on GUILE-TEST-ARGS.
#
# Example invocations:
# ./check-guile
# ./check-guile numbers.test
# ./check-guile -i /usr/local/bin/guile
# ./check-guile -i /usr/local/bin/guile numbers.test

set -e

top_builddir=@top_builddir_absolute@
top_srcdir=@top_srcdir_absolute@

TEST_SUITE_DIR=${top_srcdir}/test-suite

if [ x"$1" = x-i ] ; then
    guile=$2
    shift
    shift
else
    guile=${top_builddir}/pre-inst-guile
fi

GUILE_LOAD_PATH=$TEST_SUITE_DIR
export GUILE_LOAD_PATH

if [ -f "$guile" -a -x "$guile" ] ; then
    echo Testing $guile ... "$@"
    echo with GUILE_LOAD_PATH=$GUILE_LOAD_PATH
else
    echo ERROR: Cannot execute $guile
    exit 1
fi

# documentation searching ignores GUILE_LOAD_PATH.
if [ ! -f guile-procedures.txt ] ; then
   @LN_S@ libguile/guile-procedures.txt .
fi

exec $guile \
    -l ${top_builddir}/libguile/stack-limit-calibration.scm \
    -e main -s "$TEST_SUITE_DIR/guile-test" \
    --test-suite "$TEST_SUITE_DIR/tests" \
    --log-file check-guile.log "$@"

# check-guile ends here