merge from guile master

Had to fix up .gitignore for some conflicts.

.gitignore

@@ -69,3 +69,5 @@ guile-config/guile-config
 guile-readline/guile-readline-config.h
 guile-readline/guile-readline-config.h.in
 *.go
+TAGS
+guile-1.8.pc

ChangeLog

@@ -1,3 +1,67 @@
+2008-08-25  Ludovic Courtès  <ludo@gnu.org>
+
+	* configure.in (GCC_CFLAGS): New variable.  Store GCC flags like
+	`-Werror' inside it so that they are not used when compiling
+	Gnulib modules.
+
+2008-08-21  Ludovic Courtès  <ludo@gnu.org>
+
+	* autogen.sh: Don't use `gnulib-tool', use the Gnulib files
+	available in the repository.
+
+2008-08-07  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* configure.in (SCM_I_GSC_STACK_GROWS_UP): Remove use of
+	AC_CACHE_CHECK, which was inadvertently causing
+	SCM_I_GSC_STACK_GROWS_UP _always_ to be 0.
+
+2008-07-17  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* configure.in: Update stack direction test to be like that in
+        Autoconf _AC_LIBOBJ_ALLOCA and Gnulib; specifically in involving a
+        function calling itself.
+
+2008-07-16  Ludovic Courtès  <ludo@gnu.org>
+
+	* configure.in: Look for `struct dirent64' and `readdir64_r ()',
+	not available on HP-UX 11.11.
+
+2008-07-06  Ludovic Courtès  <ludo@gnu.org>
+
+	* configure.in: Update to Autoconf 2.61.
+
+2008-06-28  Ludovic Courtès  <ludo@gnu.org>
+
+	* configure.in: Use Automake with `-Wall -Wno-override'.
+
+2008-05-07  Ludovic Courtès  <ludo@gnu.org>
+
+	Guile 1.8.5 released.
+
+	* GUILE-VERSION (LIBGUILE_INTERFACE_CURRENT): Increment due to
+	the addition of an inlined version of `scm getc ()' and friends.
+	(LIBGUILE_INTERFACE_AGE): Increment.
+	(LIBGUILE_INTERFACE_REVISION): Zeroed.
+	(LIBGUILE_SRFI_SRFI_1_INTERFACE_REVISION): Increment.
+
+2008-05-04  Ludovic Courtès  <ludo@gnu.org>
+
+	Add `pkg-config' support.  Suggested by Aaron VanDevender, Greg
+	Troxel, and others.
+
+	* configure.in: Substitute `sitedir', produce `guile-1.8.pc'.
+	* Makefile.am (EXTRA_DIST): Add `guile-1.8.pc.in'.
+	(pkgconfigdir, pkgconfig_DATA): New.
+
+2008-04-26  Ludovic Courtès  <ludo@gnu.org>
+
+	* configure.in (BUILD_PTHREAD_SUPPORT): New Automake
+	conditional.
+
+2008-04-26  Ludovic Courtès  <ludo@gnu.org>
+
+	* Makefile.am (EXTRA_DIST): Remove `ANON-CVS' and `SNAPSHOTS'.
+
 2008-02-23  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* FAQ: New file.

Makefile.am

@@ -1,6 +1,6 @@
 ## Process this file with automake to produce Makefile.in.
 ##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007, 2008 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -32,10 +32,8 @@ bin_SCRIPTS = guile-tools
 
 include_HEADERS = libguile.h
 
-# automake sometimes forgets to distribute acconfig.h,
+EXTRA_DIST = LICENSE HACKING GUILE-VERSION \
-# apparently depending on the phase of the moon.
+	     m4/ChangeLog FAQ guile-1.8.pc.in
-EXTRA_DIST = LICENSE HACKING GUILE-VERSION ANON-CVS SNAPSHOTS	\
-	     m4/ChangeLog FAQ
 
 TESTS = check-guile
 
@@ -43,4 +41,7 @@ ACLOCAL_AMFLAGS = -I guile-config -I m4
 
 DISTCLEANFILES = check-guile.log
 
+pkgconfigdir = $(libdir)/pkgconfig
+pkgconfig_DATA = guile-1.8.pc
+
 # Makefile.am ends here

NEWS

@@ -11,6 +11,7 @@ Changes in 1.9.0:
 
 * New modules (see the manual for details)
 
+** `(srfi srfi-18)', multithreading support
 ** The `(ice-9 i18n)' module provides internationalization support
 
 * Changes to the distribution
@@ -35,6 +36,34 @@ See `cancel-thread', `set-thread-cleanup!', and `thread-cleanup'.
 indicating length of the `scm_t_option' array.
 
 
+
+Changes in 1.8.6 (since 1.8.5)
+
+* New features (see the manual for details)
+
+** New convenience function `scm_c_symbol_length ()'
+
+** Single stepping through code from Emacs
+
+When you use GDS to evaluate Scheme code from Emacs, you can now use
+`C-u' to indicate that you want to single step through that code. See
+`Evaluating Scheme Code' in the manual for more details.
+
+* Bugs fixed
+
+** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF
+
+This makes these internal functions technically not callable from
+application code.
+
+** `guile-config link' now prints `-L$libdir' before `-lguile'
+** Fix memory corruption involving GOOPS' `class-redefinition'
+** Fix build issue on Tru64 and ia64-hp-hpux11.23 (`SCM_UNPACK' macro)
+** Fix build issue on mips, mipsel, powerpc and ia64 (stack direction)
+** Fix build issue on hppa2.0w-hp-hpux11.11 (`dirent64' and `readdir64_r')
+** Fix misleading output from `(help rationalize)'
+** Fix build failure on Debian hppa architecture (bad stack growth detection)
+
 
 Changes in 1.8.5 (since 1.8.4)
 
@@ -46,6 +75,31 @@ The new repository can be accessed using
 "git-clone git://git.sv.gnu.org/guile.git", or can be browsed on-line at
 http://git.sv.gnu.org/gitweb/?p=guile.git .  See `README' for details.
 
+** Add support for `pkg-config'
+
+See "Autoconf Support" in the manual for details.
+
+* New modules (see the manual for details)
+
+** `(srfi srfi-88)'
+
+* New features (see the manual for details)
+
+** New `postfix' read option, for SRFI-88 keyword syntax
+** Some I/O primitives have been inlined, which improves I/O performance
+** New object-based traps infrastructure
+
+This is a GOOPS-based infrastructure that builds on Guile's low-level
+evaluator trap calls and facilitates the development of debugging
+features like single-stepping, breakpoints, tracing and profiling.
+See the `Traps' node of the manual for details.
+
+** New support for working on Guile code from within Emacs
+
+Guile now incorporates the `GDS' library (previously distributed
+separately) for working on Guile code from within Emacs.  See the
+`Using Guile In Emacs' node of the manual for details.
+ 
 * Bugs fixed
 
 ** `scm_add_slot ()' no longer segfaults (fixes bug #22369)
@@ -60,9 +114,12 @@ would trigger an unbound variable error for `match:andmap'.
 Previously, parsing short option names of argument-less options would
 lead to a stack overflow.
 
+** `(srfi srfi-35)' is now visible through `cond-expand'
 ** Fixed type-checking for the second argument of `eval'
+** Fixed type-checking for SRFI-1 `partition'
 ** Fixed `struct-ref' and `struct-set!' on "light structs"
 ** Honor struct field access rights in GOOPS
+** Changed the storage strategy of source properties, which fixes a deadlock
 ** Allow compilation of Guile-using programs in C99 mode with GCC 4.3 and later
 ** Fixed build issue for GNU/Linux on IA64
 ** Fixed build issues on NetBSD 1.6
@@ -70,6 +127,8 @@ lead to a stack overflow.
 ** Fixed build issue with DEC/Compaq/HP's compiler
 ** Fixed `scm_from_complex_double' build issue on FreeBSD
 ** Fixed `alloca' build issue on FreeBSD 6
+** Removed use of non-portable makefile constructs
+** Fixed shadowing of libc's <random.h> on Tru64, which broke compilation
 ** Make sure all tests honor `$TMPDIR'
 
 * Changes to the distribution

THANKS

@@ -37,12 +37,14 @@ For fixes or providing information which led to a fix:
         Charles Gagnon
           Peter Gavin
            Eric Gillespie, Jr
+         Didier Godefroy
            John Goerzen
            Mike Gran
          Szavai Gyula
 	   Sven Hartrumpf
 	   Eric Hanchrow
             Sam Hocevar
+	Patrick Horgan
            Ales Hvezda
           Peter Ivanyi
        Wolfgang Jaehrling
@@ -67,6 +69,7 @@ For fixes or providing information which led to a fix:
          Hrvoje Nikšić
          Stefan Nordhausen
          Roland Orre
+	  Peter O'Gorman
          Pieter Pareit
            Jack Pavlovsky
            Arno Peters
@@ -79,6 +82,7 @@ For fixes or providing information which led to a fix:
          Werner Scheinast
 	   Bill Schottstaedt
 	  Frank Schwidom
+         Thiemo Seufer
           Scott Shedden
            Alex Shinn
          Daniel Skarda

autogen.sh

@@ -19,13 +19,10 @@ libtool --version
 echo ""
 ${M4:-/usr/bin/m4} --version
 echo ""
-gnulib-tool --version
-echo ""
 
 ######################################################################
 ### update infrastructure
 
-gnulib-tool --update &&				\
 autoreconf -i --force --verbose
 
 echo "guile-readline..."

benchmark-suite/ChangeLog

@@ -1,3 +1,8 @@
+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.

benchmark-suite/Makefile.am

@@ -1,6 +1,7 @@
-SCM_BENCHMARKS = benchmarks/0-reference.bm			\
+SCM_BENCHMARKS = benchmarks/0-reference.bm	\
-	         benchmarks/continuations.bm                    \
+	         benchmarks/continuations.bm	\
-                 benchmarks/if.bm                               \
+                 benchmarks/if.bm		\
-                 benchmarks/logand.bm
+                 benchmarks/logand.bm		\
+		 benchmarks/read.bm
 
 EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS)

benchmark-suite/benchmarks/read.bm

@@ -0,0 +1,62 @@
+;;; 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))))

build-aux/link-warning.h

@@ -0,0 +1,28 @@
+/* GL_LINK_WARNING("literal string") arranges to emit the literal string as
+   a linker warning on most glibc systems.
+   We use a linker warning rather than a preprocessor warning, because
+   #warning cannot be used inside macros.  */
+#ifndef GL_LINK_WARNING
+  /* This works on platforms with GNU ld and ELF object format.
+     Testing __GLIBC__ is sufficient for asserting that GNU ld is in use.
+     Testing __ELF__ guarantees the ELF object format.
+     Testing __GNUC__ is necessary for the compound expression syntax.  */
+# if defined __GLIBC__ && defined __ELF__ && defined __GNUC__
+#  define GL_LINK_WARNING(message) \
+     GL_LINK_WARNING1 (__FILE__, __LINE__, message)
+#  define GL_LINK_WARNING1(file, line, message) \
+     GL_LINK_WARNING2 (file, line, message)  /* macroexpand file and line */
+#  define GL_LINK_WARNING2(file, line, message) \
+     GL_LINK_WARNING3 (file ":" #line ": warning: " message)
+#  define GL_LINK_WARNING3(message) \
+     ({ static const char warning[sizeof (message)]		\
+          __attribute__ ((__unused__,				\
+                          __section__ (".gnu.warning"),		\
+                          __aligned__ (1)))			\
+          = message "\n";					\
+        (void)0;						\
+     })
+# else
+#  define GL_LINK_WARNING(message) ((void) 0)
+# endif
+#endif

configure.in

@@ -25,7 +25,7 @@ Boston, MA 02110-1301, USA.
 
 ]])
 
-AC_PREREQ(2.59)
+AC_PREREQ(2.61)
 
 dnl  `patsubst' here deletes the newline which "echo" prints.  We can't use
 dnl  "echo -n" since -n is not portable (see autoconf manual "Limitations of
@@ -41,7 +41,7 @@ AC_CONFIG_AUX_DIR([build-aux])
 AC_CONFIG_MACRO_DIR([m4])
 AC_CONFIG_SRCDIR(GUILE-VERSION)
 
-AM_INIT_AUTOMAKE([gnu no-define check-news])
+AM_INIT_AUTOMAKE([gnu no-define check-news -Wall -Wno-override])
 
 AC_COPYRIGHT(GUILE_CONFIGURE_COPYRIGHT)
 AC_CONFIG_SRCDIR([GUILE-VERSION])
@@ -49,7 +49,7 @@ AC_CONFIG_SRCDIR([GUILE-VERSION])
 . $srcdir/GUILE-VERSION
 
 AM_MAINTAINER_MODE
-AM_CONFIG_HEADER([config.h])
+AC_CONFIG_HEADERS([config.h])
 AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/)
 
 #--------------------------------------------------------------------
@@ -62,8 +62,11 @@ AC_CONFIG_SUBDIRS(guile-readline)
 
 #--------------------------------------------------------------------
 
+AC_LANG([C])
+
 dnl Some more checks for Win32
-AC_CYGWIN
+AC_CANONICAL_HOST
+
 AC_LIBTOOL_WIN32_DLL
 
 AC_PROG_INSTALL
@@ -75,7 +78,8 @@ AC_PROG_AWK
 dnl Gnulib.
 gl_INIT
 
-AM_PROG_CC_STDC
+AC_PROG_CC_C89
+
 # for per-target cflags in the libguile subdir
 AM_PROG_CC_C_O
 
@@ -124,7 +128,7 @@ AC_ARG_ENABLE(debug-malloc,
 
 SCM_I_GSC_GUILE_DEBUG=0
 AC_ARG_ENABLE(guile-debug,
-  [AC_HELP_STRING([--enable-guile-debug],
+  [AS_HELP_STRING([--enable-guile-debug],
                   [include internal debugging functions])],
   if test "$enable_guile_debug" = y || test "$enable_guile_debug" = yes; then
     SCM_I_GSC_GUILE_DEBUG=1
@@ -143,7 +147,7 @@ AC_ARG_ENABLE(regex,
   enable_regex=yes)
 
 AC_ARG_ENABLE([discouraged],
-  AC_HELP_STRING([--disable-discouraged],[omit discouraged features]))
+  AS_HELP_STRING([--disable-discouraged],[omit discouraged features]))
 
 if test "$enable_discouraged" = no; then
   SCM_I_GSC_ENABLE_DISCOURAGED=0
@@ -152,7 +156,7 @@ else
 fi
 
 AC_ARG_ENABLE([deprecated],
-  AC_HELP_STRING([--disable-deprecated],[omit deprecated features]))
+  AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))
 
 if test "$enable_deprecated" = no; then
   SCM_I_GSC_ENABLE_DEPRECATED=0
@@ -198,7 +202,7 @@ dnl  For now, --without-64-calls allows Guile to build on OSs where it
 dnl  wasn't building before.
 AC_MSG_CHECKING([whether to use system and library "64" calls])
 AC_ARG_WITH([64-calls],
-  AC_HELP_STRING([--without-64-calls],
+  AS_HELP_STRING([--without-64-calls],
                  [don't attempt to use system and library calls with "64" in their names]),
   [use_64_calls=$withval],
   [use_64_calls=yes
@@ -581,9 +585,38 @@ AC_SUBST([SCM_I_GSC_NEEDS_STDINT_H])
 AC_SUBST([SCM_I_GSC_NEEDS_INTTYPES_H])
 
 AC_HEADER_STDC
-AC_HEADER_DIRENT
 AC_HEADER_TIME
 AC_HEADER_SYS_WAIT
+AC_HEADER_DIRENT
+
+# Reason for checking:
+#
+#   HP-UX 11.11 (at least) doesn't provide `struct dirent64', even
+#   with `_LARGEFILE64_SOURCE', so check whether it's available.
+#
+AC_CHECK_MEMBER([struct dirent64.d_name],
+  [SCM_I_GSC_HAVE_STRUCT_DIRENT64=1], [SCM_I_GSC_HAVE_STRUCT_DIRENT64=0],
+  [ #ifndef _LARGEFILE64_SOURCE
+    # define _LARGEFILE64_SOURCE
+    #endif
+
+    /* Per Autoconf manual.  */
+    #include <sys/types.h>
+    #ifdef HAVE_DIRENT_H
+    # include <dirent.h>
+    #else
+    # define dirent direct
+    # ifdef HAVE_SYS_NDIR_H
+    #  include <sys/ndir.h>
+    # endif
+    # ifdef HAVE_SYS_DIR_H
+    #  include <sys/dir.h>
+    # endif
+    # ifdef HAVE_NDIR_H
+    #  include <ndir.h>
+    # endif
+    #endif ])
+AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64])
 
 # Reasons for testing:
 #   complex.h - new in C99
@@ -682,6 +715,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   pipe - not in mingw
 #   _pipe - specific to mingw, taking 3 args
 #   readdir_r - recent posix, not on old systems
+#   readdir64_r - not available on HP-UX 11.11
 #   stat64 - SuS largefile stuff, not on old systems
 #   sysconf - not on old systems
 #   truncate - not in mingw
@@ -690,7 +724,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
 #   nl_langinfo - X/Open, not available on Windows.
 #
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo])
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo])
 
 # Reasons for testing:
 #   netdb.h - not in mingw
@@ -729,24 +763,28 @@ AC_SEARCH_LIBS(crypt, crypt,
 # is a workaround for the failure of some systems to conform to C99.
 if test "$ac_cv_type_complex_double" = yes; then
   AC_MSG_CHECKING([for i])
-  AC_TRY_COMPILE([
+  AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
 #if HAVE_COMPLEX_H
 #include <complex.h>
 #endif
 complex double z;
-],[
+]], [[
 z = _Complex_I;
-],[AC_DEFINE(GUILE_I,_Complex_I,[The imaginary unit (positive square root of -1).])
+]])],
-   AC_MSG_RESULT([_Complex_I])],[AC_TRY_COMPILE([
+    [AC_DEFINE(GUILE_I,_Complex_I,[The imaginary unit (positive square root of -1).])
+     AC_MSG_RESULT([_Complex_I])],
+    [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
 #if HAVE_COMPLEX_H
 #include <complex.h>
 #endif
 complex double z;
-],[
+]],[[
 z = 1.0fi;
-],[AC_DEFINE(GUILE_I,1.0fi)
+]])],
-   AC_MSG_RESULT([1.0fi])],[ac_cv_type_complex_double=no
+  [AC_DEFINE(GUILE_I,1.0fi)
-                            AC_MSG_RESULT([not available])])])
+   AC_MSG_RESULT([1.0fi])],
+  [ac_cv_type_complex_double=no
+   AC_MSG_RESULT([not available])])])
 fi
 
 # glibc 2.3.6 (circa 2006) and various prior versions had a bug where
@@ -757,7 +795,7 @@ if test "$ac_cv_type_complex_double" = yes; then
 
   AC_CACHE_CHECK([whether csqrt is usable],
     guile_cv_use_csqrt,
-    [AC_TRY_RUN([
+    [AC_RUN_IFELSE([AC_LANG_SOURCE([[
 #include <complex.h>
 /* "volatile" is meant to prevent gcc from calculating the sqrt as a
    constant, we want to test libc. */
@@ -770,7 +808,7 @@ main (void)
     return 0;  /* good */
   else
     return 1;  /* bad */
-}],
+}]])],
     [guile_cv_use_csqrt=yes],
     [guile_cv_use_csqrt="no, glibc 2.3 bug"],
     [guile_cv_use_csqrt="yes, hopefully (cross-compiling)"])])
@@ -787,8 +825,9 @@ AC_CHECK_LIB([gmp], [__gmpz_init], ,
   [AC_MSG_ERROR([GNU MP not found, see README])])
 
 # mpz_import is a macro so we need to include <gmp.h>
-AC_TRY_LINK([#include <gmp.h>],
+AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <gmp.h>]],
-            [mpz_import (0, 0, 0, 0, 0, 0, 0);] , ,
+ 			        [[mpz_import (0, 0, 0, 0, 0, 0, 0); ]])],
+  [],
   [AC_MSG_ERROR([At least GNU MP 4.1 is required, see README])])
 
 dnl i18n tests
@@ -866,11 +905,11 @@ AC_CHECK_MEMBERS([struct sockaddr.sin_len],,,
 
 AC_MSG_CHECKING(for __libc_stack_end)
 AC_CACHE_VAL(guile_cv_have_libc_stack_end,
-[AC_TRY_LINK([#include <stdio.h>
+[AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <stdio.h>
-extern char *__libc_stack_end;],
+extern char *__libc_stack_end;]],
-             [printf("%p", (char*) __libc_stack_end);],
+   [[printf("%p", (char*) __libc_stack_end);]])],
-             guile_cv_have_libc_stack_end=yes,
+   [guile_cv_have_libc_stack_end=yes],
-             guile_cv_have_libc_stack_end=no)])
+   [guile_cv_have_libc_stack_end=no])])
 AC_MSG_RESULT($guile_cv_have_libc_stack_end)
 
 if test $guile_cv_have_libc_stack_end = yes; then
@@ -883,9 +922,10 @@ dnl macro.  With cygwin it may be in a DLL.
 
 AC_MSG_CHECKING(whether netdb.h declares h_errno)
 AC_CACHE_VAL(guile_cv_have_h_errno,
-[AC_TRY_COMPILE([#include <netdb.h>],
+  [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <netdb.h>]],
-[int a = h_errno;],
+                                      [[int a = h_errno;]])],
-guile_cv_have_h_errno=yes, guile_cv_have_h_errno=no)])
+  [guile_cv_have_h_errno=yes],
+  [guile_cv_have_h_errno=no])])
 AC_MSG_RESULT($guile_cv_have_h_errno)
 if test $guile_cv_have_h_errno = yes; then
   AC_DEFINE(HAVE_H_ERRNO, 1, [Define if h_errno is declared in netdb.h.])
@@ -893,15 +933,16 @@ fi
 
 AC_MSG_CHECKING(whether uint32_t is defined)
 AC_CACHE_VAL(guile_cv_have_uint32_t,
-  [AC_TRY_COMPILE([#include <sys/types.h>
+  [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
 		   #if HAVE_STDINT_H
 		   #include <stdint.h>
                    #endif
 		   #ifndef HAVE_NETDB_H
 	           #include <netdb.h>
-		   #endif],
+		   #endif]],
-		  [uint32_t a;],
+		   [[uint32_t a;]])],
-		  guile_cv_have_uint32_t=yes, guile_cv_have_uint32_t=no)])
+		   [guile_cv_have_uint32_t=yes],
+		   [guile_cv_have_uint32_t=no])])
 AC_MSG_RESULT($guile_cv_have_uint32_t)
 if test $guile_cv_have_uint32_t = yes; then
   AC_DEFINE(HAVE_UINT32_T, 1,
@@ -910,14 +951,15 @@ fi
 
 AC_MSG_CHECKING(for working IPv6 support)
 AC_CACHE_VAL(guile_cv_have_ipv6,
-[AC_TRY_COMPILE([
+[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 #endif
 #include <netinet/in.h>
-#include <sys/socket.h>],
+#include <sys/socket.h>]],
-[struct sockaddr_in6 a;  a.sin6_family = AF_INET6;],
+[[struct sockaddr_in6 a;  a.sin6_family = AF_INET6;]])],
-guile_cv_have_ipv6=yes, guile_cv_have_ipv6=no)])
+[guile_cv_have_ipv6=yes],
+[guile_cv_have_ipv6=no])])
 AC_MSG_RESULT($guile_cv_have_ipv6)
 if test $guile_cv_have_ipv6 = yes; then
   AC_DEFINE(HAVE_IPV6, 1, [Define if you want support for IPv6.])
@@ -926,13 +968,14 @@ fi
 # included in rfc2553 but not in older implementations, e.g., glibc 2.1.3.
 AC_MSG_CHECKING(whether sockaddr_in6 has sin6_scope_id)
 AC_CACHE_VAL(guile_cv_have_sin6_scope_id,
-[AC_TRY_COMPILE([
+[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 #endif
-#include <netinet/in.h>],
+#include <netinet/in.h>]],
-[struct sockaddr_in6 sok;  sok.sin6_scope_id = 0;],
+[[struct sockaddr_in6 sok;  sok.sin6_scope_id = 0;]])],
-guile_cv_have_sin6_scope_id=yes, guile_cv_have_sin6_scope_id=no)])
+[guile_cv_have_sin6_scope_id=yes],
+[guile_cv_have_sin6_scope_id=no])])
 AC_MSG_RESULT($guile_cv_have_sin6_scope_id)
 if test $guile_cv_have_sin6_scope_id = yes; then
   AC_DEFINE(HAVE_SIN6_SCOPE_ID, 1,
@@ -949,7 +992,7 @@ AC_CHECK_MEMBERS([struct sockaddr_in6.sin6_len],,,
 AC_MSG_CHECKING(whether localtime caches TZ)
 AC_CACHE_VAL(guile_cv_localtime_cache,
 [if test x$ac_cv_func_tzset = xyes; then
-AC_TRY_RUN([#include <time.h>
+AC_RUN_IFELSE([AC_LANG_SOURCE([[#include <time.h>
 #if STDC_HEADERS
 # include <stdlib.h>
 #endif
@@ -980,7 +1023,9 @@ main()
   if (localtime (&now)->tm_hour != hour_unset)
     exit (1);
   exit (0);
-}], guile_cv_localtime_cache=no, guile_cv_localtime_cache=yes,
+}]])],
+[guile_cv_localtime_cache=no],
+[guile_cv_localtime_cache=yes],
 [# If we have tzset, assume the worst when cross-compiling.
 guile_cv_localtime_cache=yes])
 else
@@ -1098,15 +1143,42 @@ GUILE_STRUCT_UTIMBUF
 #
 # Which way does the stack grow?
 #
+# Following code comes from Autoconf 2.61's internal _AC_LIBOBJ_ALLOCA
+# macro (/usr/share/autoconf/autoconf/functions.m4).  Gnulib has
+# very similar code, so in future we could look at using that.
+#
+# An important detail is that the code involves find_stack_direction
+# calling _itself_ - which means that find_stack_direction (or at
+# least the second find_stack_direction() call) cannot be inlined.
+# If the code could be inlined, that might cause the test to give
+# an incorrect answer.
 #--------------------------------------------------------------------
 
 SCM_I_GSC_STACK_GROWS_UP=0
-AC_TRY_RUN(aux (l) unsigned long l;
+AC_RUN_IFELSE([AC_LANG_SOURCE(
-	     { int x; exit (l >= ((unsigned long)&x)); }
+[AC_INCLUDES_DEFAULT
-	   main () { int q; aux((unsigned long)&q); },
+int
-           [SCM_I_GSC_STACK_GROWS_UP=1],
+find_stack_direction ()
-	   [],
+{
-           [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)])
+  static char *addr = 0;
+  auto char dummy;
+  if (addr == 0)
+    {
+      addr = &dummy;
+      return find_stack_direction ();
+    }
+  else
+    return (&dummy > addr) ? 1 : -1;
+}
+
+int
+main ()
+{
+  return find_stack_direction () < 0;
+}])],
+	       [SCM_I_GSC_STACK_GROWS_UP=1],
+	       [],
+	       [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)])
 
 AC_CHECK_SIZEOF(float)
 if test "$ac_cv_sizeof_float" -le "$ac_cv_sizeof_long"; then
@@ -1116,12 +1188,12 @@ fi
 
 AC_MSG_CHECKING(for struct linger)
 AC_CACHE_VAL(scm_cv_struct_linger,
-	AC_TRY_COMPILE([
+	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
 #include <sys/types.h>
-#include <sys/socket.h>],
+#include <sys/socket.h>]],
-			[struct linger lgr;  lgr.l_linger = 100],
+	                  [[struct linger lgr;  lgr.l_linger = 100]])],
-			scm_cv_struct_linger="yes",
+			  [scm_cv_struct_linger="yes"],
-			scm_cv_struct_linger="no"))
+			  [scm_cv_struct_linger="no"]))
 AC_MSG_RESULT($scm_cv_struct_linger)
 if test $scm_cv_struct_linger = yes; then
 	AC_DEFINE(HAVE_STRUCT_LINGER, 1,
@@ -1134,14 +1206,13 @@ fi
 #
 AC_MSG_CHECKING(for struct timespec)
 AC_CACHE_VAL(scm_cv_struct_timespec,
-	AC_TRY_COMPILE([
+	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
 #include <time.h>
 #if HAVE_PTHREAD_H
 #include <pthread.h>
-#endif],
+#endif]], [[struct timespec t;  t.tv_nsec = 100]])],
-			[struct timespec t;  t.tv_nsec = 100],
+          [scm_cv_struct_timespec="yes"],
-			scm_cv_struct_timespec="yes",
+          [scm_cv_struct_timespec="no"]))
-			scm_cv_struct_timespec="no"))
 AC_MSG_RESULT($scm_cv_struct_timespec)
 if test $scm_cv_struct_timespec = yes; then
   AC_DEFINE(HAVE_STRUCT_TIMESPEC, 1,
@@ -1168,6 +1239,9 @@ AC_SUBST(SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER, 0)
 
 case "$with_threads" in
   "yes" | "pthread" | "pthreads" | "pthread-threads" | "")
+
+    build_pthread_support="yes"
+
     ACX_PTHREAD(CC="$PTHREAD_CC"
       LIBS="$PTHREAD_LIBS $LIBS"
       SCM_I_GSC_USE_PTHREAD_THREADS=1
@@ -1247,6 +1321,10 @@ esac
 AC_MSG_CHECKING(what kind of threads to support)
 AC_MSG_RESULT($with_threads)
 
+AM_CONDITIONAL([BUILD_PTHREAD_SUPPORT],
+  [test "x$build_pthread_support" = "xyes"])
+
+
 ## Check whether pthread_attr_getstack works for the main thread
 
 if test "$with_threads" = pthreads; then
@@ -1254,8 +1332,7 @@ if test "$with_threads" = pthreads; then
 AC_MSG_CHECKING(whether pthread_attr_getstack works for the main thread)
 old_CFLAGS="$CFLAGS"
 CFLAGS="$PTHREAD_CFLAGS $CFLAGS"
-AC_TRY_RUN(
+AC_RUN_IFELSE([AC_LANG_SOURCE([[
-[
 #if HAVE_PTHREAD_ATTR_GETSTACK
 #include <pthread.h>
 
@@ -1280,10 +1357,11 @@ int main ()
   return 1;
 }
 #endif
-],
+]])],
 [works=yes
 AC_DEFINE(PTHREAD_ATTR_GETSTACK_WORKS, [1], [Define when pthread_att_get_stack works for the main thread])],
-[works=no])
+[works=no],
+[])
 CFLAGS="$old_CFLAGS"
 AC_MSG_RESULT($works)
 
@@ -1341,17 +1419,19 @@ case "$GCC" in
     ## less than exasperating.
     ## -Wpointer-arith was here too, but something changed in gcc/glibc
     ## and it became equally exasperating (gcc 2.95 and/or glibc 2.1.2).
-    CFLAGS="$CFLAGS -Wall -Wmissing-prototypes"
+    GCC_CFLAGS="-Wall -Wmissing-prototypes"
     # Do this here so we don't screw up any of the tests above that might
     # not be "warning free"
     if test "${GUILE_ERROR_ON_WARNING}" = yes
     then
-	CFLAGS="${CFLAGS} -Werror"
+	GCC_CFLAGS="${GCC_CFLAGS} -Werror"
 	enable_compile_warnings=no
     fi
     ;;
 esac
 
+AC_SUBST(GCC_CFLAGS)
+
 ## If we're creating a shared library (using libtool!), then we'll
 ## need to generate a list of .lo files corresponding to the .o files
 ## given in LIBOBJS.  We'll call it LIBLOBJS.
@@ -1425,6 +1505,12 @@ AC_SUBST(top_builddir_absolute)
 top_srcdir_absolute=`(cd $srcdir && pwd)`
 AC_SUBST(top_srcdir_absolute)
 
+dnl We need `sitedir' in `guile-1.8.pc'.
+dnl Note: `sitedir' must be kept in sync with `GUILE_SITE_DIR' in `guile.m4'.
+pkgdatadir="$datadir/guile"
+sitedir="$pkgdatadir/site"
+AC_SUBST([sitedir])
+
 # Additional SCM_I_GSC definitions are above.
 AC_SUBST([SCM_I_GSC_GUILE_DEBUG])
 AC_SUBST([SCM_I_GSC_GUILE_DEBUG_FREELIST])
@@ -1481,6 +1567,7 @@ AC_CONFIG_FILES([
   testsuite/Makefile
 ])
 
+AC_CONFIG_FILES([guile-1.8.pc])
 AC_CONFIG_FILES([check-guile], [chmod +x check-guile])
 AC_CONFIG_FILES([benchmark-guile], [chmod +x benchmark-guile])
 AC_CONFIG_FILES([guile-tools], [chmod +x guile-tools])

doc/ChangeLog

@@ -1,3 +1,7 @@
+2008-04-26  Ludovic Courtès  <ludo@gnu.org>
+
+	* Makefile.am (EXAMPLE_SMOB_FILES): Remove `COPYING'.
+
 2008-01-22  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* COPYING: Removed.

doc/Makefile.am

@@ -1,6 +1,6 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##  	Copyright (C) 1998, 2002, 2006 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 2002, 2006, 2008 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -27,7 +27,7 @@ SUBDIRS = ref tutorial goops r5rs
 # man_MANS = guile.1
 
 EXAMPLE_SMOB_FILES = \
-    ChangeLog Makefile README COPYING image-type.c image-type.h myguile.c
+    ChangeLog Makefile README image-type.c image-type.h myguile.c
 
 OLDFMT = oldfmt.c
 

doc/ref/ChangeLog

@@ -1,3 +1,71 @@
+2008-07-17  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* scheme-using.texi (Evaluating Scheme Code): Document use of
+        `C-u' prefix with evaluation commands.
+
+2008-07-05  Ludovic Courtès  <ludo@gnu.org>
+
+	* api-data.texi (Symbol Primitives): Add `scm_c_symbol_length ()'.
+
+2008-06-30  Julian Graham  <joolean@gmail.com>
+
+	* srfi-modules.texi (SRFI-18): New section.
+	(SRFI-19 Time): Mention SRFI-18's `current-time'.
+
+2008-06-28  Ludovic Courtès  <ludo@gnu.org>
+
+	* api-modules.texi (Using Guile Modules): Substitute "syntax
+	transformer" to "system transformer".  Reported by Sebastian
+	Tennant <sebyte@smolny.plus.com>.
+
+2008-06-01  Ludovic Courtès  <ludo@gnu.org>
+
+	* srfi-modules.texi (SRFI-88): Fix URL.
+
+2008-05-14  Julian Graham  <joolean@gmail.com>
+
+	* api-scheduling.texi (Mutexes and Condition Variables): Add
+	documentation for new functions "scm_mutex_owner",
+	"scm_mutex_level", and "scm_mutex_locked_p".  Update
+	documentation for function "scm_lock_mutex_timed" to reflect
+	addition of optional ownership argument.
+
+2008-05-07  Ludovic Courtès  <ludo@gnu.org>
+
+	* Makefile.am (autoconf-macros.texi): Avoid use of GNU Make
+	specific `$<' variable.  This broke with BSD Make as found on
+	FreeBSD 6.2.
+
+2008-05-05  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* scheme-using.texi (Using Guile in Emacs): Add concept index
+	entries `GDS' and `Emacs'.
+
+	* api-debug.texi (Debugging): Add concept index entry `Debugging'.
+
+2008-05-04  Ludovic Courtès  <ludo@gnu.org>
+
+	* guile.texi (Guile Modules): Include `autoconf.texi'.
+	* autoconf.texi (Autoconf Support): Mention `pkg-config'.
+	(Autoconf Macros): Document `pkg-config' support.
+
+2008-04-26  Ludovic Courtès  <ludo@gnu.org>
+
+	* srfi-modules.texi (SRFI-88): New section.
+	* api-data.texi (Keyword Read Syntax): Add reference to
+	`SRFI-88'.
+
+2008-04-17  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* posix.texi (File System): New doc for file-exists?.
+
+2008-04-15  Ludovic Courtès  <ludo@gnu.org>
+
+	* api-data.texi (Keywords): Mention postfix syntax.
+	(Keyword Read Syntax): Document `postfix' read option.
+	* api-options.texi (Reader options): Update examples.
+	(Examples of option use): Likewise.
+
 2008-03-28  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* libguile-concepts.texi (Multi-Threading): Fix typo.
@@ -6,7 +74,7 @@
 
 	Applying patch from Julian Graham, containing minor fixes to his
 	thread enhancements:
-	
+
 	* api-scheduling.texi (Mutexes and Condition Variables): Change
 	`flag' to `flags' in docstring.
 
@@ -42,14 +110,14 @@
 	(Examples): Moved to api-debug.texi.
 	(Tracing, Old Tracing): Promoted one level.
 	(New Tracing, Tracing Compared): Removed.
-	
+
 2008-03-08  Julian Graham  <joolean@gmail.com>
 
-	* api-scheduling.texi (Threads): Add documentation for new 
+	* api-scheduling.texi (Threads): Add documentation for new
 	functions "scm_thread_p" and new "scm_join_thread_timed".
-	(Mutexes and Condition Variables): Add documentation for new 
+	(Mutexes and Condition Variables): Add documentation for new
-	functions "scm_make_mutex_with_flags", "scm_mutex_p", 
+	functions "scm_make_mutex_with_flags", "scm_mutex_p",
-	"scm_lock_mutex_timed", "scm_unlock_mutex_timed", and 
+	"scm_lock_mutex_timed", "scm_unlock_mutex_timed", and
 	"scm_condition_variable_p".
 
 2008-02-11  Neil Jerram  <neil@ossau.uklinux.net>
@@ -211,7 +279,7 @@
 	(lib-version.texi): New target.
 
 	* guile.texi: Include `lib-version.texi'.
-	
+
 	* api-data.texi (Conversion): Link to `The ice-9 i18n Module' when
 	describing `string->number'.
 	(String Comparison): Likewise.
@@ -399,7 +467,7 @@
 
 	* api-debug.texi (Debug on Error): Note need to handling of errors
 	in C.
-	
+
 	* api-debug.texi (Debugging): New intro text.  New subsection
 	"Evaluation Model".  Moved existing subsections "Capturing the
 	Stack or Innermost Stack Frame", "Examining the Stack", "Examining
@@ -435,7 +503,7 @@
 	* api-evaluation.texi (Fly Evaluation): Add scm_c_eval_string.
 	(Loading): Add scm_c_primitive_load.
 	Reported by Jon Wilson.
-	
+
 2006-06-25  Kevin Ryde  <user42@zip.com.au>
 
 	* posix.texi (Time): In tm:gmtoff, give example values, note not the
@@ -569,7 +637,7 @@
 
         * api-data.texi (Operations Related to Symbols):
         Documented `scm_take_locale_symbol ()'.
-	
+
 2005-12-15  Kevin Ryde  <user42@zip.com.au>
 
 	* api-evaluation.texi (Fly Evaluation): Add scm_call_4, suggested by
@@ -660,7 +728,7 @@
 
 	* misc-modules.texi (Formatted Output): Show modifiers like ~:d
 	instead of in words.
-	
+
 2005-08-06  Kevin Ryde  <user42@zip.com.au>
 
 	* api-compound.texi (List Modification): In filter, return may share a
@@ -1007,7 +1075,7 @@
 	* api-i18n.texi: New file.
 	* Makefile.am (guile_TEXINFOS): Added it.
 	* guile.texi: Include it.
-	
+
 2004-09-16  Kevin Ryde  <user42@zip.com.au>
 
 	* api-utility.texi (Equality): Revise for clarity.
@@ -1062,16 +1130,16 @@
 
 	Ran a (docstring-process-module "(guile)") and moved entries from
 	new-docstrings.texi to their appropriate place.
-	
+
 	* api-undocumented.texi: New file.
 
 2004-08-21  Marius Vollmer  <mvo@zagadka.de>
 
         From Richard Todd, Thanks!
-	
+
  	* scheme-scripts.texi (Invoking Guile): documented new '-L'
 	switch.
- 
+
 2004-08-20  Marius Vollmer  <mvo@zagadka.de>
 
 	* gh.texi: Updated transition section with new recommended things.
@@ -1082,7 +1150,7 @@
 	mutation-sharing substrings.
 	(Symbols): Document scm_from_locale_symbol and
 	scm_from_locale_symboln.
-	
+
 2004-08-18  Kevin Ryde  <user42@zip.com.au>
 
 	* posix.texi (Network Sockets and Communication): Add SOCK_RDM and
@@ -1144,7 +1212,7 @@
 	scm_is_complex, scm_is_number, scm_c_make_rectangular,
 	scm_c_make_polar, scm_c_real_part, scm_c_imag_part,
 	scm_c_magnitude, and scm_c_angle.
-	
+
 2004-08-02  Marius Vollmer  <marius.vollmer@uni-dortmund.de>
 
 	* gh.texi: Replaced references to scm_num2* with scm_to_* and
@@ -1180,7 +1248,7 @@
 	* api-deprecated.texi: Removed.
 	* intro.texi (Discouraged and Deprecated): General information
 	about deprecation, etc.
-	
+
 2004-07-30  Marius Vollmer  <marius.vollmer@uni-dortmund.de>
 
 	* misc-modules.texi (Formatted Output): Changed @w to @w{} in
@@ -1265,7 +1333,7 @@
 
 	* Makefile.am (CLEANFILES): Remove guile.cps guile.fns guile.rns
 	guile.tps guile.vrs guile.tmp, cleaned by automake these days.
- 	
+
 2004-05-06  Marius Vollmer  <marius.vollmer@uni-dortmund.de>
 
 	* scheme-smobs.texi: Updated for new SCM_SMOB_* macros.
@@ -1348,7 +1416,7 @@
 	* scheme-control.texi (while do): Expand and clarify `do', in
 	particular note iteration binds fresh locations, rather than values
 	"stored".
- 
+
 	* srfi-modules.texi (SRFI-4): Revise for clarity, give each function
 	explicitly rather than showing TAG so Emacs info-look can find them,
 	merge "SRFI-4 - Read Syntax" and "SRFI-4 - Procedures" into just one
@@ -1378,7 +1446,7 @@
 2004-01-21  Marius Vollmer  <mvo@zagadka.de>
 
 	Added copyright notices to all TeXinfo files.
-	
+
 	* fdl.texi: New.
 	* guile.texi: Include it as an appendix.
 	* preface.texi: State that the manual is FDL.
@@ -1400,7 +1468,7 @@
 
 	* misc-modules.texi (Queues): New chapter.
 	* guile.texi (Top): Add it.
-	
+
 2004-01-09  Kevin Ryde  <user42@zip.com.au>
 
 	* scheme-compound.texi (Bit Vectors): Revise for clarity, following
@@ -1455,7 +1523,7 @@
 	* scheme-data.texi: Include exact rationals.
 
 	From Stephen Compall.  Thanks!
-	
+
         * intro.texi (What is Guile?): Add @acronym for POSIX, R5RS, GUI,
 	and HTTP.  Conclude linking libguile.  Say what one can find *for*.
 
@@ -1536,7 +1604,7 @@
 	* data-rep.texi, scheme-memory.texi (scm_remember_upto_here_1,
 	scm_remember_upto_here_2): Moved from data-rep.texi to
 	scheme-memory.texi.
-	
+
 2003-10-02  Kevin Ryde  <user42@zip.com.au>
 
 	* scheme-io.texi (String Ports): In call-with-output-string, note proc
@@ -1867,7 +1935,7 @@
 	remainder and modulo round their results.
 
 	* scheme-io.texi (Reading): In read-char and peek-char, fix typos "?"
-	in @rnindex.  In port-column, use @: after i.e.  
+	in @rnindex.  In port-column, use @: after i.e.
 	(Writing): In get-print-state, two spaces after full stop.  Add write,
 	revise display.
 
@@ -1886,7 +1954,7 @@
 
 2003-04-30  Marius Vollmer  <marius.vollmer@uni-dortmund.de>
 
-	* posix.texi (scm_c_port_for_each): Added. 
+	* posix.texi (scm_c_port_for_each): Added.
 
 2003-04-26  Neil Jerram  <neil@ossau.uklinux.net>
 
@@ -2017,7 +2085,7 @@
 	Configuration.
 
 	The following doc updates are from Ian Sheldon - thanks!
-	
+
 	* scheme-data.texi (Appending Strings, Regexp Functions, Match
 	Structures): Add examples.
 	(Regular Expressions): Add instruction to use (ice-9 regex)
@@ -2055,7 +2123,7 @@
 
 	* intro.texi: Updated GNu ftp server name.  Use "-lguile" instead
 	of "libguile.a".  Some small fixes/improvements.
-	
+
 	* scheme-reading.texi: Added www.schemers.org.  Removed foldoc,
 	it's too generic.  Updated 'teach yourself ...' URL.
 
@@ -2066,7 +2134,7 @@
 
 2002-08-14  Marius Vollmer  <mvo@zagadka.ping.de>
 
-	* scheme-evaluation.texi (eval-string): Updated. 
+	* scheme-evaluation.texi (eval-string): Updated.
 
 	* scheme-scheduling.texi (Fluids): Touched up a bit, added
 	with-fluids.
@@ -2106,7 +2174,7 @@
 
 	* scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc.
 	correct typos.
-	
+
 2002-08-05  Marius Vollmer  <marius.vollmer@uni-dortmund.de>
 
 	* intro.texi, srfi-modules.texi: Added (use-modules (ice-9
@@ -2150,7 +2218,7 @@
 	rather than deprecated section.  Hence this change.  Added
 	`@deftp' for scm_t_bits data type so that a proper index entry is
 	added for this.  Thanks to Richard Y. Kim!
-	
+
 	* data-rep.texi (Subrs): Changed scm_make_gsubr to
 	scm_c_define_gsubr.  Thanks to Richard Y. Kim!
 
@@ -2187,13 +2255,13 @@
 
 	* scheme-debug.texi (Debugging): Rename chapter `Debugging
 	Infrastructure' and reorganize its contents.
-	
+
 	* scheme-debug.texi (Debugging), scheme-control.texi (Handling
 	Errors): Move display-error to error-focussed section.
 
 	* scheme-debug.texi (Debugging), debugging.texi (Backtrace): Move
 	backtrace to user-level debugging chapter.
-	
+
 	* scheme-debug.texi (Debugging), scheme-procedures.texi (Procedure
 	Properties): Move procedure-name, procedure-source and
 	procedure-environment to procedures chapter.
@@ -2276,7 +2344,7 @@
 
 	* scheme-utility.texi (Hooks): Further updates.  New material on
 	GC hooks.
-	
+
 	* scheme-evaluation.texi (Fly Evaluation): Note disappearance of
 	eval2 and read-and-eval!.
 

doc/ref/Makefile.am

@@ -1,6 +1,6 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##  	Copyright (C) 1998, 2004, 2006 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -86,7 +86,8 @@ include $(top_srcdir)/am/pre-inst-guile
 
 autoconf.texi: autoconf-macros.texi
 autoconf-macros.texi: $(top_srcdir)/guile-config/guile.m4
-	$(preinstguiletool)/snarf-guile-m4-docs $< > $(srcdir)/$@
+	$(preinstguiletool)/snarf-guile-m4-docs $(top_srcdir)/guile-config/guile.m4 \
+	  > $(srcdir)/$@
 
 lib-version.texi: $(top_srcdir)/GUILE-VERSION
 	cat "$^" | grep '^LIBGUILE_.*_MAJOR' |				\

doc/ref/api-data.texi

@@ -4647,6 +4647,11 @@ immediately after creating the Scheme string.  In certain cases, Guile
 can then use @var{str} directly as its internal representation.
 @end deftypefn
 
+The size of a symbol can also be obtained from C:
+
+@deftypefn {C Function} size_t scm_c_symbol_length (SCM sym)
+Return the number of characters in @var{sym}.
+@end deftypefn
 
 Finally, some applications, especially those that generate new Scheme
 code dynamically, need to generate symbols for use in the generated
@@ -4901,7 +4906,7 @@ makes them easy to type.
 
 Guile's keyword support conforms to R5RS, and adds a (switchable) read
 syntax extension to permit keywords to begin with @code{:} as well as
-@code{#:}.
+@code{#:}, or to end with @code{:}.
 
 @menu
 * Why Use Keywords?::           Motivation for keyword usage.
@@ -5046,9 +5051,16 @@ If the @code{keyword} read option is set to @code{'prefix}, Guile also
 recognizes the alternative read syntax @code{:NAME}.  Otherwise, tokens
 of the form @code{:NAME} are read as symbols, as required by R5RS.
 
+@cindex SRFI-88 keyword syntax
+
+If the @code{keyword} read option is set to @code{'postfix}, Guile
+recognizes the SRFI-88 read syntax @code{NAME:} (@pxref{SRFI-88}).
+Otherwise, tokens of this form are read as symbols.
+
 To enable and disable the alternative non-R5RS keyword syntax, you use
 the @code{read-set!} procedure documented in @ref{User level options
-interfaces} and @ref{Reader options}.
+interfaces} and @ref{Reader options}.  Note that the @code{prefix} and
+@code{postfix} syntax are mutually exclusive.
 
 @smalllisp
 (read-set! keywords 'prefix)
@@ -5061,6 +5073,16 @@ interfaces} and @ref{Reader options}.
 @result{}
 #:type
 
+(read-set! keywords 'postfix)
+
+type:
+@result{}
+#:type
+
+:type
+@result{}
+:type
+
 (read-set! keywords #f)
 
 #:type

doc/ref/api-debug.texi

@@ -8,6 +8,7 @@
 @node Debugging
 @section Debugging Infrastructure
 
+@cindex Debugging
 In order to understand Guile's debugging facilities, you first need to
 understand a little about how the evaluator works and what the Scheme
 stack is.  With that in place we explain the low level trap calls that

doc/ref/api-modules.texi

@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -329,12 +329,12 @@ Signal error if module name is not resolvable.
 
 
 @c FIXME::martin: Is this correct, and is there more to say?
-@c FIXME::martin: Define term and concept `system transformer' somewhere.
+@c FIXME::martin: Define term and concept `syntax transformer' somewhere.
 
 @deffn syntax use-syntax module-name
-Load the module @code{module-name} and use its system
+Load the module @code{module-name} and use its syntax
-transformer as the system transformer for the currently defined module,
+transformer as the syntax transformer for the currently defined module,
-as well as installing it as the current system transformer.
+as well as installing it as the current syntax transformer.
 @end deffn
 
 @deffn syntax @@ module-name binding-name

doc/ref/api-options.texi

@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -491,7 +491,7 @@ Here is the list of reader options generated by typing
 values.
 
 @smalllisp
-keywords         #f      Style of keyword recognition: #f or 'prefix
+keywords         #f      Style of keyword recognition: #f, 'prefix or 'postfix
 case-insensitive no      Convert symbols to lower case.
 positions        yes     Record positions of source code expressions.
 copy             no      Copy source code expressions.
@@ -729,7 +729,7 @@ ABORT: (misc-error)
 
 Type "(backtrace)" to get more information.
 guile> (read-options 'help)
-keywords	#f	Style of keyword recognition: #f or 'prefix
+keywords	#f	Style of keyword recognition: #f, 'prefix or 'postfix
 case-insensitive	no	Convert symbols to lower case.
 positions	yes	Record positions of source code expressions.
 copy		no	Copy source code expressions.

doc/ref/api-scheduling.texi

@@ -90,8 +90,8 @@ execution and triggering this execution.  They will not be executed
 automatically.
 
 @menu
-* System asyncs::               
+* System asyncs::
-* User asyncs::                 
+* User asyncs::
 @end menu
 
 @node System asyncs
@@ -279,11 +279,11 @@ Return @code{#t} iff @var{obj} is a thread; otherwise, return
 @deffnx {C Function} scm_join_thread_timed (thread, timeout, timeoutval)
 Wait for @var{thread} to terminate and return its exit value.  Threads
 that have not been created with @code{call-with-new-thread} or
-@code{scm_spawn_thread} have an exit value of @code{#f}.  When 
+@code{scm_spawn_thread} have an exit value of @code{#f}.  When
 @var{timeout} is given, it specifies a point in time where the waiting
-should be aborted.  It can be either an integer as returned by 
+should be aborted.  It can be either an integer as returned by
-@code{current-time} or a pair as returned by @code{gettimeofday}.  
+@code{current-time} or a pair as returned by @code{gettimeofday}.
-When the waiting is aborted, @var{timeoutval} is returned (if it is 
+When the waiting is aborted, @var{timeoutval} is returned (if it is
 specified; @code{#f} is returned otherwise).
 @end deffn
 
@@ -378,9 +378,9 @@ in all threads is one way to avoid such problems.
 @deffn {Scheme Procedure} make-mutex . flags
 @deffnx {C Function} scm_make_mutex ()
 @deffnx {C Function} scm_make_mutex_with_flags (SCM flags)
-Return a new mutex.  It is initially unlocked.  If @var{flags} is 
+Return a new mutex.  It is initially unlocked.  If @var{flags} is
 specified, it must be a list of symbols specifying configuration flags
-for the newly-created mutex.  The supported flags are: 
+for the newly-created mutex.  The supported flags are:
 @table @code
 @item unchecked-unlock
 Unless this flag is present, a call to `unlock-mutex' on the returned
@@ -398,7 +398,7 @@ The returned mutex will be recursive.
 
 @deffn {Scheme Procedure} mutex? obj
 @deffnx {C Function} scm_mutex_p (obj)
-Return @code{#t} iff @var{obj} is a mutex; otherwise, return 
+Return @code{#t} iff @var{obj} is a mutex; otherwise, return
 @code{#f}.
 @end deffn
 
@@ -409,16 +409,20 @@ function is equivalent to calling `make-mutex' and specifying the
 @code{recursive} flag.
 @end deffn
 
-@deffn {Scheme Procedure} lock-mutex mutex [timeout]
+@deffn {Scheme Procedure} lock-mutex mutex [timeout [owner]]
 @deffnx {C Function} scm_lock_mutex (mutex)
-@deffnx {C Function} scm_lock_mutex_timed (mutex, timeout)
+@deffnx {C Function} scm_lock_mutex_timed (mutex, timeout, owner)
-Lock @var{mutex}.  If the mutex is already locked by another thread
+Lock @var{mutex}.  If the mutex is already locked, then block and
-then block and return only when @var{mutex} has been acquired.
+return only when @var{mutex} has been acquired.
 
-When @var{timeout} is given, it specifies a point in time where the 
+When @var{timeout} is given, it specifies a point in time where the
-waiting should be aborted.  It can be either an integer as returned 
+waiting should be aborted.  It can be either an integer as returned
-by @code{current-time} or a pair as returned by @code{gettimeofday}.  
+by @code{current-time} or a pair as returned by @code{gettimeofday}.
-When the waiting is aborted, @code{#f} is returned. 
+When the waiting is aborted, @code{#f} is returned.
+
+When @var{owner} is given, it specifies an owner for @var{mutex} other
+than the calling thread.  @var{owner} may also be @code{#f},
+indicating that the mutex should be locked but left unowned.
 
 For standard mutexes (@code{make-mutex}), and error is signalled if
 the thread has itself already locked @var{mutex}.
@@ -429,7 +433,7 @@ call increments the lock count.  An additional @code{unlock-mutex}
 will be required to finally release.
 
 If @var{mutex} was locked by a thread that exited before unlocking it,
-the next attempt to lock @var{mutex} will succeed, but 
+the next attempt to lock @var{mutex} will succeed, but
 @code{abandoned-mutex-error} will be signalled.
 
 When a system async (@pxref{System asyncs}) is activated for a thread
@@ -441,7 +445,7 @@ executed.  When the async returns, the wait resumes.
 Arrange for @var{mutex} to be locked whenever the current dynwind
 context is entered and to be unlocked when it is exited.
 @end deftypefn
- 
+
 @deffn {Scheme Procedure} try-mutex mx
 @deffnx {C Function} scm_try_mutex (mx)
 Try to lock @var{mutex} as per @code{lock-mutex}.  If @var{mutex} can
@@ -454,23 +458,44 @@ the return is @code{#f}.
 @deffnx {C Function} scm_unlock_mutex (mutex)
 @deffnx {C Function} scm_unlock_mutex_timed (mutex, condvar, timeout)
 Unlock @var{mutex}.  An error is signalled if @var{mutex} is not locked
-and was not created with the @code{unchecked-unlock} flag set, or if 
+and was not created with the @code{unchecked-unlock} flag set, or if
 @var{mutex} is locked by a thread other than the calling thread and was
 not created with the @code{allow-external-unlock} flag set.
 
 If @var{condvar} is given, it specifies a condition variable upon
 which the calling thread will wait to be signalled before returning.
-(This behavior is very similar to that of 
+(This behavior is very similar to that of
 @code{wait-condition-variable}, except that the mutex is left in an
 unlocked state when the function returns.)
 
-When @var{timeout} is also given, it specifies a point in time where 
+When @var{timeout} is also given, it specifies a point in time where
-the waiting should be aborted.  It can be either an integer as 
+the waiting should be aborted.  It can be either an integer as
-returned by @code{current-time} or a pair as returned by 
+returned by @code{current-time} or a pair as returned by
-@code{gettimeofday}.  When the waiting is aborted, @code{#f} is 
+@code{gettimeofday}.  When the waiting is aborted, @code{#f} is
 returned.  Otherwise the function returns @code{#t}.
 @end deffn
 
+@deffn {Scheme Procedure} mutex-owner mutex
+@deffnx {C Function} scm_mutex_owner (mutex)
+Return the current owner of @var{mutex}, in the form of a thread or
+@code{#f} (indicating no owner).  Note that a mutex may be unowned but
+still locked.
+@end deffn
+
+@deffn {Scheme Procedure} mutex-level mutex
+@deffnx {C Function} scm_mutex_level (mutex)
+Return the current lock level of @var{mutex}.  If @var{mutex} is
+currently unlocked, this value will be 0; otherwise, it will be the
+number of times @var{mutex} has been recursively locked by its current
+owner.
+@end deffn
+
+@deffn {Scheme Procedure} mutex-locked? mutex
+@deffnx {C Function} scm_mutex_locked_p (mutex)
+Return @code{#t} if @var{mutex} is locked, regardless of ownership;
+otherwise, return @code{#f}.
+@end deffn
+
 @deffn {Scheme Procedure} make-condition-variable
 @deffnx {C Function} scm_make_condition_variable ()
 Return a new condition variable.
@@ -478,7 +503,7 @@ Return a new condition variable.
 
 @deffn {Scheme Procedure} condition-variable? obj
 @deffnx {C Function} scm_condition_variable_p (obj)
-Return @code{#t} iff @var{obj} is a condition variable; otherwise, 
+Return @code{#t} iff @var{obj} is a condition variable; otherwise,
 return @code{#f}.
 @end deffn
 

doc/ref/autoconf.texi

@@ -8,10 +8,10 @@
 @node Autoconf Support
 @chapter Autoconf Support
 
-When Guile is installed, a set of autoconf macros is also installed as
+When Guile is installed, a pkg-config description file and a set of
-PREFIX/share/aclocal/guile.m4.  This chapter documents the macros provided in
+Autoconf macros is installed.  This chapter documents pkg-config and
-that file, as well as the high-level guile-tool Autofrisk.  @xref{Top,The GNU
+Autoconf support, as well as the high-level guile-tool Autofrisk.
-Autoconf Manual,,autoconf}, for more info.
+@xref{Top,The GNU Autoconf Manual,,autoconf}, for more info.
 
 @menu
 * Autoconf Background::         Why use autoconf?
@@ -45,7 +45,38 @@ checks.
 @node Autoconf Macros
 @section Autoconf Macros
 
-The macro names all begin with "GUILE_".
+@cindex pkg-config
+@cindex autoconf
+
+GNU Guile provides a @dfn{pkg-config} description file, installed as
+@file{@var{prefix}/lib/pkgconfig/guile-1.8.pc}, which contains all the
+information necessary to compile and link C applications that use Guile.
+The @code{pkg-config} program is able to read this file and provide this
+information to application programmers; it can be obtained at
+@url{http://pkg-config.freedesktop.org/}.
+
+The following command lines give respectively the C compilation and link
+flags needed to build Guile-using programs:
+
+@example
+pkg-config guile-1.8 --cflags
+pkg-config guile-1.8 --libs
+@end example
+
+To ease use of pkg-config with Autoconf, pkg-config comes with a
+convenient Autoconf macro.  The following example looks for Guile and
+sets the @code{GUILE_CFLAGS} and @code{GUILE_LIBS} variables
+accordingly, or prints an error and exits if Guile was not found:
+
+@findex PKG_CHECK_MODULES
+
+@example
+PKG_CHECK_MODULES([GUILE], [guile-1.8])
+@end example
+
+Guile comes with additional Autoconf macros providing more information,
+installed as @file{@var{prefix}/share/aclocal/guile.m4}.  Their names
+all begin with @code{GUILE_}.
 
 @c see Makefile.am
 @include autoconf-macros.texi

doc/ref/guile.texi

@@ -177,6 +177,8 @@ x
 
 * Guile Modules::
 
+* Autoconf Support::
+
 Appendices
 
 * Data Representation::             All the details.
@@ -362,6 +364,8 @@ available through both Scheme and C interfaces.
 @include scsh.texi
 @include scheme-debugging.texi
 
+@include autoconf.texi
+
 @include data-rep.texi
 @include fdl.texi
 

doc/ref/posix.texi

@@ -956,6 +956,11 @@ If @var{suffix} is provided, and is equal to the end of
 @end lisp
 @end deffn
 
+@deffn {Scheme Procedure} file-exists? filename
+Return @code{#t} if the file named @var{filename} exists, @code{#f} if
+not.
+@end deffn
+
 
 @node User Information
 @subsection User Information

doc/ref/scheme-using.texi

@@ -359,6 +359,8 @@ debugger to continue.)
 @node Using Guile in Emacs
 @section Using Guile in Emacs
 
+@cindex GDS
+@cindex Emacs
 There are several options for working on Guile Scheme code in Emacs.
 The simplest are to use Emacs's standard @code{scheme-mode} for
 editing code, and to run the interpreter when you need it by typing
@@ -986,6 +988,14 @@ region contains a balanced expression, or try to expand the region so
 that it does; it uses the region exactly as it is.
 @end table
 
+If you type @kbd{C-u} before one of these commands, GDS will
+immediately pop up a Scheme stack buffer, showing the requested
+evaluation, so that you can single step through it.  (This is achieved
+by setting a @code{<source-trap>} trap at the start of the requested
+evaluation; see @ref{Source Traps} for more on how those work.)  The
+Scheme stack display, and the options for continuing through the code,
+are described in the next two sections.
+
 
 @node Displaying the Scheme Stack
 @subsection Displaying the Scheme Stack

doc/ref/srfi-modules.texi

@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -34,6 +34,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-14::                     Character-set library.
 * SRFI-16::                     case-lambda
 * SRFI-17::                     Generalized set!
+* SRFI-18::                     Multithreading support
 * SRFI-19::                     Time/Date library.
 * SRFI-26::                     Specializing parameters
 * SRFI-31::                     A special form `rec' for recursive evaluation
@@ -45,6 +46,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-60::                     Integers as bits.
 * SRFI-61::                     A more general `cond' clause
 * SRFI-69::                     Basic hash tables.
+* SRFI-88::                     Keyword objects.
 @end menu
 
 
@@ -1677,6 +1679,344 @@ The same as the Guile core @code{make-procedure-with-setter}
 @end defun
 
 
+@node SRFI-18
+@subsection SRFI-18 - Multithreading support
+@cindex SRFI-18
+
+This is an implementation of the SRFI-18 threading and synchronization
+library.  The functions and variables described here are provided by
+
+@example
+(use-modules (srfi srfi-18))
+@end example
+
+As a general rule, the data types and functions in this SRFI-18
+implementation are compatible with the types and functions in Guile's
+core threading code.  For example, mutexes created with the SRFI-18 
+@code{make-mutex} function can be passed to the built-in Guile 
+function @code{lock-mutex} (@pxref{Mutexes and Condition Variables}),
+and mutexes created with the built-in Guile function @code{make-mutex}
+can be passed to the SRFI-18 function @code{mutex-lock!}.  Cases in
+which this does not hold true are noted in the following sections.
+
+@menu
+* SRFI-18 Threads::             Executing code 
+* SRFI-18 Mutexes::             Mutual exclusion devices
+* SRFI-18 Condition variables:: Synchronizing of groups of threads
+* SRFI-18 Time::                Representation of times and durations
+* SRFI-18 Exceptions::          Signalling and handling errors
+@end menu
+
+@node SRFI-18 Threads
+@subsubsection SRFI-18 Threads
+
+Threads created by SRFI-18 differ in two ways from threads created by 
+Guile's built-in thread functions.  First, a thread created by SRFI-18
+@code{make-thread} begins in a blocked state and will not start 
+execution until @code{thread-start!} is called on it.  Second, SRFI-18
+threads are constructed with a top-level exception handler that 
+captures any exceptions that are thrown on thread exit.  In all other
+regards, SRFI-18 threads are identical to normal Guile threads.
+
+@defun current-thread
+Returns the thread that called this function.  This is the same
+procedure as the same-named built-in procedure @code{current-thread}
+(@pxref{Threads}).
+@end defun
+
+@defun thread? obj
+Returns @code{#t} if @var{obj} is a thread, @code{#f} otherwise.  This
+is the same procedure as the same-named built-in procedure 
+@code{thread?} (@pxref{Threads}).
+@end defun
+
+@defun make-thread thunk [name]
+Call @code{thunk} in a new thread and with a new dynamic state,
+returning the new thread and optionally assigning it the object name
+@var{name}, which may be any Scheme object.
+
+Note that the name @code{make-thread} conflicts with the 
+@code{(ice-9 threads)} function @code{make-thread}.  Applications 
+wanting to use both of these functions will need to refer to them by 
+different names.
+@end defun
+
+@defun thread-name thread
+Returns the name assigned to @var{thread} at the time of its creation,
+or @code{#f} if it was not given a name.
+@end defun
+
+@defun thread-specific thread
+@defunx thread-specific-set! thread obj
+Get or set the ``object-specific'' property of @var{thread}.  In
+Guile's implementation of SRFI-18, this value is stored as an object
+property, and will be @code{#f} if not set.
+@end defun
+
+@defun thread-start! thread
+Unblocks @var{thread} and allows it to begin execution if it has not
+done so already.
+@end defun
+
+@defun thread-yield!
+If one or more threads are waiting to execute, calling 
+@code{thread-yield!} forces an immediate context switch to one of them.
+Otherwise, @code{thread-yield!} has no effect.  @code{thread-yield!} 
+behaves identically to the Guile built-in function @code{yield}.
+@end defun
+
+@defun thread-sleep! timeout
+The current thread waits until the point specified by the time object
+@var{timeout} is reached (@pxref{SRFI-18 Time}).  This blocks the 
+thread only if @var{timeout} represents a point in the future.  it is 
+an error for @var{timeout} to be @code{#f}.
+@end defun
+
+@defun thread-terminate! thread
+Causes an abnormal termination of @var{thread}.  If @var{thread} is
+not already terminated, all mutexes owned by @var{thread} become
+unlocked/abandoned.  If @var{thread} is the current thread, 
+@code{thread-terminate!} does not return.  Otherwise 
+@code{thread-terminate!} returns an unspecified value; the termination
+of @var{thread} will occur before @code{thread-terminate!} returns.  
+Subsequent attempts to join on @var{thread} will cause a ``terminated 
+thread exception'' to be raised.
+
+@code{thread-terminate!} is compatible with the thread cancellation
+procedures in the core threads API (@pxref{Threads}) in that if a 
+cleanup handler has been installed for the target thread, it will be 
+called before the thread exits and its return value (or exception, if
+any) will be stored for later retrieval via a call to 
+@code{thread-join!}.
+@end defun
+
+@defun thread-join! thread [timeout [timeout-val]]
+Wait for @var{thread} to terminate and return its exit value.  When a 
+time value @var{timeout} is given, it specifies a point in time where
+the waiting should be aborted.  When the waiting is aborted, 
+@var{timeoutval} is returned if it is specified; otherwise, a
+@code{join-timeout-exception} exception is raised 
+(@pxref{SRFI-18 Exceptions}).  Exceptions may also be raised if the 
+thread was terminated by a call to @code{thread-terminate!} 
+(@code{terminated-thread-exception} will be raised) or if the thread 
+exited by raising an exception that was handled by the top-level 
+exception handler (@code{uncaught-exception} will be raised; the 
+original exception can be retrieved using 
+@code{uncaught-exception-reason}).
+@end defun
+
+
+@node SRFI-18 Mutexes
+@subsubsection SRFI-18 Mutexes
+
+The behavior of Guile's built-in mutexes is parameterized via a set of
+flags passed to the @code{make-mutex} procedure in the core
+(@pxref{Mutexes and Condition Variables}).  To satisfy the requirements
+for mutexes specified by SRFI-18, the @code{make-mutex} procedure
+described below sets the following flags:
+@itemize @bullet
+@item
+@code{recursive}: the mutex can be locked recursively
+@item
+@code{unchecked-unlock}: attempts to unlock a mutex that is already
+unlocked will not raise an exception
+@item
+@code{allow-external-unlock}: the mutex can be unlocked by any thread,
+not just the thread that locked it originally
+@end itemize
+
+@defun make-mutex [name]
+Returns a new mutex, optionally assigning it the object name 
+@var{name}, which may be any Scheme object.  The returned mutex will be
+created with the configuration described above.  Note that the name 
+@code{make-mutex} conflicts with Guile core function @code{make-mutex}.
+Applications wanting to use both of these functions will need to refer 
+to them by different names.
+@end defun
+
+@defun mutex-name mutex
+Returns the name assigned to @var{mutex} at the time of its creation, 
+or @code{#f} if it was not given a name.
+@end defun
+
+@defun mutex-specific mutex
+@defunx mutex-specific-set! mutex obj
+Get or set the ``object-specific'' property of @var{mutex}.  In Guile's
+implementation of SRFI-18, this value is stored as an object property, 
+and will be @code{#f} if not set.
+@end defun
+
+@defun mutex-state mutex
+Returns information about the state of @var{mutex}.  Possible values 
+are:
+@itemize @bullet
+@item
+thread @code{T}: the mutex is in the locked/owned state and thread T
+is the owner of the mutex
+@item 
+symbol @code{not-owned}: the mutex is in the locked/not-owned state
+@item
+symbol @code{abandoned}: the mutex is in the unlocked/abandoned state
+@item
+symbol @code{not-abandoned}: the mutex is in the 
+unlocked/not-abandoned state 
+@end itemize
+@end defun
+
+@defun mutex-lock! mutex [timeout [thread]]
+Lock @var{mutex}, optionally specifying a time object @var{timeout}
+after which to abort the lock attempt and a thread @var{thread} giving
+a new owner for @var{mutex} different than the current thread.  This 
+procedure has the same behavior as the @code{lock-mutex} procedure in 
+the core library.
+@end defun
+
+@defun mutex-unlock! mutex [condition-variable [timeout]]
+Unlock @var{mutex}, optionally specifying a condition variable
+@var{condition-variable} on which to wait, either indefinitely or,
+optionally, until the time object @var{timeout} has passed, to be
+signalled.  This procedure has the same behavior as the 
+@code{unlock-mutex} procedure in the core library.
+@end defun
+
+
+@node SRFI-18 Condition variables
+@subsubsection SRFI-18 Condition variables
+
+SRFI-18 does not specify a ``wait'' function for condition variables.
+Waiting on a condition variable can be simulated using the SRFI-18
+@code{mutex-unlock!} function described in the previous section, or
+Guile's built-in @code{wait-condition-variable} procedure can be used.
+
+@defun condition-variable? obj
+Returns @code{#t} if @var{obj} is a condition variable, @code{#f}
+otherwise.  This is the same procedure as the same-named built-in 
+procedure
+(@pxref{Mutexes and Condition Variables, @code{condition-variable?}}).
+@end defun
+
+@defun make-condition-variable [name]
+Returns a new condition variable, optionally assigning it the object
+name @var{name}, which may be any Scheme object.  This procedure 
+replaces a procedure of the same name in the core library.
+@end defun
+
+@defun condition-variable-name condition-variable
+Returns the name assigned to @var{thread} at the time of its creation,
+or @code{#f} if it was not given a name.
+@end defun
+
+@defun condition-variable-specific condition-variable
+@defunx condition-variable-specific-set! condition-variable obj
+Get or set the ``object-specific'' property of 
+@var{condition-variable}.  In Guile's implementation of SRFI-18, this
+value is stored as an object property, and will be @code{#f} if not 
+set.
+@end defun
+
+@defun condition-variable-signal! condition-variable
+@defunx condition-variable-broadcast! condition-variable
+Wake up one thread that is waiting for @var{condition-variable}, in
+the case of @code{condition-variable-signal!}, or all threads waiting
+for it, in the case of @code{condition-variable-broadcast!}.  The
+behavior of these procedures is equivalent to that of the procedures
+@code{signal-condition-variable} and 
+@code{broadcast-condition-variable} in the core library.
+@end defun
+
+
+@node SRFI-18 Time
+@subsubsection SRFI-18 Time
+
+The SRFI-18 time functions manipulate time in two formats: a 
+``time object'' type that represents an absolute point in time in some 
+implementation-specific way; and the number of seconds since some 
+unspecified ``epoch''.  In Guile's implementation, the epoch is the
+Unix epoch, 00:00:00 UTC, January 1, 1970.
+
+@defun current-time
+Return the current time as a time object.  This procedure replaces 
+the procedure of the same name in the core library, which returns the
+current time in seconds since the epoch.
+@end defun
+
+@defun time? obj
+Returns @code{#t} if @var{obj} is a time object, @code{#f} otherwise.
+@end defun
+
+@defun time->seconds time
+@defunx seconds->time seconds
+Convert between time objects and numerical values representing the
+number of seconds since the epoch.  When converting from a time object 
+to seconds, the return value is the number of seconds between 
+@var{time} and the epoch.  When converting from seconds to a time 
+object, the return value is a time object that represents a time 
+@var{seconds} seconds after the epoch.
+@end defun
+
+
+@node SRFI-18 Exceptions
+@subsubsection SRFI-18 Exceptions
+
+SRFI-18 exceptions are identical to the exceptions provided by 
+Guile's implementation of SRFI-34.  The behavior of exception 
+handlers invoked to handle exceptions thrown from SRFI-18 functions,
+however, differs from the conventional behavior of SRFI-34 in that
+the continuation of the handler is the same as that of the call to
+the function.  Handlers are called in a tail-recursive manner; the
+exceptions do not ``bubble up''.
+
+@defun current-exception-handler
+Returns the current exception handler.
+@end defun
+
+@defun with-exception-handler handler thunk
+Installs @var{handler} as the current exception handler and calls the
+procedure @var{thunk} with no arguments, returning its value as the 
+value of the exception.  @var{handler} must be a procedure that accepts
+a single argument. The current exception handler at the time this 
+procedure is called will be restored after the call returns.
+@end defun
+
+@defun raise obj
+Raise @var{obj} as an exception.  This is the same procedure as the
+same-named procedure defined in SRFI 34.
+@end defun
+
+@defun join-timeout-exception? obj
+Returns @code{#t} if @var{obj} is an exception raised as the result of 
+performing a timed join on a thread that does not exit within the
+specified timeout, @code{#f} otherwise.
+@end defun
+
+@defun abandoned-mutex-exception? obj
+Returns @code{#t} if @var{obj} is an exception raised as the result of
+attempting to lock a mutex that has been abandoned by its owner thread,
+@code{#f} otherwise.
+@end defun
+
+@defun terminated-thread-exception? obj
+Returns @code{#t} if @var{obj} is an exception raised as the result of 
+joining on a thread that exited as the result of a call to
+@code{thread-terminate!}.
+@end defun
+
+@defun uncaught-exception? obj
+@defunx uncaught-exception-reason exc
+@code{uncaught-exception?} returns @code{#t} if @var{obj} is an 
+exception thrown as the result of joining a thread that exited by
+raising an exception that was handled by the top-level exception
+handler installed by @code{make-thread}.  When this occurs, the 
+original exception is preserved as part of the exception thrown by
+@code{thread-join!} and can be accessed by calling 
+@code{uncaught-exception-reason} on that exception.  Note that
+because this exception-preservation mechanism is a side-effect of
+@code{make-thread}, joining on threads that exited as described above
+but were created by other means will not raise this 
+@code{uncaught-exception} error.
+@end defun
+
+
 @node SRFI-19
 @subsection SRFI-19 - Time/Date Library
 @cindex SRFI-19
@@ -1844,8 +2184,10 @@ Return the current time of the given @var{type}.  The default
 @var{type} is @code{time-utc}.
 
 Note that the name @code{current-time} conflicts with the Guile core
-@code{current-time} function (@pxref{Time}).  Applications wanting to
+@code{current-time} function (@pxref{Time}) as well as the SRFI-18
-use both will need to use a different name for one of them.
+@code{current-time} function (@pxref{SRFI-18 Time}).  Applications 
+wanting to use more than one of these functions will need to refer to
+them by different names.
 @end defun
 
 @defun time-resolution [type]
@@ -3216,6 +3558,56 @@ Answer a hash value appropriate for equality predicate @code{equal?},
 @code{hash} is a backwards-compatible replacement for Guile's built-in
 @code{hash}.
 
+@node SRFI-88
+@subsection SRFI-88 Keyword Objects
+@cindex SRFI-88
+@cindex keyword objects
+
+@uref{http://srfi.schemers.org/srfi-88/srfi-88.html, SRFI-88} provides
+@dfn{keyword objects}, which are equivalent to Guile's keywords
+(@pxref{Keywords}).  SRFI-88 keywords can be entered using the
+@dfn{postfix keyword syntax}, which consists of an identifier followed
+by @code{:} (@pxref{Reader options, @code{postfix} keyword syntax}).
+SRFI-88 can be made available with:
+
+@example
+(use-modules (srfi srfi-88))
+@end example
+
+Doing so installs the right reader option for keyword syntax, using
+@code{(read-set! keywords 'postfix)}.  It also provides the procedures
+described below.
+
+@deffn {Scheme Procedure} keyword? obj
+Return @code{#t} if @var{obj} is a keyword.  This is the same procedure
+as the same-named built-in procedure (@pxref{Keyword Procedures,
+@code{keyword?}}).
+
+@example
+(keyword? foo:)         @result{} #t
+(keyword? 'foo:)        @result{} #t
+(keyword? "foo")        @result{} #f
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} keyword->string kw
+Return the name of @var{kw} as a string, i.e., without the trailing
+colon.  The returned string may not be modified, e.g., with
+@code{string-set!}.
+
+@example
+(keyword->string foo:)  @result{} "foo"
+@end example
+@end deffn
+
+@deffn {Scheme Procedure} string->keyword str
+Return the keyword object whose name is @var{str}.
+
+@example
+(keyword->string (string->keyword "a b c"))     @result{} "a b c"
+@end example
+@end deffn
+
 
 @c srfi-modules.texi ends here
 

emacs/ChangeLog

@@ -1,3 +1,9 @@
+2008-07-17  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* gds-scheme.el (gds-eval-region, gds-eval-expression)
+	(gds-eval-defun, gds-eval-last-sexp): Support `C-u' prefix,
+	meaning that user wants to single step through the code.
+
 2007-02-06  Clinton Ebadi  <clinton@unknownlamer.org>
 
         * gds-scheme.el (gds-display-results): Use save-selected-window

emacs/gds-scheme.el

@@ -279,9 +279,12 @@ region's code."
       (setq line (count-lines (point-min) (point))))
     (cons line column)))
 
-(defun gds-eval-region (start end)
+(defun gds-eval-region (start end &optional debugp)
-  "Evaluate the current region."
+  "Evaluate the current region.  If invoked with `C-u' prefix (or, in
-  (interactive "r")
+a program, with optional DEBUGP arg non-nil), pause and pop up the
+stack at the start of the evaluation, so that the user can single-step
+through the code."
+  (interactive "r\nP")
   (or gds-client
       (gds-auto-associate-buffer)
       (call-interactively 'gds-associate-buffer))
@@ -289,24 +292,29 @@ region's code."
 	(port-name (gds-port-name start end))
 	(lc (gds-line-and-column start)))
     (let ((code (buffer-substring-no-properties start end)))
-      (gds-send (format "eval (region . %S) %s %S %d %d %S"
+      (gds-send (format "eval (region . %S) %s %S %d %d %S %s"
 			(gds-abbreviated code)
 			(if module (prin1-to-string module) "#f")
 			port-name (car lc) (cdr lc)
-			code)
+			code
+			(if debugp '(debug) '(none)))
 		gds-client))))
 
-(defun gds-eval-expression (expr &optional correlator)
+(defun gds-eval-expression (expr &optional correlator debugp)
-  "Evaluate the supplied EXPR (a string)."
+  "Evaluate the supplied EXPR (a string).  If invoked with `C-u'
-  (interactive "sEvaluate expression: \nP")
+prefix (or, in a program, with optional DEBUGP arg non-nil), pause and
+pop up the stack at the start of the evaluation, so that the user can
+single-step through the code."
+  (interactive "sEvaluate expression: \ni\nP")
   (or gds-client
       (gds-auto-associate-buffer)
       (call-interactively 'gds-associate-buffer))
   (set-text-properties 0 (length expr) nil expr)
-  (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S"
+  (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S %s"
 		    (or correlator 'expression)
 		    (gds-abbreviated expr)
-		    expr)
+		    expr
+		    (if debugp '(debug) '(none)))
 	    gds-client))
 
 (defconst gds-abbreviated-length 35)
@@ -325,19 +333,25 @@ region's code."
       (concat (substring code 0 (- gds-abbreviated-length 3)) "...")
     code))
 
-(defun gds-eval-defun ()
+(defun gds-eval-defun (&optional debugp)
-  "Evaluate the defun (top-level form) at point."
+  "Evaluate the defun (top-level form) at point.  If invoked with
-  (interactive)
+`C-u' prefix (or, in a program, with optional DEBUGP arg non-nil),
+pause and pop up the stack at the start of the evaluation, so that the
+user can single-step through the code."
+  (interactive "P")
   (save-excursion
    (end-of-defun)
    (let ((end (point)))
      (beginning-of-defun)
-     (gds-eval-region (point) end))))
+     (gds-eval-region (point) end debugp))))
 
-(defun gds-eval-last-sexp ()
+(defun gds-eval-last-sexp (&optional debugp)
-  "Evaluate the sexp before point."
+  "Evaluate the sexp before point.  If invoked with `C-u' prefix (or,
-  (interactive)
+in a program, with optional DEBUGP arg non-nil), pause and pop up the
-  (gds-eval-region (save-excursion (backward-sexp) (point)) (point)))
+stack at the start of the evaluation, so that the user can single-step
+through the code."
+  (interactive "P")
+  (gds-eval-region (save-excursion (backward-sexp) (point)) (point) debugp))
 
 ;;;; Help.
 

guile-1.8.pc.in

@@ -0,0 +1,15 @@
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@
+datarootdir=@datarootdir@
+datadir=@datadir@
+
+sitedir=@sitedir@
+libguileinterface=@LIBGUILE_INTERFACE@
+
+Name: GNU Guile
+Description: GNU's Ubiquitous Intelligent Language for Extension
+Version: @GUILE_VERSION@
+Libs: -L${libdir} -lguile @GUILE_LIBS@
+Cflags: -I${includedir} @GUILE_CFLAGS@

guile-config/ChangeLog

@@ -1,3 +1,8 @@
+2008-06-02  Ludovic Courtès  <ludo@gnu.org>
+
+	* guile-config.in (build-link): Show `-L' before `-lguile'.
+	Reported by Peter O'Gorman <pogma@thewrittenword.com>.
+
 2008-01-22  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* COPYING: Removed.

guile-config/guile-config.in

@@ -4,7 +4,7 @@
 ;;;; guile-config --- utility for linking programs with Guile
 ;;;; Jim Blandy <jim@red-bean.com> --- September 1997
 ;;;; 
-;;;; 	Copyright (C) 1998, 2001, 2004, 2005, 2006 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -151,11 +151,11 @@
     (display (string-join
 	      (list
 	       (get-build-info 'CFLAGS)
-	       "-lguile -lltdl" 
                (if (or (string=? libdir "/usr/lib")
                        (string=? libdir "/usr/lib/"))
 		   ""
 		   (string-append "-L" (get-build-info 'libdir)))
+               "-lguile -lltdl"
 	       (string-join other-flags)
 
 	       )))

guile-config/qthreads.m4

@@ -1,165 +0,0 @@
-dnl   Autoconf macros for configuring the QuickThreads package
-dnl   Jim Blandy <jimb@red-bean.com> --- July 1998
-dnl
-dnl  	Copyright (C) 1998, 1999, 2006 Free Software Foundation, Inc.
-dnl
-dnl   This file is part of GUILE.
-dnl
-dnl   GUILE is free software; you can redistribute it and/or modify
-dnl   it under the terms of the GNU General Public License as
-dnl   published by the Free Software Foundation; either version 2, or
-dnl   (at your option) any later version.
-dnl
-dnl   GUILE is distributed in the hope that it will be useful, but
-dnl   WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-dnl   GNU General Public License for more details.
-dnl
-dnl   You should have received a copy of the GNU General Public
-dnl   License along with GUILE; see the file COPYING.  If not, write
-dnl   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-dnl   Floor, Boston, MA 02110-1301 USA
-
-
-
-dnl   QTHREADS_CONFIGURE configures the QuickThreads package.  The QT
-dnl   sources should be in $srcdir/qt.  If configuration succeeds, this
-dnl   macro creates the appropriate symlinks in the qt object directory,
-dnl   and sets the following variables, used in building libqthreads.a:
-dnl      QTHREAD_LTLIBS --- set to libqthreads.la if configuration
-dnl         succeeds, or the empty string if configuration fails.
-dnl      qtmd_h, qtmds_s, qtmdc_c, qtdmdb_s --- the names of the machine-
-dnl         dependent source files.
-dnl      qthread_asflags --- flags to pass to the compiler when processing
-dnl         assembly-language files.
-dnl
-dnl   It also sets the following variables, which describe how clients
-dnl   can link against libqthreads.a:
-dnl      THREAD_PACKAGE --- set to "QT" if configuration succeeds, or
-dnl         the empty string if configuration fails.
-dnl	 THREAD_LIBS_LOCAL --- linker options for use in this source tree
-dnl	 THREAD_LIBS_INSTALLED --- linker options for use after this package
-dnl	    is installed
-dnl   It would be nice if all thread configuration packages for Guile
-dnl   followed the same conventions.
-dnl
-dnl   All of the above variables will be substituted into Makefiles in
-dnl   the usual autoconf fashion.
-dnl
-dnl   We distinguish between THREAD_LIBS_LOCAL and
-dnl   THREAD_LIBS_INSTALLED because the thread library might be in
-dnl   this tree, and be built using libtool.  This means that:
-dnl	 1) when building other executables in this tree, one must
-dnl	    pass the relative path to the ../libfoo.la file, but
-dnl	 2) once the whole package has been installed, users should
-dnl	    link using -lfoo.
-dnl   Normally, we only care about the first case, but since the
-dnl   guile-config script needs to give users all the flags they need
-dnl   to link programs against guile, the GUILE_WITH_THREADS macro
-dnl   needs to supply the second piece of information as well.
-dnl
-dnl   This whole thing is a little confused about what ought to be
-dnl   done in the top-level configure script, and what ought to be
-dnl   taken care of in the subdirectory.  For example, qtmds_s and
-dnl   friends really ought not to be even mentioned in the top-level
-dnl   configure script, but here they are.
-
-AC_DEFUN([QTHREADS_CONFIGURE],[
-  AC_REQUIRE([AC_PROG_LN_S])
-
-  AC_MSG_CHECKING(QuickThreads configuration)
-
-  changequote(,)dnl We use [ and ] in a regexp in the case
-
-  THREAD_PACKAGE=QT
-  qthread_asflags=''
-  case "$host" in
-    i[3456]86-*-*)
-      port_name=i386
-      qtmd_h=md/i386.h
-      qtmds_s=md/i386.s
-      qtmdc_c=md/null.c
-      qtdmdb_s=
-      case "$host" in
-        *-*-netbsd* )
-          ## NetBSD needs to be told to pass the assembly code through
-          ## the C preprocessor.  Other GCC installations seem to do
-          ## this by default, but NetBSD's doesn't.  We could get the
-          ## same effect by giving the file a name ending with .S
-          ## instead of .s, but I don't see how to tell automake to do
-          ## that.
-          qthread_asflags='-x assembler-with-cpp'
-        ;;
-      esac
-      ;;
-    mips-sgi-irix[56]*)
-      port_name=irix
-      qtmd_h=md/mips.h
-      qtmds_s=md/mips-irix5.s
-      qtmdc_c=md/null.c
-      qtdmdb_s=md/mips_b.s
-      ;;
-    mips-*-*)
-      port_name=mips
-      qtmd_h=md/mips.h
-      qtmds_s=md/mips.s
-      qtmdc_c=md/null.c
-      qtdmdb_s=md/mips_b.s
-      ;;
-    sparc-*-sunos*)
-      port_name=sparc-sunos
-      qtmd_h=md/sparc.h
-      qtmds_s=md/_sparc.s
-      qtmdc_c=md/null.c
-      qtdmdb_s=md/_sparc_b.s
-      ;;
-    sparc*-*-*)
-      port_name=sparc
-      qtmd_h=md/sparc.h
-      qtmds_s=md/sparc.s
-      qtmdc_c=md/null.c
-      qtdmdb_s=md/sparc_b.s
-      ;;
-    alpha*-*-*)
-      port_name=alpha
-      qtmd_h=md/axp.h
-      qtmds_s=md/axp.s
-      qtmdc_c=md/null.c
-      qtdmdb_s=md/axp_b.s
-      ;;
-    arm*-*-*)
-      port_name=arm
-      qtmd_h=md/arm.h
-      qtmds_s=md/arm.s
-      qtmdc_c=md/null.c
-      qtdmdb_s=
-      ;;
-    *)
-      echo "Unknown configuration; threads package disabled"
-      THREAD_PACKAGE=""
-      ;;
-  esac
-  changequote([, ])
-
-  # Did configuration succeed?
-  if test -n "$THREAD_PACKAGE"; then
-    AC_MSG_RESULT($port_name)
-    QTHREAD_LTLIBS=libqthreads.la
-    THREAD_LIBS_LOCAL="../qt/libqthreads.la"
-    THREAD_LIBS_INSTALLED="-lqthreads"
-  else
-    AC_MSG_RESULT(none; disabled)
-  fi
-
-  AC_SUBST(QTHREAD_LTLIBS)
-  AC_SUBST(qtmd_h)
-  AC_SUBST(qtmds_s)
-  AC_SUBST(qtmdc_c)
-  AC_SUBST(qtdmdb_s)
-  AC_SUBST(qthread_asflags)
-  AC_SUBST(THREAD_PACKAGE)
-  AC_SUBST(THREAD_LIBS_LOCAL)
-  AC_SUBST(THREAD_LIBS_INSTALLED)
-])
-
-dnl qthreads.m4 ends here

guile-readline/ChangeLog

@@ -1,3 +1,14 @@
+2008-05-07  Ludovic Courtès  <ludo@gnu.org>
+
+	* ice-9/Makefile.am (guile_pdd): Don't use `patsubst': it's GNU
+	Make and broke BSD Make as found on FreeBSD 6.2.
+
+2008-04-16  Ludovic Courtès  <ludo@gnu.org>
+
+	* configure.in (AC_INIT): Don't use "echo -n", which is not
+	available on MacOS X; use `patsubst' instead to remove the
+	newline.  Reported by Steven Wu <wus@qwest.net>.
+
 2008-02-16  Ludovic Courtès  <ludo@gnu.org>
 
 	* LIBGUILEREADLINE-VERSION

guile-readline/configure.in

@@ -1,7 +1,12 @@
 AC_PREREQ(2.50)
 
+dnl Don't use "echo -n", which is not portable (e.g., not available on
+dnl MacOS X).  Instead, use `patsubst' to remove the newline.
 AC_INIT(guile-readline,
-        m4_esyscmd(. ../GUILE-VERSION && echo -n ${GUILE_VERSION}))
+        patsubst(m4_esyscmd(. ../GUILE-VERSION && echo ${GUILE_VERSION}), [
+]),
+	[bug-guile@gnu.org])
+
 AC_CONFIG_AUX_DIR([.])
 AC_CONFIG_SRCDIR(readline.c)
 AM_CONFIG_HEADER([guile-readline-config.h])

guile-readline/ice-9/Makefile.am

@@ -1,7 +1,6 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
-##  	Copyright (C) 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -20,7 +19,9 @@
 ##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 ##   Floor, Boston, MA 02110-1301 USA
 
-guile_pdd = $(patsubst %/guile-readline,%/guile,$(pkgdatadir))
+# Guile's `pkgdatadir'.
+guile_pdd = $(datadir)/guile
+
 ice9dir = $(guile_pdd)/$(GUILE_EFFECTIVE_VERSION)/ice-9
 ice9_DATA = readline.scm
 ETAGS_ARGS = $(ice9_DATA)

ice-9/ChangeLog

@@ -1,3 +1,13 @@
+2008-07-17  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* gds-client.scm (handle-nondebug-protocol): Add support for
+	setting a trap on code that is about to be evaluated.
+
+2008-04-14  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* gds-client.scm (gds-debug-trap): Ensure that frame index passed
+	to Emacs is always positive.
+
 2008-03-19  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* debugging/ice-9-debugger-extensions.scm (command-loop): Use

ice-9/gds-client.scm

@@ -73,7 +73,9 @@
 					     (slot-ref (car fired-traps) 'depth)))))
                  ;; Write current stack to the frontend.
                  (write-form (list 'stack
-				   (or special-index 0)
+				   (if (and special-index (> special-index 0))
+				       special-index
+				       0)
                                    (stack->emacs-readable stack)
                                    (append (flags->emacs-readable flags)
                                            (slot-ref trap-context
@@ -352,7 +354,7 @@ Thanks!\n\n"
 
     ((eval)
      (set! last-lazy-trap-context #f)
-     (apply (lambda (correlator module port-name line column code)
+     (apply (lambda (correlator module port-name line column code flags)
               (with-input-from-string code
                 (lambda ()
                   (set-port-filename! (current-input-port) port-name)
@@ -382,6 +384,11 @@ Thanks!\n\n"
                               ;; it to the list.
 			      (begin
 				(for-each-breakpoint setup-after-read x)
+				(if (and (pair? x)
+					 (memq 'debug flags))
+				    (install-trap (make <source-trap>
+						    #:expression x
+						    #:behaviour gds-debug-trap)))
 				(loop (cons x exprs) (read))))))
                       (lambda (key . args)
                         (write-form `(eval-results

lang/elisp/ChangeLog

@@ -1,3 +1,12 @@
+2008-04-14  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* primitives/symprop.scm (get): Use lambda->nil.
+
+	* primitives/strings.scm (aset): New primitive.
+
+	* internals/load.scm (load): Use in-vicinity (instead of
+	string-append) to add a slash if needed.
+
 2004-02-08  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	* primitives/Makefile.am (TAGS_FILES), internals/Makefile.am

lang/elisp/internals/load.scm

@@ -15,9 +15,8 @@
 					 '("")
 					 load-path)))
 		      (cond ((null? dirs) #f)
-			    ((file-exists? (string-append (car dirs)
+			    ((file-exists? (in-vicinity (car dirs) filename))
-							  filename))
+			     (in-vicinity (car dirs) filename))
-			     (string-append (car dirs) filename))
 			    (else (loop (cdr dirs)))))))
       (if pathname
 	  (begin

lang/elisp/primitives/strings.scm

@@ -29,6 +29,12 @@
 	      ((string? array) (char->integer (string-ref array idx)))
 	      (else (wta 'arrayp array 1)))))
 
+(fset 'aset
+      (lambda (array idx newelt)
+	(cond ((vector? array) (vector-set! array idx newelt))
+	      ((string? array) (string-set! array idx (integer->char newelt)))
+	      (else (wta 'arrayp array 1)))))
+
 (fset 'stringp (lambda->nil string?))
 
 (fset 'vector vector)

lang/elisp/primitives/symprop.scm

@@ -9,7 +9,7 @@
 
 (fset 'put set-symbol-property!)
 
-(fset 'get symbol-property)
+(fset 'get (lambda->nil symbol-property))
 
 (fset 'set set)
 

lib/.gitignore

@@ -1,7 +0,0 @@
-Makefile.am
-alloca.c
-alloca.in.h
-dummy.c
-strcasecmp.c
-strings.in.h
-strncasecmp.c

lib/Makefile.am

@@ -0,0 +1,119 @@
+## DO NOT EDIT! GENERATED AUTOMATICALLY!
+## Process this file with automake to produce Makefile.in.
+# Copyright (C) 2002-2008 Free Software Foundation, Inc.
+#
+# This file is free software, distributed under the terms of the GNU
+# General Public License.  As a special exception to the GNU General
+# Public License, this file may be distributed as part of a program
+# that contains a configuration script generated by Autoconf, under
+# the same distribution terms as the rest of that program.
+#
+# Generated by gnulib-tool.
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl alloca extensions strcase
+
+AUTOMAKE_OPTIONS = 1.5 gnits
+
+noinst_HEADERS =
+noinst_LIBRARIES =
+noinst_LTLIBRARIES =
+EXTRA_DIST =
+BUILT_SOURCES =
+SUFFIXES =
+MOSTLYCLEANFILES = core *.stackdump
+MOSTLYCLEANDIRS =
+CLEANFILES =
+DISTCLEANFILES =
+MAINTAINERCLEANFILES =
+
+AM_CPPFLAGS =
+
+noinst_LTLIBRARIES += libgnu.la
+
+libgnu_la_SOURCES =
+libgnu_la_LIBADD = $(gl_LTLIBOBJS)
+libgnu_la_DEPENDENCIES = $(gl_LTLIBOBJS)
+EXTRA_libgnu_la_SOURCES =
+libgnu_la_LDFLAGS = $(AM_LDFLAGS)
+
+## begin gnulib module alloca
+
+
+EXTRA_DIST += alloca.c
+
+EXTRA_libgnu_la_SOURCES += alloca.c
+
+libgnu_la_LIBADD += @LTALLOCA@
+libgnu_la_DEPENDENCIES += @LTALLOCA@
+## end   gnulib module alloca
+
+## begin gnulib module alloca-opt
+
+BUILT_SOURCES += $(ALLOCA_H)
+
+# We need the following in order to create <alloca.h> when the system
+# doesn't have one that works with the given compiler.
+alloca.h: alloca.in.h
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+	  cat $(srcdir)/alloca.in.h; \
+	} > $@-t
+	mv -f $@-t $@
+MOSTLYCLEANFILES += alloca.h alloca.h-t
+
+EXTRA_DIST += alloca.in.h
+
+## end   gnulib module alloca-opt
+
+## begin gnulib module link-warning
+
+LINK_WARNING_H=$(top_srcdir)/build-aux/link-warning.h
+
+EXTRA_DIST += $(top_srcdir)/build-aux/link-warning.h
+
+## end   gnulib module link-warning
+
+## begin gnulib module strcase
+
+
+EXTRA_DIST += strcasecmp.c strncasecmp.c
+
+EXTRA_libgnu_la_SOURCES += strcasecmp.c strncasecmp.c
+
+## end   gnulib module strcase
+
+## begin gnulib module strings
+
+BUILT_SOURCES += strings.h
+
+# We need the following in order to create <strings.h> when the system
+# doesn't have one that works with the given compiler.
+strings.h: strings.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's/@''INCLUDE_NEXT''@/$(INCLUDE_NEXT)/g' \
+	      -e 's|@''NEXT_STRINGS_H''@|$(NEXT_STRINGS_H)|g' \
+	      -e 's|@''HAVE_STRCASECMP''@|$(HAVE_STRCASECMP)|g' \
+	      -e 's|@''HAVE_DECL_STRNCASECMP''@|$(HAVE_DECL_STRNCASECMP)|g' \
+	      -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \
+	      < $(srcdir)/strings.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += strings.h strings.h-t
+
+EXTRA_DIST += strings.in.h
+
+## end   gnulib module strings
+
+## begin gnulib module dummy
+
+libgnu_la_SOURCES += dummy.c
+
+## end   gnulib module dummy
+
+
+mostlyclean-local: mostlyclean-generic
+	@for dir in '' $(MOSTLYCLEANDIRS); do \
+	  if test -n "$$dir" && test -d $$dir; then \
+	    echo "rmdir $$dir"; rmdir $$dir; \
+	  fi; \
+	done; \
+	:

lib/alloca.c

@@ -0,0 +1,489 @@
+/* alloca.c -- allocate automatically reclaimed memory
+   (Mostly) portable public-domain implementation -- D A Gwyn
+
+   This implementation of the PWB library alloca function,
+   which is used to allocate space off the run-time stack so
+   that it is automatically reclaimed upon procedure exit,
+   was inspired by discussions with J. Q. Johnson of Cornell.
+   J.Otto Tennant <jot@cray.com> contributed the Cray support.
+
+   There are some preprocessor constants that can
+   be defined when compiling for your specific system, for
+   improved efficiency; however, the defaults should be okay.
+
+   The general concept of this implementation is to keep
+   track of all alloca-allocated blocks, and reclaim any
+   that are found to be deeper in the stack than the current
+   invocation.  This heuristic does not reclaim storage as
+   soon as it becomes invalid, but it will do so eventually.
+
+   As a special case, alloca(0) reclaims storage without
+   allocating any.  It is a good idea to use alloca(0) in
+   your main control loop, etc. to force garbage collection.  */
+
+#include <config.h>
+
+#include <alloca.h>
+
+#include <string.h>
+#include <stdlib.h>
+
+#ifdef emacs
+# include "lisp.h"
+# include "blockinput.h"
+# ifdef EMACS_FREE
+#  undef free
+#  define free EMACS_FREE
+# endif
+#else
+# define memory_full() abort ()
+#endif
+
+/* If compiling with GCC 2, this file's not needed.  */
+#if !defined (__GNUC__) || __GNUC__ < 2
+
+/* If someone has defined alloca as a macro,
+   there must be some other way alloca is supposed to work.  */
+# ifndef alloca
+
+#  ifdef emacs
+#   ifdef static
+/* actually, only want this if static is defined as ""
+   -- this is for usg, in which emacs must undefine static
+   in order to make unexec workable
+   */
+#    ifndef STACK_DIRECTION
+you
+lose
+-- must know STACK_DIRECTION at compile-time
+/* Using #error here is not wise since this file should work for
+   old and obscure compilers.  */
+#    endif /* STACK_DIRECTION undefined */
+#   endif /* static */
+#  endif /* emacs */
+
+/* If your stack is a linked list of frames, you have to
+   provide an "address metric" ADDRESS_FUNCTION macro.  */
+
+#  if defined (CRAY) && defined (CRAY_STACKSEG_END)
+long i00afunc ();
+#   define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
+#  else
+#   define ADDRESS_FUNCTION(arg) &(arg)
+#  endif
+
+/* Define STACK_DIRECTION if you know the direction of stack
+   growth for your system; otherwise it will be automatically
+   deduced at run-time.
+
+   STACK_DIRECTION > 0 => grows toward higher addresses
+   STACK_DIRECTION < 0 => grows toward lower addresses
+   STACK_DIRECTION = 0 => direction of growth unknown  */
+
+#  ifndef STACK_DIRECTION
+#   define STACK_DIRECTION	0	/* Direction unknown.  */
+#  endif
+
+#  if STACK_DIRECTION != 0
+
+#   define STACK_DIR	STACK_DIRECTION	/* Known at compile-time.  */
+
+#  else /* STACK_DIRECTION == 0; need run-time code.  */
+
+static int stack_dir;		/* 1 or -1 once known.  */
+#   define STACK_DIR	stack_dir
+
+static void
+find_stack_direction (void)
+{
+  static char *addr = NULL;	/* Address of first `dummy', once known.  */
+  auto char dummy;		/* To get stack address.  */
+
+  if (addr == NULL)
+    {				/* Initial entry.  */
+      addr = ADDRESS_FUNCTION (dummy);
+
+      find_stack_direction ();	/* Recurse once.  */
+    }
+  else
+    {
+      /* Second entry.  */
+      if (ADDRESS_FUNCTION (dummy) > addr)
+	stack_dir = 1;		/* Stack grew upward.  */
+      else
+	stack_dir = -1;		/* Stack grew downward.  */
+    }
+}
+
+#  endif /* STACK_DIRECTION == 0 */
+
+/* An "alloca header" is used to:
+   (a) chain together all alloca'ed blocks;
+   (b) keep track of stack depth.
+
+   It is very important that sizeof(header) agree with malloc
+   alignment chunk size.  The following default should work okay.  */
+
+#  ifndef	ALIGN_SIZE
+#   define ALIGN_SIZE	sizeof(double)
+#  endif
+
+typedef union hdr
+{
+  char align[ALIGN_SIZE];	/* To force sizeof(header).  */
+  struct
+    {
+      union hdr *next;		/* For chaining headers.  */
+      char *deep;		/* For stack depth measure.  */
+    } h;
+} header;
+
+static header *last_alloca_header = NULL;	/* -> last alloca header.  */
+
+/* Return a pointer to at least SIZE bytes of storage,
+   which will be automatically reclaimed upon exit from
+   the procedure that called alloca.  Originally, this space
+   was supposed to be taken from the current stack frame of the
+   caller, but that method cannot be made to work for some
+   implementations of C, for example under Gould's UTX/32.  */
+
+void *
+alloca (size_t size)
+{
+  auto char probe;		/* Probes stack depth: */
+  register char *depth = ADDRESS_FUNCTION (probe);
+
+#  if STACK_DIRECTION == 0
+  if (STACK_DIR == 0)		/* Unknown growth direction.  */
+    find_stack_direction ();
+#  endif
+
+  /* Reclaim garbage, defined as all alloca'd storage that
+     was allocated from deeper in the stack than currently.  */
+
+  {
+    register header *hp;	/* Traverses linked list.  */
+
+#  ifdef emacs
+    BLOCK_INPUT;
+#  endif
+
+    for (hp = last_alloca_header; hp != NULL;)
+      if ((STACK_DIR > 0 && hp->h.deep > depth)
+	  || (STACK_DIR < 0 && hp->h.deep < depth))
+	{
+	  register header *np = hp->h.next;
+
+	  free (hp);		/* Collect garbage.  */
+
+	  hp = np;		/* -> next header.  */
+	}
+      else
+	break;			/* Rest are not deeper.  */
+
+    last_alloca_header = hp;	/* -> last valid storage.  */
+
+#  ifdef emacs
+    UNBLOCK_INPUT;
+#  endif
+  }
+
+  if (size == 0)
+    return NULL;		/* No allocation required.  */
+
+  /* Allocate combined header + user data storage.  */
+
+  {
+    /* Address of header.  */
+    register header *new;
+
+    size_t combined_size = sizeof (header) + size;
+    if (combined_size < sizeof (header))
+      memory_full ();
+
+    new = malloc (combined_size);
+
+    if (! new)
+      memory_full ();
+
+    new->h.next = last_alloca_header;
+    new->h.deep = depth;
+
+    last_alloca_header = new;
+
+    /* User storage begins just after header.  */
+
+    return (void *) (new + 1);
+  }
+}
+
+#  if defined (CRAY) && defined (CRAY_STACKSEG_END)
+
+#   ifdef DEBUG_I00AFUNC
+#    include <stdio.h>
+#   endif
+
+#   ifndef CRAY_STACK
+#    define CRAY_STACK
+#    ifndef CRAY2
+/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
+struct stack_control_header
+  {
+    long shgrow:32;		/* Number of times stack has grown.  */
+    long shaseg:32;		/* Size of increments to stack.  */
+    long shhwm:32;		/* High water mark of stack.  */
+    long shsize:32;		/* Current size of stack (all segments).  */
+  };
+
+/* The stack segment linkage control information occurs at
+   the high-address end of a stack segment.  (The stack
+   grows from low addresses to high addresses.)  The initial
+   part of the stack segment linkage control information is
+   0200 (octal) words.  This provides for register storage
+   for the routine which overflows the stack.  */
+
+struct stack_segment_linkage
+  {
+    long ss[0200];		/* 0200 overflow words.  */
+    long sssize:32;		/* Number of words in this segment.  */
+    long ssbase:32;		/* Offset to stack base.  */
+    long:32;
+    long sspseg:32;		/* Offset to linkage control of previous
+				   segment of stack.  */
+    long:32;
+    long sstcpt:32;		/* Pointer to task common address block.  */
+    long sscsnm;		/* Private control structure number for
+				   microtasking.  */
+    long ssusr1;		/* Reserved for user.  */
+    long ssusr2;		/* Reserved for user.  */
+    long sstpid;		/* Process ID for pid based multi-tasking.  */
+    long ssgvup;		/* Pointer to multitasking thread giveup.  */
+    long sscray[7];		/* Reserved for Cray Research.  */
+    long ssa0;
+    long ssa1;
+    long ssa2;
+    long ssa3;
+    long ssa4;
+    long ssa5;
+    long ssa6;
+    long ssa7;
+    long sss0;
+    long sss1;
+    long sss2;
+    long sss3;
+    long sss4;
+    long sss5;
+    long sss6;
+    long sss7;
+  };
+
+#    else /* CRAY2 */
+/* The following structure defines the vector of words
+   returned by the STKSTAT library routine.  */
+struct stk_stat
+  {
+    long now;			/* Current total stack size.  */
+    long maxc;			/* Amount of contiguous space which would
+				   be required to satisfy the maximum
+				   stack demand to date.  */
+    long high_water;		/* Stack high-water mark.  */
+    long overflows;		/* Number of stack overflow ($STKOFEN) calls.  */
+    long hits;			/* Number of internal buffer hits.  */
+    long extends;		/* Number of block extensions.  */
+    long stko_mallocs;		/* Block allocations by $STKOFEN.  */
+    long underflows;		/* Number of stack underflow calls ($STKRETN).  */
+    long stko_free;		/* Number of deallocations by $STKRETN.  */
+    long stkm_free;		/* Number of deallocations by $STKMRET.  */
+    long segments;		/* Current number of stack segments.  */
+    long maxs;			/* Maximum number of stack segments so far.  */
+    long pad_size;		/* Stack pad size.  */
+    long current_address;	/* Current stack segment address.  */
+    long current_size;		/* Current stack segment size.  This
+				   number is actually corrupted by STKSTAT to
+				   include the fifteen word trailer area.  */
+    long initial_address;	/* Address of initial segment.  */
+    long initial_size;		/* Size of initial segment.  */
+  };
+
+/* The following structure describes the data structure which trails
+   any stack segment.  I think that the description in 'asdef' is
+   out of date.  I only describe the parts that I am sure about.  */
+
+struct stk_trailer
+  {
+    long this_address;		/* Address of this block.  */
+    long this_size;		/* Size of this block (does not include
+				   this trailer).  */
+    long unknown2;
+    long unknown3;
+    long link;			/* Address of trailer block of previous
+				   segment.  */
+    long unknown5;
+    long unknown6;
+    long unknown7;
+    long unknown8;
+    long unknown9;
+    long unknown10;
+    long unknown11;
+    long unknown12;
+    long unknown13;
+    long unknown14;
+  };
+
+#    endif /* CRAY2 */
+#   endif /* not CRAY_STACK */
+
+#   ifdef CRAY2
+/* Determine a "stack measure" for an arbitrary ADDRESS.
+   I doubt that "lint" will like this much.  */
+
+static long
+i00afunc (long *address)
+{
+  struct stk_stat status;
+  struct stk_trailer *trailer;
+  long *block, size;
+  long result = 0;
+
+  /* We want to iterate through all of the segments.  The first
+     step is to get the stack status structure.  We could do this
+     more quickly and more directly, perhaps, by referencing the
+     $LM00 common block, but I know that this works.  */
+
+  STKSTAT (&status);
+
+  /* Set up the iteration.  */
+
+  trailer = (struct stk_trailer *) (status.current_address
+				    + status.current_size
+				    - 15);
+
+  /* There must be at least one stack segment.  Therefore it is
+     a fatal error if "trailer" is null.  */
+
+  if (trailer == 0)
+    abort ();
+
+  /* Discard segments that do not contain our argument address.  */
+
+  while (trailer != 0)
+    {
+      block = (long *) trailer->this_address;
+      size = trailer->this_size;
+      if (block == 0 || size == 0)
+	abort ();
+      trailer = (struct stk_trailer *) trailer->link;
+      if ((block <= address) && (address < (block + size)))
+	break;
+    }
+
+  /* Set the result to the offset in this segment and add the sizes
+     of all predecessor segments.  */
+
+  result = address - block;
+
+  if (trailer == 0)
+    {
+      return result;
+    }
+
+  do
+    {
+      if (trailer->this_size <= 0)
+	abort ();
+      result += trailer->this_size;
+      trailer = (struct stk_trailer *) trailer->link;
+    }
+  while (trailer != 0);
+
+  /* We are done.  Note that if you present a bogus address (one
+     not in any segment), you will get a different number back, formed
+     from subtracting the address of the first block.  This is probably
+     not what you want.  */
+
+  return (result);
+}
+
+#   else /* not CRAY2 */
+/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
+   Determine the number of the cell within the stack,
+   given the address of the cell.  The purpose of this
+   routine is to linearize, in some sense, stack addresses
+   for alloca.  */
+
+static long
+i00afunc (long address)
+{
+  long stkl = 0;
+
+  long size, pseg, this_segment, stack;
+  long result = 0;
+
+  struct stack_segment_linkage *ssptr;
+
+  /* Register B67 contains the address of the end of the
+     current stack segment.  If you (as a subprogram) store
+     your registers on the stack and find that you are past
+     the contents of B67, you have overflowed the segment.
+
+     B67 also points to the stack segment linkage control
+     area, which is what we are really interested in.  */
+
+  stkl = CRAY_STACKSEG_END ();
+  ssptr = (struct stack_segment_linkage *) stkl;
+
+  /* If one subtracts 'size' from the end of the segment,
+     one has the address of the first word of the segment.
+
+     If this is not the first segment, 'pseg' will be
+     nonzero.  */
+
+  pseg = ssptr->sspseg;
+  size = ssptr->sssize;
+
+  this_segment = stkl - size;
+
+  /* It is possible that calling this routine itself caused
+     a stack overflow.  Discard stack segments which do not
+     contain the target address.  */
+
+  while (!(this_segment <= address && address <= stkl))
+    {
+#    ifdef DEBUG_I00AFUNC
+      fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
+#    endif
+      if (pseg == 0)
+	break;
+      stkl = stkl - pseg;
+      ssptr = (struct stack_segment_linkage *) stkl;
+      size = ssptr->sssize;
+      pseg = ssptr->sspseg;
+      this_segment = stkl - size;
+    }
+
+  result = address - this_segment;
+
+  /* If you subtract pseg from the current end of the stack,
+     you get the address of the previous stack segment's end.
+     This seems a little convoluted to me, but I'll bet you save
+     a cycle somewhere.  */
+
+  while (pseg != 0)
+    {
+#    ifdef DEBUG_I00AFUNC
+      fprintf (stderr, "%011o %011o\n", pseg, size);
+#    endif
+      stkl = stkl - pseg;
+      ssptr = (struct stack_segment_linkage *) stkl;
+      size = ssptr->sssize;
+      pseg = ssptr->sspseg;
+      result += size;
+    }
+  return (result);
+}
+
+#   endif /* not CRAY2 */
+#  endif /* CRAY */
+
+# endif /* no alloca */
+#endif /* not GCC version 2 */

lib/alloca.in.h

@@ -0,0 +1,56 @@
+/* Memory allocation on the stack.
+
+   Copyright (C) 1995, 1999, 2001-2004, 2006-2008 Free Software
+   Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 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 Lesser General Public
+   License along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+   USA.  */
+
+/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H
+   means there is a real alloca function.  */
+#ifndef _GL_ALLOCA_H
+#define _GL_ALLOCA_H
+
+/* alloca (N) returns a pointer to N bytes of memory
+   allocated on the stack, which will last until the function returns.
+   Use of alloca should be avoided:
+     - inside arguments of function calls - undefined behaviour,
+     - in inline functions - the allocation may actually last until the
+       calling function returns,
+     - for huge N (say, N >= 65536) - you never know how large (or small)
+       the stack is, and when the stack cannot fulfill the memory allocation
+       request, the program just crashes.
+ */
+
+#ifndef alloca
+# ifdef __GNUC__
+#  define alloca __builtin_alloca
+# elif defined _AIX
+#  define alloca __alloca
+# elif defined _MSC_VER
+#  include <malloc.h>
+#  define alloca _alloca
+# elif defined __DECC && defined __VMS
+#  define alloca __ALLOCA
+# else
+#  include <stddef.h>
+#  ifdef  __cplusplus
+extern "C"
+#  endif
+void *alloca (size_t);
+# endif
+#endif
+
+#endif /* _GL_ALLOCA_H */

lib/dummy.c

@@ -0,0 +1,42 @@
+/* A dummy file, to prevent empty libraries from breaking builds.
+   Copyright (C) 2004, 2007 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* Some systems, reportedly OpenBSD and Mac OS X, refuse to create
+   libraries without any object files.  You might get an error like:
+
+   > ar cru .libs/libgl.a
+   > ar: no archive members specified
+
+   Compiling this file, and adding its object file to the library, will
+   prevent the library from being empty.  */
+
+/* Some systems, such as Solaris with cc 5.0, refuse to work with libraries
+   that don't export any symbol.  You might get an error like:
+
+   > cc ... libgnu.a
+   > ild: (bad file) garbled symbol table in archive ../gllib/libgnu.a
+
+   Compiling this file, and adding its object file to the library, will
+   prevent the library from exporting no symbols.  */
+
+#ifdef __sun
+/* This declaration ensures that the library will export at least 1 symbol.  */
+int gl_dummy_symbol;
+#else
+/* This declaration is solely to ensure that after preprocessing
+   this file is never empty.  */
+typedef int dummy;
+#endif

lib/strcasecmp.c

@@ -0,0 +1,63 @@
+/* Case-insensitive string comparison function.
+   Copyright (C) 1998-1999, 2005-2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 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 Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <string.h>
+
+#include <ctype.h>
+#include <limits.h>
+
+#define TOLOWER(Ch) (isupper (Ch) ? tolower (Ch) : (Ch))
+
+/* Compare strings S1 and S2, ignoring case, returning less than, equal to or
+   greater than zero if S1 is lexicographically less than, equal to or greater
+   than S2.
+   Note: This function does not work with multibyte strings!  */
+
+int
+strcasecmp (const char *s1, const char *s2)
+{
+  const unsigned char *p1 = (const unsigned char *) s1;
+  const unsigned char *p2 = (const unsigned char *) s2;
+  unsigned char c1, c2;
+
+  if (p1 == p2)
+    return 0;
+
+  do
+    {
+      c1 = TOLOWER (*p1);
+      c2 = TOLOWER (*p2);
+
+      if (c1 == '\0')
+	break;
+
+      ++p1;
+      ++p2;
+    }
+  while (c1 == c2);
+
+  if (UCHAR_MAX <= INT_MAX)
+    return c1 - c2;
+  else
+    /* On machines where 'char' and 'int' are types of the same size, the
+       difference of two 'unsigned char' values - including the sign bit -
+       doesn't fit in an 'int'.  */
+    return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}

lib/strings.in.h

@@ -0,0 +1,86 @@
+/* A substitute <strings.h>.
+
+   Copyright (C) 2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 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 Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _GL_STRINGS_H
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_STRINGS_H@
+
+#ifndef _GL_STRINGS_H
+#define _GL_STRINGS_H
+
+
+/* The definition of GL_LINK_WARNING is copied here.  */
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Compare strings S1 and S2, ignoring case, returning less than, equal to or
+   greater than zero if S1 is lexicographically less than, equal to or greater
+   than S2.
+   Note: This function does not work in multibyte locales.  */
+#if ! @HAVE_STRCASECMP@
+extern int strcasecmp (char const *s1, char const *s2);
+#endif
+#if defined GNULIB_POSIXCHECK
+/* strcasecmp() does not work with multibyte strings:
+   POSIX says that it operates on "strings", and "string" in POSIX is defined
+   as a sequence of bytes, not of characters.   */
+# undef strcasecmp
+# define strcasecmp(a,b) \
+    (GL_LINK_WARNING ("strcasecmp cannot work correctly on character strings " \
+                      "in multibyte locales - " \
+                      "use mbscasecmp if you care about " \
+                      "internationalization, or use c_strcasecmp (from " \
+                      "gnulib module c-strcase) if you want a locale " \
+                      "independent function"), \
+     strcasecmp (a, b))
+#endif
+
+/* Compare no more than N bytes of strings S1 and S2, ignoring case,
+   returning less than, equal to or greater than zero if S1 is
+   lexicographically less than, equal to or greater than S2.
+   Note: This function cannot work correctly in multibyte locales.  */
+#if ! @HAVE_DECL_STRNCASECMP@
+extern int strncasecmp (char const *s1, char const *s2, size_t n);
+#endif
+#if defined GNULIB_POSIXCHECK
+/* strncasecmp() does not work with multibyte strings:
+   POSIX says that it operates on "strings", and "string" in POSIX is defined
+   as a sequence of bytes, not of characters.  */
+# undef strncasecmp
+# define strncasecmp(a,b,n) \
+    (GL_LINK_WARNING ("strncasecmp cannot work correctly on character " \
+                      "strings in multibyte locales - " \
+                      "use mbsncasecmp or mbspcasecmp if you care about " \
+                      "internationalization, or use c_strncasecmp (from " \
+                      "gnulib module c-strcase) if you want a locale " \
+                      "independent function"), \
+     strncasecmp (a, b, n))
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GL_STRING_H */
+#endif /* _GL_STRING_H */

lib/strncasecmp.c

@@ -0,0 +1,63 @@
+/* strncasecmp.c -- case insensitive string comparator
+   Copyright (C) 1998-1999, 2005-2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 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 Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <string.h>
+
+#include <ctype.h>
+#include <limits.h>
+
+#define TOLOWER(Ch) (isupper (Ch) ? tolower (Ch) : (Ch))
+
+/* Compare no more than N bytes of strings S1 and S2, ignoring case,
+   returning less than, equal to or greater than zero if S1 is
+   lexicographically less than, equal to or greater than S2.
+   Note: This function cannot work correctly in multibyte locales.  */
+
+int
+strncasecmp (const char *s1, const char *s2, size_t n)
+{
+  register const unsigned char *p1 = (const unsigned char *) s1;
+  register const unsigned char *p2 = (const unsigned char *) s2;
+  unsigned char c1, c2;
+
+  if (p1 == p2 || n == 0)
+    return 0;
+
+  do
+    {
+      c1 = TOLOWER (*p1);
+      c2 = TOLOWER (*p2);
+
+      if (--n == 0 || c1 == '\0')
+	break;
+
+      ++p1;
+      ++p2;
+    }
+  while (c1 == c2);
+
+  if (UCHAR_MAX <= INT_MAX)
+    return c1 - c2;
+  else
+    /* On machines where 'char' and 'int' are types of the same size, the
+       difference of two 'unsigned char' values - including the sign bit -
+       doesn't fit in an 'int'.  */
+    return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}

libguile/Makefile.am

@@ -1,6 +1,6 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -23,11 +23,19 @@ AUTOMAKE_OPTIONS = gnu
 
 ## Prevent automake from adding extra -I options
 DEFS = @DEFS@
+
+# Override Automake's `DEFAULT_INCLUDES'.  By default, it contains
+# "-I$(srcdir)", which causes problems on Tru64 where our "random.h"
+# is picked up by <stdlib.h> instead of the libc's <random.h>.
+DEFAULT_INCLUDES =
+
 ## Check for headers in $(srcdir)/.., so that #include
 ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're
 ## building.  Also look for Gnulib headers in `lib'.
-INCLUDES = -I.. -I$(top_srcdir)				\
+AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir)		\
-	   -I$(top_srcdir)/lib -I$(top_builddir)/lib
+	      -I$(top_srcdir)/lib -I$(top_builddir)/lib
+
+AM_CFLAGS = $(GCC_CFLAGS)
 
 ## The Gnulib Libtool archive.
 gnulib_library = $(top_builddir)/lib/libgnu.la
@@ -47,7 +55,7 @@ gen_scmconfig_SOURCES = gen-scmconfig.c
 ## For some reason, OBJEXT does not include the dot
 gen-scmconfig.$(OBJEXT): gen-scmconfig.c
 	if [ "$(cross_compiling)" = "yes" ]; then \
-		$(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) -c -o $@ $<; \
+		$(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(AM_CPPFLAGS) -c -o $@ $<; \
 	else \
 		$(COMPILE) -c -o $@ $<; \
 	fi
@@ -75,7 +83,7 @@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c
 ## For some reason, OBJEXT does not include the dot
 c-tokenize.$(OBJEXT): c-tokenize.c
 	if [ "$(cross_compiling)" = "yes" ]; then \
-		$(CC_FOR_BUILD) $(DEFS) $(INCLUDES) -c -o $@ $<; \
+		$(CC_FOR_BUILD) $(DEFS) $(AM_CPPFLAGS) -c -o $@ $<; \
 	else \
 		$(filter-out -Werror,$(COMPILE)) -c -o $@ $<; \
 	fi
@@ -91,18 +99,18 @@ guile_filter_doc_snarfage$(EXEEXT): $(guile_filter_doc_snarfage_OBJECTS) $(guile
 
 
 guile_SOURCES = guile.c
-guile_CFLAGS = $(GUILE_CFLAGS)
+guile_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
 guile_LDADD = libguile.la
 guile_LDFLAGS = @DLPREOPEN@ $(GUILE_CFLAGS)
 
-libguile_la_CFLAGS = $(GUILE_CFLAGS)
+libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
 
 libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
     chars.c continuations.c convert.c debug.c deprecation.c		\
     deprecated.c discouraged.c dynwind.c eq.c error.c	\
     eval.c evalext.c extensions.c feature.c fluids.c fports.c		\
     futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c		\
-    gc-freelist.c gc_os_dep.c gdbint.c gettext.c			\
+    gc-freelist.c gc_os_dep.c gdbint.c gettext.c gc-segment-table.c     \
     gh_data.c gh_eval.c gh_funcs.c					\
     gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c		\
     guardians.c hash.c hashtab.c hooks.c init.c inline.c		\
@@ -132,7 +140,7 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	\
     dynl.x dynwind.x eq.x error.x eval.x evalext.x	\
     extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x	\
     gc-segment.x gc-malloc.x gc-card.x gettext.x goops.x		\
-    gsubr.x guardians.x							\
+    gsubr.x guardians.x gc-segment-table.x                              \
     hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x	\
     list.x load.x macros.x mallocs.x modules.x numbers.x objects.x	\
     objprop.x options.x pairs.x ports.x print.x procprop.x procs.x	\
@@ -152,8 +160,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc		\
     deprecated.doc discouraged.doc dynl.doc dynwind.doc			\
     eq.doc error.doc eval.doc evalext.doc		\
     extensions.doc feature.doc fluids.doc fports.doc futures.doc	\
-    gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc		\
+    gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \
-    gc-malloc.doc gc-card.doc gettext.doc				\
+    gc-malloc.doc gc-card.doc gettext.doc gc-segment-table.doc          \
     guardians.doc hash.doc hashtab.doc					\
     hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc		\
     list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc	\
@@ -301,7 +309,7 @@ libpath.h: $(srcdir)/Makefile.in  $(top_builddir)/config.status
 	@mv libpath.tmp libpath.h
 
 
-snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)
 
 SUFFIXES = .x .doc
 .c.x:
@@ -351,7 +359,7 @@ schemelibdir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)
 schemelib_DATA = guile-procedures.txt
 
 ## Add -MG to make the .x magic work with auto-dep code.
-MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+MKDEP = gcc -M -MG $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)
 
 cpp_err_symbols.c: cpp_err_symbols.in cpp_cnvt.awk
 	$(AWK) -f $(srcdir)/cpp_cnvt.awk < $(srcdir)/cpp_err_symbols.in > \

libguile/__scm.h

@@ -97,6 +97,15 @@
 #define SCM_LIKELY(_expr)    SCM_EXPECT ((_expr), 1)
 #define SCM_UNLIKELY(_expr)  SCM_EXPECT ((_expr), 0)
 
+/* The SCM_INTERNAL macro makes it possible to explicitly declare a function
+ * as having "internal" linkage.  */
+#if (defined __GNUC__) && \
+  ((__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ == 3))
+# define SCM_INTERNAL  extern __attribute__ ((__visibility__ ("internal")))
+#else
+# define SCM_INTERNAL  extern
+#endif
+
 
 
 /* {Supported Options}
@@ -402,7 +411,23 @@
 #  define setjmp setjump
 #  define longjmp longjump
 # else				/* ndef _CRAY1 */
-#  include <setjmp.h>
+#  if defined (__ia64__)
+/* For IA64, emulate the setjmp API using getcontext. */
+#   include <signal.h>
+#   include <ucontext.h>
+    typedef struct {
+      ucontext_t ctx;
+      int fresh;
+    } jmp_buf;
+#   define setjmp(JB)				        \
+      ( (JB).fresh = 1,				        \
+        getcontext (&((JB).ctx)),			\
+        ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
+#   define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
+    void scm_ia64_longjmp (jmp_buf *, int);
+#  else                 	/* ndef __ia64__ */
+#   include <setjmp.h>
+#  endif			/* ndef __ia64__ */
 # endif				/* ndef _CRAY1 */
 #endif				/* ndef vms */
 

libguile/_scm.h

@@ -113,7 +113,11 @@
 #endif
 
 /* These names are a bit long, but they make it clear what they represent. */
-#define dirent_or_dirent64              CHOOSE_LARGEFILE(dirent,dirent64)
+#if SCM_HAVE_STRUCT_DIRENT64 == 1
+# define dirent_or_dirent64             CHOOSE_LARGEFILE(dirent,dirent64)
+#else
+# define dirent_or_dirent64             dirent
+#endif
 #define fstat_or_fstat64                CHOOSE_LARGEFILE(fstat,fstat64)
 #define ftruncate_or_ftruncate64        CHOOSE_LARGEFILE(ftruncate,ftruncate64)
 #define lseek_or_lseek64                CHOOSE_LARGEFILE(lseek,lseek64)
@@ -121,7 +125,11 @@
 #define off_t_or_off64_t                CHOOSE_LARGEFILE(off_t,off64_t)
 #define open_or_open64                  CHOOSE_LARGEFILE(open,open64)
 #define readdir_or_readdir64            CHOOSE_LARGEFILE(readdir,readdir64)
-#define readdir_r_or_readdir64_r        CHOOSE_LARGEFILE(readdir_r,readdir64_r)
+#if SCM_HAVE_READDIR64_R == 1
+# define readdir_r_or_readdir64_r       CHOOSE_LARGEFILE(readdir_r,readdir64_r)
+#else
+# define readdir_r_or_readdir64_r       readdir_r
+#endif
 #define stat_or_stat64                  CHOOSE_LARGEFILE(stat,stat64)
 #define truncate_or_truncate64          CHOOSE_LARGEFILE(truncate,truncate64)
 #define scm_from_off_t_or_off64_t       CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)

libguile/alist.h

@@ -3,7 +3,7 @@
 #ifndef SCM_ALIST_H
 #define SCM_ALIST_H
 
-/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -42,7 +42,7 @@ SCM_API SCM scm_assoc_set_x (SCM alist, SCM key, SCM val);
 SCM_API SCM scm_assq_remove_x (SCM alist, SCM key);
 SCM_API SCM scm_assv_remove_x (SCM alist, SCM key);
 SCM_API SCM scm_assoc_remove_x (SCM alist, SCM key);
-SCM_API void scm_init_alist (void);
+SCM_INTERNAL void scm_init_alist (void);
 
 #endif  /* SCM_ALIST_H */
 

libguile/arbiters.h

@@ -3,7 +3,7 @@
 #ifndef SCM_ARBITERS_H
 #define SCM_ARBITERS_H
 
-/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -29,7 +29,7 @@
 SCM_API SCM scm_make_arbiter (SCM name);
 SCM_API SCM scm_try_arbiter (SCM arb);
 SCM_API SCM scm_release_arbiter (SCM arb);
-SCM_API void scm_init_arbiters (void);
+SCM_INTERNAL void scm_init_arbiters (void);
 
 #endif  /* SCM_ARBITERS_H */
 

libguile/async.h

@@ -3,7 +3,7 @@
 #ifndef SCM_ASYNC_H
 #define SCM_ASYNC_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -38,10 +38,11 @@ SCM_API SCM scm_async (SCM thunk);
 SCM_API SCM scm_async_mark (SCM a);
 SCM_API SCM scm_system_async_mark (SCM a);
 SCM_API SCM scm_system_async_mark_for_thread (SCM a, SCM thread);
-SCM_API void scm_i_queue_async_cell (SCM cell, scm_i_thread *);
+SCM_INTERNAL void scm_i_queue_async_cell (SCM cell, scm_i_thread *);
-SCM_API int scm_i_setup_sleep (scm_i_thread *,
+SCM_INTERNAL int scm_i_setup_sleep (scm_i_thread *,
-			       SCM obj, scm_i_pthread_mutex_t *m, int fd);
+				    SCM obj, scm_i_pthread_mutex_t *m,
-SCM_API void scm_i_reset_sleep (scm_i_thread *);
+				    int fd);
+SCM_INTERNAL void scm_i_reset_sleep (scm_i_thread *);
 SCM_API SCM scm_run_asyncs (SCM list_of_a);
 SCM_API SCM scm_noop (SCM args);
 SCM_API SCM scm_call_with_blocked_asyncs (SCM proc);
@@ -77,7 +78,7 @@ extern int scm_i_critical_section_level;
     scm_async_click ();	\
   } while (0)
 
-SCM_API void scm_init_async (void);
+SCM_INTERNAL void scm_init_async (void);
 
 #if (SCM_ENABLE_DEPRECATED == 1)
 

libguile/backtrace.h

@@ -3,7 +3,7 @@
 #ifndef SCM_BACKTRACE_H
 #define SCM_BACKTRACE_H
 
-/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -27,7 +27,8 @@
 SCM_API SCM scm_the_last_stack_fluid_var;
 
 SCM_API void scm_display_error_message (SCM message, SCM args, SCM port);
-SCM_API void scm_i_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest);
+SCM_INTERNAL void scm_i_display_error (SCM stack, SCM port, SCM subr,
+				       SCM message, SCM args, SCM rest);
 SCM_API SCM scm_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest);
 SCM_API SCM scm_display_application (SCM frame, SCM port, SCM indent);
 SCM_API SCM scm_display_backtrace (SCM stack, SCM port, SCM first, SCM depth);
@@ -38,7 +39,7 @@ SCM_API SCM scm_backtrace_with_highlights (SCM highlights);
 SCM_API SCM scm_set_print_params_x (SCM params);
 #endif
 
-SCM_API void scm_init_backtrace (void);
+SCM_INTERNAL void scm_init_backtrace (void);
 
 #endif  /* SCM_BACKTRACE_H */
 

libguile/boolean.h

@@ -3,7 +3,7 @@
 #ifndef SCM_BOOLEAN_H
 #define SCM_BOOLEAN_H
 
-/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -43,7 +43,7 @@ SCM_API int scm_to_bool (SCM x);
 SCM_API SCM scm_not (SCM x);
 SCM_API SCM scm_boolean_p (SCM obj);
 
-SCM_API void scm_init_boolean (void);
+SCM_INTERNAL void scm_init_boolean (void);
 
 #endif  /* SCM_BOOLEAN_H */
 

libguile/c-tokenize.lex

@@ -18,7 +18,12 @@ INTQUAL		(l|L|ll|LL|lL|Ll|u|U)
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
-  
+
+/* Prevent compilation of static input() function in generated scanner
+   code.  This function is never actually used, and GCC 4.3 will emit
+   an error for that. */
+#define YY_NO_INPUT
+
 int yylex(void);
 
 int yyget_lineno (void);

libguile/chars.h

@@ -3,7 +3,7 @@
 #ifndef SCM_CHARS_H
 #define SCM_CHARS_H
 
-/* Copyright (C) 1995,1996,2000,2001,2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001,2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -62,7 +62,7 @@ SCM_API SCM scm_char_upcase (SCM chr);
 SCM_API SCM scm_char_downcase (SCM chr);
 SCM_API int scm_c_upcase (unsigned int c);
 SCM_API int scm_c_downcase (unsigned int c);
-SCM_API void scm_init_chars (void);
+SCM_INTERNAL void scm_init_chars (void);
 
 #endif  /* SCM_CHARS_H */
 

libguile/continuations.c

@@ -124,47 +124,30 @@ scm_make_continuation (int *first)
   continuation->offset = continuation->stack - src;
   memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
 
-#ifdef __ia64__
+  *first = !setjmp (continuation->jmpbuf);
-  continuation->fresh = 1;
+  if (*first)
-  getcontext (&continuation->ctx);
-  if (continuation->fresh)
     {
+#ifdef __ia64__
       continuation->backing_store_size =
-	(char *) scm_ia64_ar_bsp(&continuation->ctx)
+	(char *) scm_ia64_ar_bsp(&continuation->jmpbuf.ctx)
 	-
-	(char *) scm_ia64_register_backing_store_base ();
+	(char *) thread->register_backing_store_base;
       continuation->backing_store = NULL;
       continuation->backing_store = 
         scm_gc_malloc (continuation->backing_store_size,
 		       "continuation backing store");
       memcpy (continuation->backing_store, 
-              (void *) scm_ia64_register_backing_store_base (), 
+              (void *) thread->register_backing_store_base, 
               continuation->backing_store_size);
-      *first = 1;
+#endif /* __ia64__ */
-      continuation->fresh = 0;
       return cont;
     }
   else
     {
       SCM ret = continuation->throw_value;
-      *first = 0;
       continuation->throw_value = SCM_BOOL_F;
       return ret;
     }
-#else /* !__ia64__ */
-  if (setjmp (continuation->jmpbuf))
-    {
-      SCM ret = continuation->throw_value;
-      *first = 0;
-      continuation->throw_value = SCM_BOOL_F;
-      return ret;
-    }
-  else
-    {
-      *first = 1;
-      return cont;
-    }
-#endif /* !__ia64__ */
 }
 #undef FUNC_NAME
 
@@ -218,6 +201,9 @@ copy_stack (void *data)
   copy_stack_data *d = (copy_stack_data *)data;
   memcpy (d->dst, d->continuation->stack,
 	  sizeof (SCM_STACKITEM) * d->continuation->num_stack_items);
+#ifdef __ia64__
+  SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation;
+#endif
 }
 
 static void
@@ -235,16 +221,26 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
   scm_i_set_last_debug_frame (continuation->dframe);
 
   continuation->throw_value = val;
-#ifdef __ia64__
-  memcpy (scm_ia64_register_backing_store_base (),
-          continuation->backing_store,
-          continuation->backing_store_size);
-  setcontext (&continuation->ctx);
-#else
   longjmp (continuation->jmpbuf, 1);
-#endif
 }
 
+#ifdef __ia64__
+void
+scm_ia64_longjmp (jmp_buf *JB, int VAL)
+{
+  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+
+  if (t->pending_rbs_continuation)
+    {
+      memcpy (t->register_backing_store_base,
+	      t->pending_rbs_continuation->backing_store,
+	      t->pending_rbs_continuation->backing_store_size);
+      t->pending_rbs_continuation = NULL;
+    }
+  setcontext (&JB->ctx);
+}
+#endif
+
 /* Call grow_stack until the stack space is large enough, then, as the current
  * stack frame might get overwritten, let copy_stack_and_call perform the
  * actual copying and continuation calling.

libguile/continuations.h

@@ -3,7 +3,7 @@
 #ifndef SCM_CONTINUATIONS_H
 #define SCM_CONTINUATIONS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -46,8 +46,6 @@ typedef struct
   jmp_buf jmpbuf;
   SCM dynenv;
 #ifdef __ia64__
-  ucontext_t ctx;
-  int fresh;
   void *backing_store;
   unsigned long backing_store_size;
 #endif /* __ia64__ */
@@ -92,14 +90,15 @@ SCM_API SCM scm_make_continuation (int *first);
 SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *);
 SCM_API SCM scm_with_continuation_barrier (SCM proc);
 
-SCM_API SCM scm_i_with_continuation_barrier (scm_t_catch_body body,
+SCM_INTERNAL SCM
-					     void *body_data,
+scm_i_with_continuation_barrier (scm_t_catch_body body,
-					     scm_t_catch_handler handler,
+				 void *body_data,
-					     void *handler_data,
+				 scm_t_catch_handler handler,
-					     scm_t_catch_handler pre_unwind_handler,
+				 void *handler_data,
-					     void *pre_unwind_handler_data);
+				 scm_t_catch_handler pre_unwind_handler,
+				 void *pre_unwind_handler_data);
 
-SCM_API void scm_init_continuations (void);
+SCM_INTERNAL void scm_init_continuations (void);
 
 #endif  /* SCM_CONTINUATIONS_H */
 

libguile/coop-pthreads.h

@@ -3,7 +3,7 @@
 #ifndef SCM_COOP_PTHREADS_H
 #define SCM_COOP_PTHREADS_H
 
-/* Copyright (C) 2002, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -70,7 +70,7 @@ SCM_API int scm_i_switch_counter;
 #define SCM_SET_THREAD_LOCAL_DATA(ptr) (scm_i_copt_set_thread_data (ptr))
 
 SCM_API void *scm_i_copt_thread_data;
-SCM_API void scm_i_copt_set_thread_data (void *data);
+SCM_INTERNAL void scm_i_copt_set_thread_data (void *data);
 
 #endif  /* SCM_COOP_PTHREAD_H */
 

libguile/debug-malloc.h

@@ -3,7 +3,7 @@
 #ifndef SCM_DEBUG_MALLOC_H
 #define SCM_DEBUG_MALLOC_H
 
-/* Copyright (C) 2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -32,8 +32,8 @@ SCM_API void scm_malloc_reregister (void *obj, void *new, const char *what);
 
 SCM_API SCM scm_malloc_stats (void);
 
-SCM_API void scm_debug_malloc_prehistory (void);
+SCM_INTERNAL void scm_debug_malloc_prehistory (void);
-SCM_API void scm_init_debug_malloc (void);
+SCM_INTERNAL void scm_init_debug_malloc (void);
 
 #endif  /* SCM_DEBUG_MALLOC_H */
 

libguile/debug.h

@@ -3,7 +3,7 @@
 #ifndef SCM_DEBUG_H
 #define SCM_DEBUG_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -150,8 +150,8 @@ SCM_API SCM scm_evaluator_traps (SCM setting);
 SCM_API SCM scm_debug_options (SCM setting);
 SCM_API SCM scm_make_debugobj (scm_t_debug_frame *debug);
 
-SCM_API SCM scm_i_unmemoize_expr (SCM memoized);
+SCM_INTERNAL SCM scm_i_unmemoize_expr (SCM memoized);
-SCM_API void scm_init_debug (void);
+SCM_INTERNAL void scm_init_debug (void);
 
 #ifdef GUILE_DEBUG
 SCM_API SCM scm_memcons (SCM car, SCM cdr, SCM env);

libguile/deprecated.c

@@ -2,7 +2,7 @@
    deprecate something, move it here when that is feasible.
 */
 
-/* Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -319,14 +319,14 @@ scm_load_scheme_module (SCM name)
 static void
 maybe_close_port (void *data, SCM port)
 {
-  SCM except = (SCM)data;
+  SCM except_set = (SCM) data;
 
-  while (!scm_is_null (except))
+  while (!scm_is_null (except_set))
     {
-      SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except));
+      SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except_set));
       if (scm_is_eq (p, port))
 	return;
-      except = SCM_CDR (except);
+      except_set = SCM_CDR (except_set);
     }
 
   scm_close_port (port);

libguile/deprecation.h

@@ -3,7 +3,7 @@
 #ifndef SCM_DEPRECATION_H
 #define SCM_DEPRECATION_H
 
-/* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -41,7 +41,7 @@ SCM_API SCM scm_issue_deprecation_warning (SCM msgs);
 #endif
 
 SCM_API SCM scm_include_deprecated_features (void);
-SCM_API void scm_init_deprecation (void);
+SCM_INTERNAL void scm_init_deprecation (void);
 
 #endif  /* SCM_DEPRECATION_H */
 

libguile/discouraged.c

@@ -23,33 +23,128 @@
 
 #if (SCM_ENABLE_DISCOURAGED == 1)
 
-#define DEFFROM(t,f1,f2) SCM f1(t x) { return f2 (x); }
+SCM
-#define DEFTO(t,f1,f2)   t f1(SCM x, unsigned long pos, const char *s_caller) \
+scm_short2num (short x)
-                           { return f2 (x); }
+{
+  return scm_from_short (x);
+}
 
-DEFFROM (short, scm_short2num, scm_from_short);
+SCM
-DEFFROM (unsigned short, scm_ushort2num, scm_from_ushort);
+scm_ushort2num (unsigned short x)
-DEFFROM (int, scm_int2num, scm_from_int);
+{
-DEFFROM (unsigned int, scm_uint2num, scm_from_uint);
+  return scm_from_ushort (x);
-DEFFROM (long, scm_long2num, scm_from_long);
+}
-DEFFROM (unsigned long, scm_ulong2num, scm_from_ulong);
-DEFFROM (size_t, scm_size2num, scm_from_size_t);
-DEFFROM (ptrdiff_t, scm_ptrdiff2num, scm_from_ssize_t);
 
-DEFTO (short, scm_num2short, scm_to_short);
+SCM
-DEFTO (unsigned short, scm_num2ushort, scm_to_ushort);
+scm_int2num (int x)
-DEFTO (int, scm_num2int, scm_to_int);
+{
-DEFTO (unsigned int, scm_num2uint, scm_to_uint);
+  return scm_from_int (x);
-DEFTO (long, scm_num2long, scm_to_long);
+}
-DEFTO (unsigned long, scm_num2ulong, scm_to_ulong);
+
-DEFTO (size_t, scm_num2size, scm_to_size_t);
+SCM
-DEFTO (ptrdiff_t, scm_num2ptrdiff, scm_to_ssize_t);
+scm_uint2num (unsigned int x)
+{
+  return scm_from_uint (x);
+}
+
+SCM
+scm_long2num (long x)
+{
+  return scm_from_long (x);
+}
+
+SCM
+scm_ulong2num (unsigned long x)
+{
+  return scm_from_ulong (x);
+}
+
+SCM
+scm_size2num (size_t x)
+{
+  return scm_from_size_t (x);
+}
+
+SCM
+scm_ptrdiff2num (ptrdiff_t x)
+{
+  return scm_from_ssize_t (x);
+}
+
+short
+scm_num2short (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_short (x);
+}
+
+unsigned short
+scm_num2ushort (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_ushort (x);
+}
+
+int
+scm_num2int (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_int (x);
+}
+
+unsigned int
+scm_num2uint (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_uint (x);
+}
+
+long
+scm_num2long (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_long (x);
+}
+
+unsigned long
+scm_num2ulong (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_ulong (x);
+}
+
+size_t
+scm_num2size (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_size_t (x);
+}
+
+ptrdiff_t
+scm_num2ptrdiff (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_ssize_t (x);
+}
 
 #if SCM_SIZEOF_LONG_LONG != 0
-DEFFROM (long long, scm_long_long2num, scm_from_long_long);
+
-DEFFROM (unsigned long long, scm_ulong_long2num, scm_from_ulong_long);
+SCM
-DEFTO   (long long, scm_num2long_long, scm_to_long_long);
+scm_long_long2num (long long x)
-DEFTO   (unsigned long long, scm_num2ulong_long, scm_to_ulong_long);
+{
+  return scm_from_long_long (x);
+}
+
+SCM
+scm_ulong_long2num (unsigned long long x)
+{
+  return scm_from_ulong_long (x);
+}
+
+long long
+scm_num2long_long (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_long_long (x);
+}
+
+unsigned long long
+scm_num2ulong_long (SCM x, unsigned long pos, const char *s_caller)
+{
+  return scm_to_ulong_long (x);
+}
+
 #endif
 
 SCM

libguile/dynl.h

@@ -3,7 +3,7 @@
 #ifndef SCM_DYNL_H
 #define SCM_DYNL_H
 
-/* Copyright (C) 1996,1998,2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -33,7 +33,7 @@ SCM_API SCM scm_dynamic_func (SCM symb, SCM dobj);
 SCM_API SCM scm_dynamic_call (SCM symb, SCM dobj);
 SCM_API SCM scm_dynamic_args_call (SCM symb, SCM dobj, SCM args);
 
-SCM_API void scm_init_dynamic_linking (void);
+SCM_INTERNAL void scm_init_dynamic_linking (void);
 
 #endif  /* SCM_DYNL_H */
 

libguile/dynwind.h

@@ -3,7 +3,7 @@
 #ifndef SCM_DYNWIND_H
 #define SCM_DYNWIND_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -36,9 +36,9 @@ SCM_API SCM scm_internal_dynamic_wind (scm_t_guard before,
 				       void *inner_data,
 				       void *guard_data);
 SCM_API void scm_dowinds (SCM to, long delta);
-SCM_API void scm_i_dowinds (SCM to, long delta,
+SCM_INTERNAL void scm_i_dowinds (SCM to, long delta,
-			    void (*turn_func) (void *), void *data);
+				 void (*turn_func) (void *), void *data);
-SCM_API void scm_init_dynwind (void);
+SCM_INTERNAL void scm_init_dynwind (void);
 
 SCM_API void scm_swap_bindings (SCM vars, SCM vals);
 

libguile/environments.h

@@ -3,7 +3,7 @@
 #ifndef SCM_ENVIRONMENTS_H
 #define SCM_ENVIRONMENTS_H
 
-/* Copyright (C) 1999,2000, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -122,8 +122,8 @@ SCM_API SCM scm_environment_observe_weak (SCM env, SCM proc);
 SCM_API SCM scm_c_environment_observe (SCM env, scm_environment_observer proc, SCM data, int weak_p);
 SCM_API SCM scm_environment_unobserve (SCM token);
 
-SCM_API void scm_environments_prehistory (void);
+SCM_INTERNAL void scm_environments_prehistory (void);
-SCM_API void scm_init_environments (void);
+SCM_INTERNAL void scm_init_environments (void);
 
 
 

libguile/eq.h

@@ -3,7 +3,7 @@
 #ifndef SCM_EQ_H
 #define SCM_EQ_H
 
-/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -29,7 +29,7 @@
 SCM_API SCM scm_eq_p (SCM x, SCM y);
 SCM_API SCM scm_eqv_p (SCM x, SCM y);
 SCM_API SCM scm_equal_p (SCM x, SCM y);
-SCM_API void scm_init_eq (void);
+SCM_INTERNAL void scm_init_eq (void);
 
 #endif  /* SCM_EQ_H */
 

libguile/error.h

@@ -3,7 +3,7 @@
 #ifndef SCM_ERROR_H
 #define SCM_ERROR_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -57,7 +57,7 @@ SCM_API void scm_wrong_type_arg_msg (const char *subr, int pos,
 SCM_API void scm_memory_error (const char *subr) SCM_NORETURN;
 SCM_API void scm_misc_error (const char *subr, const char *message,
 			     SCM args) SCM_NORETURN;
-SCM_API void scm_init_error (void);
+SCM_INTERNAL void scm_init_error (void);
 
 #endif  /* SCM_ERROR_H */
 

libguile/eval.c

@@ -18,8 +18,6 @@
 
 
 
-#define _GNU_SOURCE
-
 /* SECTION: This code is compiled once.
  */
 

libguile/eval.h

@@ -3,7 +3,7 @@
 #ifndef SCM_EVAL_H
 #define SCM_EVAL_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -152,7 +152,7 @@ SCM_API SCM scm_apply_0 (SCM proc, SCM args);
 SCM_API SCM scm_apply_1 (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args);
 SCM_API SCM scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args);
-SCM_API SCM scm_i_call_closure_0 (SCM proc);
+SCM_INTERNAL SCM scm_i_call_closure_0 (SCM proc);
 SCM_API scm_t_trampoline_0 scm_trampoline_0 (SCM proc);
 SCM_API scm_t_trampoline_1 scm_trampoline_1 (SCM proc);
 SCM_API scm_t_trampoline_2 scm_trampoline_2 (SCM proc);
@@ -167,18 +167,18 @@ SCM_API SCM scm_force (SCM x);
 SCM_API SCM scm_promise_p (SCM x);
 SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y);
 SCM_API SCM scm_copy_tree (SCM obj);
-SCM_API SCM scm_i_eval_x (SCM exp, SCM env);
+SCM_API SCM scm_i_eval_x (SCM exp, SCM env) /* not internal */;
-SCM_API SCM scm_i_eval (SCM exp, SCM env);
+SCM_INTERNAL SCM scm_i_eval (SCM exp, SCM env);
 SCM_API SCM scm_primitive_eval (SCM exp);
 SCM_API SCM scm_primitive_eval_x (SCM exp);
 SCM_API SCM scm_eval (SCM exp, SCM module);
 SCM_API SCM scm_eval_x (SCM exp, SCM module);
 
-SCM_API void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/);
+SCM_INTERNAL void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/);
-SCM_API void scm_i_print_isym (SCM /*isym*/, SCM /*port*/);
+SCM_INTERNAL void scm_i_print_isym (SCM /*isym*/, SCM /*port*/);
-SCM_API SCM scm_i_unmemocopy_expr (SCM expr, SCM env);
+SCM_INTERNAL SCM scm_i_unmemocopy_expr (SCM expr, SCM env);
-SCM_API SCM scm_i_unmemocopy_body (SCM forms, SCM env);
+SCM_INTERNAL SCM scm_i_unmemocopy_body (SCM forms, SCM env);
-SCM_API void scm_init_eval (void);
+SCM_INTERNAL void scm_init_eval (void);
 
 
 #if (SCM_ENABLE_DEPRECATED == 1)

libguile/evalext.h

@@ -3,7 +3,7 @@
 #ifndef SCM_EVALEXT_H
 #define SCM_EVALEXT_H
 
-/* Copyright (C) 1998,1999,2000, 2003, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -28,7 +28,7 @@
 
 SCM_API SCM scm_defined_p (SCM sym, SCM env);
 SCM_API SCM scm_self_evaluating_p (SCM obj);
-SCM_API void scm_init_evalext (void);
+SCM_INTERNAL void scm_init_evalext (void);
 
 #if (SCM_ENABLE_DEPRECATED == 1)
 

libguile/extensions.h

@@ -3,7 +3,7 @@
 #ifndef SCM_EXTENSIONS_H
 #define SCM_EXTENSIONS_H
 
-/* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -32,7 +32,7 @@ SCM_API void scm_c_register_extension (const char *lib, const char *init,
 SCM_API void scm_c_load_extension (const char *lib, const char *init);
 SCM_API SCM scm_load_extension (SCM lib, SCM init);
 
-SCM_API void scm_init_extensions (void);
+SCM_INTERNAL void scm_init_extensions (void);
 
 #endif  /* SCM_EXTENSIONS_H */
 

libguile/feature.h

@@ -3,7 +3,7 @@
 #ifndef SCM_FEATURE_H
 #define SCM_FEATURE_H
 
-/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -28,7 +28,7 @@ SCM_API void scm_add_feature (const char* str);
 SCM_API SCM scm_program_arguments (void);
 SCM_API void scm_set_program_arguments (int argc, char **argv, char *first);
 SCM_API SCM scm_set_program_arguments_scm (SCM lst);
-SCM_API void scm_init_feature (void);
+SCM_INTERNAL void scm_init_feature (void);
 
 #endif  /* SCM_FEATURE_H */
 

libguile/filesys.c

@@ -19,7 +19,6 @@
 
 
 /* See stime.c for comments on why _POSIX_C_SOURCE is not always defined. */
-#define _GNU_SOURCE              /* ask glibc for everything */
 #define _LARGEFILE64_SOURCE      /* ask for stat64 etc */
 #ifdef __hpux
 #define _POSIX_C_SOURCE 199506L  /* for readdir_r */

libguile/filesys.h

@@ -3,7 +3,7 @@
 #ifndef SCM_FILESYS_H
 #define SCM_FILESYS_H
 
-/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -65,7 +65,7 @@ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
 SCM_API SCM scm_dirname (SCM filename);
 SCM_API SCM scm_basename (SCM filename, SCM suffix);
 
-SCM_API void scm_init_filesys (void);
+SCM_INTERNAL void scm_init_filesys (void);
 
 #endif  /* SCM_FILESYS_H */
 

libguile/fluids.h

@@ -3,7 +3,7 @@
 #ifndef SCM_FLUIDS_H
 #define SCM_FLUIDS_H
 
-/* Copyright (C) 1996,2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -82,10 +82,10 @@ SCM_API void *scm_c_with_dynamic_state (SCM state,
 					void *(*func)(void *), void *data);
 SCM_API SCM scm_with_dynamic_state (SCM state, SCM proc);
 
-SCM_API SCM scm_i_make_initial_dynamic_state (void);
+SCM_INTERNAL SCM scm_i_make_initial_dynamic_state (void);
 
-SCM_API void scm_fluids_prehistory (void);
+SCM_INTERNAL void scm_fluids_prehistory (void);
-SCM_API void scm_init_fluids (void);
+SCM_INTERNAL void scm_init_fluids (void);
 
 #endif  /* SCM_FLUIDS_H */
 

libguile/fports.h

@@ -3,7 +3,7 @@
 #ifndef SCM_FPORTS_H
 #define SCM_FPORTS_H
 
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -53,13 +53,13 @@ SCM_API void scm_evict_ports (int fd);
 SCM_API SCM scm_open_file (SCM filename, SCM modes);
 SCM_API SCM scm_fdes_to_port (int fdes, char *mode, SCM name);
 SCM_API SCM scm_file_port_p (SCM obj);
-SCM_API void scm_init_fports (void);
+SCM_INTERNAL void scm_init_fports (void);
 
 /* internal functions */
 
-SCM_API SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
+SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
-SCM_API int scm_i_fport_truncate (SCM, SCM);
+SCM_INTERNAL int scm_i_fport_truncate (SCM, SCM);
-SCM_API SCM scm_i_fport_seek (SCM, SCM, int);
+SCM_INTERNAL SCM scm_i_fport_seek (SCM, SCM, int);
 
 
 #endif  /* SCM_FPORTS_H */

libguile/futures.h

@@ -3,7 +3,7 @@
 #ifndef SCM_FUTURES_H
 #define SCM_FUTURES_H
 
-/* Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -73,7 +73,7 @@ SCM_API scm_t_bits scm_tc16_future;
 
 extern SCM *scm_loc_sys_thread_handler;
 
-SCM_API SCM scm_i_make_future (SCM thunk);
+SCM_INTERNAL SCM scm_i_make_future (SCM thunk);
 SCM_API SCM scm_make_future (SCM thunk);
 SCM_API SCM scm_future_ref (SCM future);
 

libguile/gc-card.c

@@ -15,31 +15,31 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
-
+#include <assert.h>
 #include <stdio.h>
 #include <gmp.h>
 
 #include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/numbers.h"
-#include "libguile/stime.h"
-#include "libguile/stackchk.h"
-#include "libguile/struct.h"
-#include "libguile/smob.h"
-#include "libguile/unif.h"
 #include "libguile/async.h"
+#include "libguile/deprecation.h"
+#include "libguile/eval.h"
+#include "libguile/gc.h"
+#include "libguile/hashtab.h"
+#include "libguile/numbers.h"
 #include "libguile/ports.h"
+#include "libguile/private-gc.h"
 #include "libguile/root.h"
+#include "libguile/smob.h"
+#include "libguile/srfi-4.h"
+#include "libguile/stackchk.h"
+#include "libguile/stime.h"
 #include "libguile/strings.h"
+#include "libguile/struct.h"
+#include "libguile/tags.h"
+#include "libguile/unif.h"
+#include "libguile/validate.h"
 #include "libguile/vectors.h"
 #include "libguile/weaks.h"
-#include "libguile/hashtab.h"
-#include "libguile/tags.h"
-#include "libguile/private-gc.h"
-#include "libguile/validate.h"
-#include "libguile/deprecation.h"
-#include "libguile/gc.h"
-#include "libguile/srfi-4.h"
 
 #include "libguile/private-gc.h"
 
@@ -50,27 +50,23 @@ long int scm_i_deprecated_memory_return;
  */
 SCM scm_i_structs_to_free;
 
-
 /*
   Init all the free cells in CARD, prepending to *FREE_LIST.
 
-  Return: number of free cells found in this card.
+  Return: FREE_COUNT, the number of cells collected.  This is
+  typically the length of the *FREE_LIST, but for some special cases,
+  we do not actually free the cell. To make the numbers match up, we
+  do increase the FREE_COUNT.
 
-  It would be cleaner to have a separate function sweep_value(), but
+  It would be cleaner to have a separate function sweep_value (), but
   that is too slow (functions with switch statements can't be
   inlined).
 
-
-
-  
   NOTE:
 
-  This function is quite efficient. However, for many types of cells,
+  For many types of cells, allocation and a de-allocation involves
-  allocation and a de-allocation involves calling malloc() and
+  calling malloc () and free ().  This is costly for small objects (due
-  free().
+  to malloc/free overhead.)  (should measure this).
-
-  This is costly for small objects (due to malloc/free overhead.)
-  (should measure this).
 
   It might also be bad for threads: if several threads are allocating
   strings concurrently, then mallocs for both threads may have to
@@ -82,15 +78,16 @@ SCM scm_i_structs_to_free;
   --hwn.
  */
 int
-scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
+scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg)
 #define FUNC_NAME "sweep_card"
 {
-  scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p);
+  scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC (card);
-  scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
+  scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
+  scm_t_cell *p = card;
   int span = seg->span;
-  int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
+  int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
-  int free_count  = 0;
+  int free_count = 0;
-
+  
   /*
     I tried something fancy with shifting by one bit every word from
     the bitvec in turn, but it wasn't any faster, but quite a bit
@@ -101,7 +98,7 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
       SCM scmptr = PTR2SCM (p);
       if (SCM_C_BVEC_GET (bitvec, offset))
         continue;
-
+      free_count++;
       switch (SCM_TYP7 (scmptr))
 	{
 	case scm_tcs_struct:
@@ -178,13 +175,13 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
 	      if (!(k < scm_numptob))
 		{
 		  fprintf (stderr, "undefined port type");
-		  abort();
+		  abort ();
 		}
 #endif
 	      /* Keep "revealed" ports alive.  */
 	      if (scm_revealed_count (scmptr) > 0)
 		continue;
-	  
+	      
 	      /* Yes, I really do mean scm_ptobs[k].free */
 	      /* rather than ftobs[k].close.  .close */
 	      /* is for explicit CLOSE-PORT by user */
@@ -214,7 +211,6 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
 	  switch SCM_TYP16 (scmptr)
 	    {
 	    case scm_tc_free_cell:
-	      free_count --;
 	      break;
 	    default:
 	      {
@@ -224,7 +220,7 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
 		if (!(k < scm_numsmob))
 		  {
 		    fprintf (stderr, "undefined smob type");
-		    abort();
+		    abort ();
 		  }
 #endif
 		if (scm_smobs[k].free)
@@ -242,7 +238,7 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
 			   SCM_SMOBNAME (k));
 			scm_i_deprecated_memory_return += mm;
 #else
-			abort();
+			abort ();
 #endif
 		      }
 		  }
@@ -252,15 +248,14 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
 	  break;
 	default:
 	  fprintf (stderr, "unknown type");
-	  abort();
+	  abort ();
 	}
 
       SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell);	  
       SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list));
       *free_list = scmptr;
-      free_count ++;
     }
-
+  
   return free_count;
 }
 #undef FUNC_NAME
@@ -270,17 +265,17 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
   Like sweep, but no complicated logic to do the sweeping.
  */
 int
-scm_i_init_card_freelist (scm_t_cell *  card, SCM *free_list,
+scm_i_init_card_freelist (scm_t_cell *card, SCM *free_list,
-			scm_t_heap_segment*seg)
+			  scm_t_heap_segment *seg)
 {
   int span = seg->span;
   scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
   scm_t_cell *p = end - span;
-
+  int collected = 0;
-  scm_t_c_bvec_long * bvec_ptr =  (scm_t_c_bvec_long* ) seg->bounds[1];
+  scm_t_c_bvec_long *bvec_ptr = (scm_t_c_bvec_long*) seg->bounds[1];
   int idx = (card  - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; 
 
-  bvec_ptr += idx *SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
+  bvec_ptr += idx * SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
   SCM_GC_SET_CELL_BVEC (card, bvec_ptr);
   
   /*
@@ -292,16 +287,47 @@ scm_i_init_card_freelist (scm_t_cell *  card, SCM *free_list,
       SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell);
       SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list));
       *free_list = scmptr;
+      collected ++;
     }
 
-  return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS);
+  return collected;
 }
 
+/*
+  Classic MIT Hack, see e.g. http://www.tekpool.com/?cat=9
+ */
+int scm_i_uint_bit_count (unsigned int u)
+{
+  unsigned int u_count = u 
+    - ((u >> 1) & 033333333333) 
+    - ((u >> 2) & 011111111111);
+  return 
+    ((u_count + (u_count >> 3)) 
+     & 030707070707) % 63;
+}
+
+/*
+  Amount of cells marked in this cell, measured in 1-cells.
+ */
+int
+scm_i_card_marked_count (scm_t_cell *card, int span)
+{
+  scm_t_c_bvec_long* bvec = SCM_GC_CARD_BVEC (card);
+  scm_t_c_bvec_long* bvec_end = (bvec + SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
+  
+  int count = 0;
+  while (bvec < bvec_end)
+    {
+      count += scm_i_uint_bit_count (*bvec);
+      bvec ++;
+    }
+  return count * span;
+}
 
 void
 scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg)
 {
-  scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p);
+  scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC (p);
   scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
   int span = seg->span;
   int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
@@ -411,7 +437,7 @@ scm_i_tag_name (scm_t_bits tag)
     case scm_tc7_smob:
       /* scm_tc_free_cell is smob 0, the name field in that scm_smobs[]
          entry should be ok for our return here */
-      return scm_smobs[SCM_TC2SMOBNUM(tag)].name;
+      return scm_smobs[SCM_TC2SMOBNUM (tag)].name;
     }
 
   return NULL;
@@ -443,7 +469,7 @@ int
 scm_dbg_gc_marked_p (SCM obj)
 {
   if (!SCM_IMP (obj))
-    return SCM_GC_MARK_P(obj);
+    return SCM_GC_MARK_P (obj);
   else
     return 0;
 }
@@ -452,7 +478,7 @@ scm_t_cell *
 scm_dbg_gc_get_card (SCM obj)
 {
   if (!SCM_IMP (obj))
-    return SCM_GC_CELL_CARD(obj);
+    return SCM_GC_CELL_CARD (obj);
   else
     return NULL;
 }

libguile/gc-freelist.c

@@ -26,9 +26,6 @@
 scm_t_cell_type_statistics scm_i_master_freelist;
 scm_t_cell_type_statistics scm_i_master_freelist2;
 
-
-
-
 /*
 
 In older versions of GUILE GC there was extensive support for
@@ -38,8 +35,6 @@ the list. Mark bits are now separate, and checking for sane cell
 access can be done much more easily by simply checking if the mark bit
 is unset before allocation.  --hwn
 
-
-
 */
 
 #if (SCM_ENABLE_DEPRECATED == 1)
@@ -69,78 +64,53 @@ SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1
 #endif /* defined (GUILE_DEBUG) */
 #endif /* deprecated */
 
-
-
-
-/* Adjust FREELIST variables to decide wether or not to allocate more heap in
-   the next GC run based on SWEEP_STATS on SWEEP_STATS_1 (statistics
-   collected after the two last full GC).  */
-void
-scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist,
-			scm_t_sweep_statistics sweep_stats,
-			scm_t_sweep_statistics sweep_stats_1)
-{
-  /* min yield is adjusted upwards so that next predicted total yield
-   * (allocated cells actually freed by GC) becomes
-   * `min_yield_fraction' of total heap size.  Note, however, that
-   * the absolute value of min_yield will correspond to `collected'
-   * on one master (the one which currently is triggering GC).
-   *
-   * The reason why we look at total yield instead of cells collected
-   * on one list is that we want to take other freelists into account.
-   * On this freelist, we know that (local) yield = collected cells,
-   * but that's probably not the case on the other lists.
-   *
-   * (We might consider computing a better prediction, for example
-   *  by computing an average over multiple GC:s.)
-   */
-  if (freelist->min_yield_fraction)
-    {
-      /* Pick largest of last two yields. */
-      long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100)
-		   - (long) SCM_MAX (sweep_stats.collected,
-				     sweep_stats_1.collected));
-#ifdef DEBUGINFO
-      fprintf (stderr, " after GC = %lu, delta = %ld\n",
-	       (unsigned long) scm_cells_allocated,
-	       (long) delta);
-#endif
-      if (delta > 0)
-	freelist->min_yield += delta;
-    }
-}
-
-
 static void
 scm_init_freelist (scm_t_cell_type_statistics *freelist,
-	       int span,
+		   int span,
-	       int min_yield)
+		   int min_yield_percentage)
 {
-  if (min_yield < 1)
+  if (min_yield_percentage < 1)
-    min_yield = 1;
+    min_yield_percentage = 1;
-  if (min_yield > 99)
+  if (min_yield_percentage > 99)
-    min_yield = 99;
+    min_yield_percentage = 99;
 
   freelist->heap_segment_idx = -1;
-  freelist->min_yield = 0;
+  freelist->min_yield_fraction = min_yield_percentage / 100.0;
-  freelist->min_yield_fraction = min_yield;
   freelist->span = span;
+  freelist->swept = 0;
   freelist->collected = 0;
-  freelist->collected_1 = 0;
+  freelist->heap_total_cells = 0;
-  freelist->heap_size = 0;
 }
 
 #if (SCM_ENABLE_DEPRECATED == 1)
- size_t scm_default_init_heap_size_1;
+size_t scm_default_init_heap_size_1;
- int scm_default_min_yield_1;
+int scm_default_min_yield_1;
- size_t scm_default_init_heap_size_2;
+size_t scm_default_init_heap_size_2;
- int scm_default_min_yield_2;
+int scm_default_min_yield_2;
- size_t scm_default_max_segment_size;
+size_t scm_default_max_segment_size;
+
+static void
+check_deprecated_heap_vars (void)  {
+  if (scm_default_init_heap_size_1 ||
+      scm_default_min_yield_1||
+      scm_default_init_heap_size_2||
+      scm_default_min_yield_2||
+      scm_default_max_segment_size)
+    {
+      scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead.");
+    }
+}
+#else
+static void check_deprecated_heap_vars (void) { }
 #endif
 
 void
 scm_gc_init_freelist (void)
 {
+  const char *error_message =
+    "Could not allocate initial heap of %uld.\n"
+    "Try adjusting GUILE_INIT_SEGMENT_SIZE_%d\n";
+ 
   int init_heap_size_1
     = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1);
   int init_heap_size_2
@@ -155,38 +125,62 @@ scm_gc_init_freelist (void)
 
   if (scm_max_segment_size <= 0)
     scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE;
-  
+   
-  
+  if (scm_i_get_new_heap_segment (&scm_i_master_freelist,
-  scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist);
+				  init_heap_size_1, return_on_error) == -1)  {
-  scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2);
+    fprintf (stderr, error_message, init_heap_size_1, 1);
-  
+    abort ();
-#if (SCM_ENABLE_DEPRECATED == 1)
+  }
-  if ( scm_default_init_heap_size_1 ||
+  if (scm_i_get_new_heap_segment (&scm_i_master_freelist2,
-       scm_default_min_yield_1||
+				  init_heap_size_2, return_on_error) == -1) {
-       scm_default_init_heap_size_2||
+    fprintf (stderr, error_message, init_heap_size_2, 2);
-       scm_default_min_yield_2||
+    abort ();
-       scm_default_max_segment_size)
+  }
-    {
+
-      scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead.");
+  check_deprecated_heap_vars ();
-    }
-#endif
 }
 
 
+
 void
 scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist)
 {
-  freelist->collected_1 = freelist->collected;
   freelist->collected = 0;
-  
+  freelist->swept = 0;
   /*
     at the end we simply start with the lowest segment again.
    */
   freelist->heap_segment_idx = -1;
 }
 
-int
+
-scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist)
+/*
+  Returns how many more cells we should allocate according to our
+  policy.  May return negative if we don't need to allocate more. 
+
+
+  The new yield should at least equal gc fraction of new heap size, i.e.
+
+  c + dh > f * (h + dh)
+
+  c : collected
+  f : min yield fraction
+  h : heap size
+  dh : size of new heap segment
+
+  this gives dh > (f * h - c) / (1 - f).
+*/
+float
+scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist)
 {
-  return SCM_MAX (freelist->collected,freelist->collected_1)  < freelist->min_yield;
+  float f = freelist->min_yield_fraction;
+  float collected = freelist->collected;
+  float swept = freelist->swept;
+  float delta = ((f * swept - collected) / (1.0 - f));
+
+  assert (freelist->heap_total_cells >= freelist->collected);
+  assert (freelist->swept == freelist->heap_total_cells);
+  assert (swept >= collected);
+
+  return delta;
 }

libguile/gc-malloc.c

@@ -84,8 +84,8 @@ scm_gc_init_malloc (void)
 {
   scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
 				 SCM_DEFAULT_INIT_MALLOC_LIMIT);
-  scm_i_minyield_malloc =  scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
+  scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
-					   SCM_DEFAULT_MALLOC_MINYIELD);
+					  SCM_DEFAULT_MALLOC_MINYIELD);
 
   if (scm_i_minyield_malloc >= 100)
     scm_i_minyield_malloc = 99;
@@ -105,7 +105,6 @@ void *
 scm_realloc (void *mem, size_t size)
 {
   void *ptr;
-  scm_t_sweep_statistics sweep_stats;
 
   SCM_SYSCALL (ptr = realloc (mem, size));
   if (ptr)
@@ -114,19 +113,17 @@ scm_realloc (void *mem, size_t size)
   scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
   scm_gc_running_p = 1;
 
-  scm_i_sweep_all_segments ("realloc", &sweep_stats);
-  
-  SCM_SYSCALL (ptr = realloc (mem, size));
-  if (ptr)
-    { 
-      scm_gc_running_p = 0;
-      scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
-      return ptr;
-    }
-
   scm_i_gc ("realloc");
-  scm_i_sweep_all_segments ("realloc", &sweep_stats);
+
-  
+  /*
+   We don't want these sweep statistics to influence results for
+   cell GC, so we don't collect statistics.
+   
+   realloc () failed, so we're really desparate to free memory. Run a
+   full sweep.
+  */
+  scm_i_sweep_all_segments ("realloc", NULL);
+
   scm_gc_running_p = 0;
   scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
   
@@ -231,19 +228,22 @@ increase_mtrigger (size_t size, const char *what)
     {
       unsigned long prev_alloced;
       float yield;
-      scm_t_sweep_statistics sweep_stats;
 
       scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
       scm_gc_running_p = 1;
       
-      prev_alloced  = mallocated;
+      prev_alloced = mallocated;
+
+      /* The GC will finish the pending sweep. For that reason, we
+	 don't execute a complete sweep after GC, although that might
+	 free some more memory.
+      */
       scm_i_gc (what);
-      scm_i_sweep_all_segments ("mtrigger", &sweep_stats);
 
       yield = (((float) prev_alloced - (float) scm_mallocated)
 	       / (float) prev_alloced);
       
-      scm_gc_malloc_yield_percentage = (int) (100  * yield);
+      scm_gc_malloc_yield_percentage = (int) (100 * yield);
 
 #ifdef DEBUGINFO
       fprintf (stderr,  "prev %lud , now %lud, yield %4.2lf, want %d",
@@ -271,7 +271,7 @@ increase_mtrigger (size_t size, const char *what)
 	  if (no_overflow_trigger >= (float) ULONG_MAX)
 	    scm_mtrigger = ULONG_MAX;
 	  else
-	    scm_mtrigger =  (unsigned long) no_overflow_trigger;
+	    scm_mtrigger = (unsigned long) no_overflow_trigger;
 	  
 #ifdef DEBUGINFO
 	  fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n",
@@ -314,7 +314,7 @@ scm_gc_malloc (size_t size, const char *what)
      again in scm_gc_register_collectable_memory.  We don't really
      want the second GC since it will not find new garbage.
 
-     Note: this is a theoretical peeve. In reality, malloc() never
+     Note: this is a theoretical peeve. In reality, malloc () never
      returns NULL. Usually, memory is overcommitted, and when you try
      to write it the program is killed with signal 11. --hwn
   */
@@ -342,10 +342,10 @@ scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 
 
   /*    
-  scm_realloc() may invalidate the block pointed to by WHERE, eg. by
+  scm_realloc () may invalidate the block pointed to by WHERE, eg. by
   unmapping it from memory or altering the contents.  Since
-  increase_mtrigger() might trigger a GC that would scan
+  increase_mtrigger () might trigger a GC that would scan
-  MEM, it is crucial that this call precedes realloc().
+  MEM, it is crucial that this call precedes realloc ().
   */
 
   decrease_mtrigger (old_size, what);

libguile/gc-mark.c

@@ -73,11 +73,12 @@ scm_mark_all (void)
   long j;
   int loops;
 
+  scm_i_marking = 1;
   scm_i_init_weak_vectors_for_gc ();
   scm_i_init_guardians_for_gc ();
   
   scm_i_clear_mark_space ();
-  
+  scm_i_find_heap_calls = 0;
   /* Mark every thread's stack and registers */
   scm_threads_mark_stacks ();
 
@@ -139,8 +140,6 @@ scm_mark_all (void)
       break;
     }
 
-  /* fprintf (stderr, "%d loops\n", loops); */
-
   /* Remove all unmarked entries from the weak vectors.
    */
   scm_i_remove_weaks_from_weak_vectors ();
@@ -148,6 +147,7 @@ scm_mark_all (void)
   /* Bring hashtables upto date.
    */
   scm_i_scan_weak_hashtables ();
+  scm_i_marking = 0;
 }
 
 /* {Mark/Sweep}
@@ -169,6 +169,12 @@ scm_gc_mark (SCM ptr)
   scm_gc_mark_dependencies (ptr);
 }
 
+void
+ensure_marking (void)
+{
+  assert (scm_i_marking);
+}
+
 /*
 
 Mark the dependencies of an object.
@@ -177,7 +183,7 @@ Prefetching:
 
 Should prefetch objects before marking, i.e. if marking a cell, we
 should prefetch the car, and then mark the cdr. This will improve CPU
-cache misses, because the car is more likely to be in core when we
+cache misses, because the car is more likely to be in cache when we
 finish the cdr.
 
 See http://www.hpl.hp.com/techreports/2000/HPL-2000-99.pdf, reducing
@@ -333,10 +339,10 @@ scm_gc_mark_dependencies (SCM p)
       if (!(i < scm_numptob))
 	{
 	  fprintf (stderr, "undefined port type");
-	  abort();
+	  abort ();
 	}
 #endif
-      if (SCM_PTAB_ENTRY(ptr))
+      if (SCM_PTAB_ENTRY (ptr))
 	scm_gc_mark (SCM_FILENAME (ptr));
       if (scm_ptobs[i].mark)
 	{
@@ -360,7 +366,7 @@ scm_gc_mark_dependencies (SCM p)
 	  if (!(i < scm_numsmob))
 	    {
 	      fprintf (stderr, "undefined smob type");
-	      abort();
+	      abort ();
 	    }
 #endif
 	  if (scm_smobs[i].mark)
@@ -374,7 +380,7 @@ scm_gc_mark_dependencies (SCM p)
       break;
     default:
       fprintf (stderr, "unknown type");
-      abort();
+      abort ();
     }
 
   /*
@@ -398,21 +404,19 @@ scm_gc_mark_dependencies (SCM p)
       {
     /* We are in debug mode.  Check the ptr exhaustively. */
 	
-	valid_cell = valid_cell && (scm_i_find_heap_segment_containing_object (ptr) >= 0);
+	valid_cell = valid_cell && scm_in_heap_p (ptr);
       }
     
 #endif
     if (!valid_cell)
       {
 	fprintf (stderr, "rogue pointer in heap");
-	abort();
+	abort ();
       }
   }
   
- if (SCM_GC_MARK_P (ptr))
+  if (SCM_GC_MARK_P (ptr))
-  {
     return;
-  }
   
   SCM_SET_GC_MARK (ptr);
 
@@ -422,8 +426,6 @@ scm_gc_mark_dependencies (SCM p)
 #undef FUNC_NAME
 
 
-
-
 /* Mark a region conservatively */
 void
 scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
@@ -501,7 +503,7 @@ scm_deprecated_newcell2 (void)
 
 
 void
-scm_gc_init_mark(void)
+scm_gc_init_mark (void)
 {
 #if SCM_ENABLE_DEPRECATED == 1
   scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);

libguile/gc-segment-table.c

@@ -0,0 +1,295 @@
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#include <assert.h> 
+#include <stdio.h>
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/pairs.h"
+#include "libguile/gc.h"
+#include "libguile/private-gc.h"
+
+
+/*
+  Heap segment table.
+
+  The table is sorted by the address of the data itself. This makes
+  for easy lookups. This is not portable: according to ANSI C,
+  pointers can only be compared within the same object (i.e. the same
+  block of malloced memory.). For machines with weird architectures,
+  this should be revised.
+  
+  (Apparently, for this reason 1.6 and earlier had macros for pointer
+  comparison. )
+  
+  perhaps it is worthwhile to remove the 2nd level of indirection in
+  the table, but this certainly makes for cleaner code.
+*/
+scm_t_heap_segment **scm_i_heap_segment_table;
+size_t scm_i_heap_segment_table_size;
+static scm_t_cell *lowest_cell;
+static scm_t_cell *highest_cell; 
+
+
+/*
+  RETURN: index of inserted segment.
+ */
+int
+scm_i_insert_segment (scm_t_heap_segment *seg)
+{
+  size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
+  SCM_SYSCALL (scm_i_heap_segment_table
+	      = ((scm_t_heap_segment **)
+		 realloc ((char *)scm_i_heap_segment_table, size)));
+
+  /*
+    We can't alloc 4 more bytes. This is hopeless.
+   */
+  if (!scm_i_heap_segment_table)
+    {
+      fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
+      abort ();
+    }
+
+  if (!lowest_cell)
+    {
+      lowest_cell = seg->bounds[0];
+      highest_cell = seg->bounds[1];
+    }
+  else
+    {
+      lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
+      highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
+    }
+
+
+  {
+    int i = 0;
+    int j = 0;
+
+    while (i < scm_i_heap_segment_table_size
+	   && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
+      i++;
+
+    /*
+      We insert a new entry; if that happens to be before the
+      "current" segment of a freelist, we must move the freelist index
+      as well.
+    */
+    if (scm_i_master_freelist.heap_segment_idx >= i)
+      scm_i_master_freelist.heap_segment_idx ++;
+    if (scm_i_master_freelist2.heap_segment_idx >= i)
+      scm_i_master_freelist2.heap_segment_idx ++;
+
+    for (j = scm_i_heap_segment_table_size; j > i; --j)
+      scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];
+
+    scm_i_heap_segment_table[i] = seg;
+    scm_i_heap_segment_table_size ++;
+
+    return i;
+  }
+}
+
+
+/*
+  Determine whether the given value does actually represent a cell in
+  some heap segment.  If this is the case, the number of the heap
+  segment is returned.  Otherwise, -1 is returned.  Binary search is
+  used to determine the heap segment that contains the cell.
+
+  I think this function is too long to be inlined. --hwn
+*/
+
+int
+scm_i_find_heap_segment_containing_object (SCM obj)
+{
+  if (!CELL_P (obj))
+    return -1;
+
+  scm_i_find_heap_calls ++;
+  if ((scm_t_cell *) obj < lowest_cell || (scm_t_cell *) obj >= highest_cell)
+    return -1;
+  
+  {
+    scm_t_cell *ptr = SCM2PTR (obj);
+    unsigned int i = 0;
+    unsigned int j = scm_i_heap_segment_table_size - 1;
+
+    if (ptr < scm_i_heap_segment_table[i]->bounds[0])
+      return -1;
+    else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
+      return -1;
+    else
+      {
+	while (i < j)
+	  {
+	    if (ptr < scm_i_heap_segment_table[i]->bounds[1])
+	      {
+		break;
+	      }
+	    else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
+	      {
+		i = j;
+		break;
+	      }
+	    else
+	      {
+		unsigned long int k = (i + j) / 2;
+
+		if (k == i)
+		  return -1;
+		else if (ptr <  scm_i_heap_segment_table[k]->bounds[1])
+		  {
+		    j = k;
+		    ++i;
+		    if (ptr <  scm_i_heap_segment_table[i]->bounds[0])
+		      return -1;
+		  }
+		else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
+		  {
+		    i = k;
+		    --j;
+		    if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
+		      return -1;
+		  }
+	      }
+	  }
+
+	if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
+	  return -1;
+	else if (SCM_GC_IN_CARD_HEADERP (ptr))
+	  return -1;
+	else
+	  return i;
+      }
+  }
+}
+
+
+int
+scm_i_marked_count (void)
+{
+  int i = 0;
+  int c = 0;
+  for (; i < scm_i_heap_segment_table_size; i++)
+    {
+      c += scm_i_heap_segment_marked_count (scm_i_heap_segment_table[i]);
+    }
+  return c;
+}
+
+
+SCM
+scm_i_sweep_some_segments (scm_t_cell_type_statistics *freelist,
+			   scm_t_sweep_statistics *sweep_stats)
+{
+  int i = freelist->heap_segment_idx;
+  SCM collected = SCM_EOL;
+
+  if (i == -1)			/* huh? --hwn */
+    i++;
+
+  for (;
+       i < scm_i_heap_segment_table_size; i++)
+    {
+      if (scm_i_heap_segment_table[i]->freelist != freelist)
+	continue;
+
+      collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
+					  sweep_stats,
+					  DEFAULT_SWEEP_AMOUNT);
+
+      if (collected != SCM_EOL)       /* Don't increment i */
+	break;
+    }
+
+  freelist->heap_segment_idx = i;
+
+  return collected;
+}
+
+void
+scm_i_reset_segments (void)
+{
+  int i = 0;
+  for (; i < scm_i_heap_segment_table_size; i++)
+    {
+      scm_t_heap_segment *seg = scm_i_heap_segment_table[i];
+      seg->next_free_card = seg->bounds[0];
+    }
+}
+
+
+
+
+/*
+  Return a hashtab with counts of live objects, with tags as keys.
+ */
+SCM
+scm_i_all_segments_statistics (SCM tab)
+{
+  int i = 0;
+  for (; i < scm_i_heap_segment_table_size; i++)
+    {
+      scm_t_heap_segment *seg = scm_i_heap_segment_table[i];
+      scm_i_heap_segment_statistics (seg, tab);
+    }
+
+  return tab;
+}
+
+
+unsigned long*
+scm_i_segment_table_info (int* size)
+{
+  *size = scm_i_heap_segment_table_size;  
+  unsigned long *bounds = malloc (sizeof (unsigned long) * *size * 2);
+  int i;
+  if (!bounds)
+    abort ();
+  for (i = *size; i-- > 0; )
+    {
+      bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0];
+      bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1];
+    }
+  return bounds;
+}
+
+
+void
+scm_i_sweep_all_segments (char const *reason,
+			  scm_t_sweep_statistics *sweep_stats)
+{
+  unsigned i= 0;
+  for (i = 0; i < scm_i_heap_segment_table_size; i++)
+    {
+      scm_i_sweep_segment (scm_i_heap_segment_table[i], sweep_stats);
+    }
+}
+
+
+void
+scm_i_clear_mark_space (void)
+{
+  int i = 0;
+  for (; i < scm_i_heap_segment_table_size; i++)
+    {
+      scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
+    }
+}

libguile/gc-segment.c

@@ -24,503 +24,35 @@
 #include "libguile/gc.h"
 #include "libguile/private-gc.h"
 
-
-
-
-
 size_t scm_max_segment_size;
 
-scm_t_heap_segment *
-scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
-{
-  scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment));
-
-  if (!shs)
-    {
-      fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
-      abort ();
-    }
-  
-  shs->bounds[0] = NULL;
-  shs->bounds[1] = NULL;
-  shs->malloced = NULL;
-  shs->span = fl->span;
-  shs->freelist  = fl;
-  shs->next_free_card = NULL;
-  
-  return shs;
-}
-
-
-void
-scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab)
-{
-  scm_t_cell *p = seg->bounds[0];
-  while (p <  seg->bounds[1])
-    {
-      scm_i_card_statistics (p, tab, seg); 
-      p += SCM_GC_CARD_N_CELLS;
-    }
-}
-
-
-
-/*
-  Fill SEGMENT with memory both for data and mark bits.
-
-  RETURN:  1 on success, 0 failure  
- */
-int 
-scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested)
-{
-  /*
-    round upwards
-   */
-  int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
-  int card_count =1 + (requested / sizeof (scm_t_cell)) /  card_data_cell_count; 
-
-  /*
-    one card extra due to alignment
-  */
-  size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD
-    + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG
-    ;
-  scm_t_c_bvec_long * bvec_ptr = 0;
-  scm_t_cell *  memory = 0;
-
-  /*
-    We use calloc to alloc the heap. On GNU libc this is 
-    equivalent to mmapping /dev/zero
-   */
-  SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed));
-
-  if (memory == NULL)
-    return 0;
-
-  segment->malloced = memory;
-  segment->bounds[0] = SCM_GC_CARD_UP (memory);
-  segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
-
-  segment->freelist->heap_size += scm_i_segment_cell_count (segment);
-  
-  bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1];
-
-  /*
-    Don't init the mem or the bitvector. This is handled by lazy
-    sweeping.
-  */
-  
-  segment->next_free_card = segment->bounds[0];
-  segment->first_time = 1;
-  return 1;
-}
-
-int
-scm_i_segment_card_count (scm_t_heap_segment * seg)
-{
-  return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
-}
-
-/*
-  Return the number of available single-cell data cells. 
- */
-int
-scm_i_segment_cell_count (scm_t_heap_segment * seg)
-{
-  return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
-    + ((seg->span == 2) ? -1 : 0);
-}
-
-void
-scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
-{
-  scm_t_cell *  markspace = seg->bounds[1];
-
-  memset (markspace, 0x00,
-	  scm_i_segment_card_count (seg) *  SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
-}
-
-/* Sweep cards from SEG until we've gathered THRESHOLD cells.  On return,
-   SWEEP_STATS contains the number of cells that have been visited and
-   collected.  A freelist is returned, potentially empty.  */
-SCM
-scm_i_sweep_some_cards (scm_t_heap_segment *seg,
-			scm_t_sweep_statistics *sweep_stats)
-{
-  SCM cells = SCM_EOL;
-  int threshold = 512;
-  int collected = 0;
-  int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment* )
-    = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;
-
-  scm_t_cell * next_free = seg->next_free_card;
-  int cards_swept = 0;
-
-  while (collected < threshold && next_free < seg->bounds[1])
-    {
-      collected += (*sweeper) (next_free, &cells, seg);
-      next_free += SCM_GC_CARD_N_CELLS;
-      cards_swept ++;
-    }
-
-  sweep_stats->swept = cards_swept * seg->span
-    * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
-
-  if (!seg->first_time)
-    {
-      /* scm_cells_allocated -= collected * seg->span; */
-      sweep_stats->collected = collected * seg->span;
-    }
-  else
-    sweep_stats->collected = 0;
-
-  seg->freelist->collected += collected * seg->span;
-
-  if(next_free == seg->bounds[1])
-    {
-      seg->first_time = 0;
-    }
-
-  seg->next_free_card = next_free;
-  return cells;
-}
-
-
-/*
-  Force a sweep of this entire segment. This doesn't modify sweep
-  statistics, it just frees the memory pointed to by to-be-swept
-  cells.
-
-  Implementation is slightly ugh.
-
-  FIXME: if you do scm_i_sweep_segment(), and then allocate from this
-  segment again, the statistics are off.
- */
-void
-scm_i_sweep_segment (scm_t_heap_segment *seg,
-		     scm_t_sweep_statistics *sweep_stats)
-{
-  scm_t_sweep_statistics sweep;
-  scm_t_cell * p = seg->next_free_card;
-
-  scm_i_sweep_statistics_init (sweep_stats);
-
-  scm_i_sweep_statistics_init (&sweep);
-  while (scm_i_sweep_some_cards (seg, &sweep) != SCM_EOL)
-    {
-      scm_i_sweep_statistics_sum (sweep_stats, sweep);
-      scm_i_sweep_statistics_init (&sweep);
-    }
-
-  seg->next_free_card =p;
-}
-
-void
-scm_i_sweep_all_segments (char const *reason,
-			  scm_t_sweep_statistics *sweep_stats)
-{
-  unsigned i= 0;
-
-  scm_i_sweep_statistics_init (sweep_stats);
-  for (i = 0; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_t_sweep_statistics sweep;
-
-      scm_i_sweep_segment (scm_i_heap_segment_table[i], &sweep);
-      scm_i_sweep_statistics_sum (sweep_stats, sweep);
-    }
-}
-
-
-/*
-  Heap segment table.
-
-  The table is sorted by the address of the data itself. This makes
-  for easy lookups. This is not portable: according to ANSI C,
-  pointers can only be compared within the same object (i.e. the same
-  block of malloced memory.). For machines with weird architectures,
-  this should be revised.
-  
-  (Apparently, for this reason 1.6 and earlier had macros for pointer
-  comparison. )
-  
-  perhaps it is worthwhile to remove the 2nd level of indirection in
-  the table, but this certainly makes for cleaner code.
-*/
-scm_t_heap_segment ** scm_i_heap_segment_table;
-size_t scm_i_heap_segment_table_size;
-scm_t_cell *lowest_cell;
-scm_t_cell *highest_cell; 
-
-
-void
-scm_i_clear_mark_space (void)
-{
-  int i = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
-    }
-}
-
-
-/*
-  RETURN: index of inserted segment.
- */
-int
-scm_i_insert_segment (scm_t_heap_segment * seg)
-{
-  size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
-  SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **)
-			       realloc ((char *)scm_i_heap_segment_table, size)));
-
-  /*
-    We can't alloc 4 more bytes. This is hopeless.
-   */
-  if (!scm_i_heap_segment_table)
-    {
-      fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
-      abort ();
-    }
-
-  if (!lowest_cell)
-    {
-      lowest_cell = seg->bounds[0];
-      highest_cell = seg->bounds[1];
-    }
-  else
-    {
-      lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
-      highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
-    }
-
-
-  {
-    int i = 0;
-    int j = 0;
-
-    while (i < scm_i_heap_segment_table_size
-	   && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
-      i++;
-
-    /*
-      We insert a new entry; if that happens to be before the
-      "current" segment of a freelist, we must move the freelist index
-      as well.
-    */
-    if (scm_i_master_freelist.heap_segment_idx >= i)
-      scm_i_master_freelist.heap_segment_idx ++;
-    if (scm_i_master_freelist2.heap_segment_idx >= i)
-      scm_i_master_freelist2.heap_segment_idx ++;
-
-    for (j = scm_i_heap_segment_table_size; j > i; --j)
-      scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];
-
-    scm_i_heap_segment_table [i] = seg;
-    scm_i_heap_segment_table_size ++;
-
-    return i;
-  }
-}
-
-SCM
-scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl,
-			   scm_t_sweep_statistics *sweep_stats)
-{
-  int i = fl->heap_segment_idx;
-  SCM collected = SCM_EOL;
-
-  scm_i_sweep_statistics_init (sweep_stats);
-  if (i == -1)
-    i++;
-
-  for (;
-       i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_t_sweep_statistics sweep;
-
-      if (scm_i_heap_segment_table[i]->freelist != fl)
-	continue;
-
-      scm_i_sweep_statistics_init (&sweep);
-      collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
-					  &sweep);
-
-      scm_i_sweep_statistics_sum (sweep_stats, sweep);
-
-      if (collected != SCM_EOL)       /* Don't increment i */
-	break;
-    }
-
-  fl->heap_segment_idx = i;
-
-  return collected;
-}
-
-
-void
-scm_i_reset_segments (void)
-{
-  int i = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
-      seg->next_free_card = seg->bounds[0];
-    }
-}
-
-/*
-  Return a hashtab with counts of live objects, with tags as keys.
- */
-
-
-SCM
-scm_i_all_segments_statistics (SCM tab)
-{
-  int i = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
-      scm_i_heap_segment_statistics (seg, tab);
-    }
-
-  return tab;
-}
-
-
-
-
-/*
-  Determine whether the given value does actually represent a cell in
-  some heap segment.  If this is the case, the number of the heap
-  segment is returned.  Otherwise, -1 is returned.  Binary search is
-  used to determine the heap segment that contains the cell.
-
-
-  I think this function is too long to be inlined. --hwn
-*/
-long int
-scm_i_find_heap_segment_containing_object (SCM obj)
-{
-  if (!CELL_P (obj))
-    return -1;
-
-  if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell)
-    return -1;
-
-  
-    {
-      scm_t_cell *  ptr = SCM2PTR (obj);
-      unsigned long int i = 0;
-      unsigned long int j = scm_i_heap_segment_table_size - 1;
-
-      if (ptr < scm_i_heap_segment_table[i]->bounds[0])
-	return -1;
-      else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
-	return -1;
-      else
-	{
-	  while (i < j)
-	    {
-	      if (ptr < scm_i_heap_segment_table[i]->bounds[1])
-		{
-		  break;
-		}
-	      else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
-		{
-		  i = j;
-		  break;
-		}
-	      else
-		{
-		  unsigned long int k = (i + j) / 2;
-
-		  if (k == i)
-		    return -1;
-		  else if (ptr <  scm_i_heap_segment_table[k]->bounds[1])
-		    {
-		      j = k;
-		      ++i;
-		      if (ptr <  scm_i_heap_segment_table[i]->bounds[0])
-			return -1;
-		    }
-		  else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
-		    {
-		      i = k;
-		      --j;
-		      if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
-			return -1;
-		    }
-		}
-	    }
-
-	  if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
-	    return -1;
-	  else if (SCM_GC_IN_CARD_HEADERP (ptr))
-	    return -1;
-	  else
-	    return i;
-	}
-    }
-}
-
-
 /* Important entry point: try to grab some memory, and make it into a
    segment; return the index of the segment.  SWEEP_STATS should contain
-   global GC sweep statistics collected since the last full GC.  */
+   global GC sweep statistics collected since the last full GC.
+
+   Returns the index of the segment.  If error_policy !=
+   abort_on_error, we return -1 on failure.
+*/
 int
 scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
-			    scm_t_sweep_statistics sweep_stats,
+			    size_t len,
 			    policy_on_error error_policy)
 {
-  size_t len;
-
-  {
-    /* Assure that the new segment is predicted to be large enough.
-     *
-     * New yield should at least equal GC fraction of new heap size, i.e.
-     *
-     *   y + dh > f * (h + dh)
-     *
-     *    y : yield
-     *    f : min yield fraction
-     *    h : heap size
-     *   dh : size of new heap segment
-     *
-     * This gives dh > (f * h - y) / (1 - f)
-     */
-    float f = freelist->min_yield_fraction / 100.0;
-    float h = SCM_HEAP_SIZE;
-    float min_cells = (f * h - sweep_stats.collected) / (1.0 - f);
-
-    /* Make heap grow with factor 1.5 */
-    len =  freelist->heap_size / 2;
-#ifdef DEBUGINFO
-    fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells);
-#endif
-
-    if (len < min_cells)
-      len = (unsigned long) min_cells;  
-    len *= sizeof (scm_t_cell);
-    /* force new sampling */
-    freelist->collected = LONG_MAX;
-  }
-
   if (len > scm_max_segment_size)
     len = scm_max_segment_size;
+
   if (len < SCM_MIN_HEAP_SEG_SIZE)
     len = SCM_MIN_HEAP_SEG_SIZE;
 
+  /* todo: consider having a more flexible lower bound. */
   {
-    scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
+    scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist);
 
     /* Allocate with decaying ambition. */
     while (len >= SCM_MIN_HEAP_SEG_SIZE)
       {
 	if (scm_i_initialize_heap_segment_data (seg, len))
-	  {
+	  return scm_i_insert_segment (seg);
-	    return scm_i_insert_segment (seg);
-	  }
 	
 	len /= 2;
       }
@@ -534,30 +66,208 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
   return -1;
 }
 
-void
-scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist)
-{
-  scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
 
-  if (init_heap_size < 1)
+scm_t_heap_segment *
+scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
+{
+  scm_t_heap_segment *shs = calloc (1, sizeof (scm_t_heap_segment));
+
+  if (!shs)
     {
-      init_heap_size =  SCM_DEFAULT_INIT_HEAP_SIZE_1;
+      fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
+      abort ();
     }
- 
+  
-  if (scm_i_initialize_heap_segment_data (seg, init_heap_size))
+  shs->span = fl->span;
+  shs->freelist  = fl;
+  
+  return shs;
+}
+
+void
+scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab)
+{
+  scm_t_cell *p = seg->bounds[0];
+  while (p <  seg->bounds[1])
     {
-      freelist->heap_segment_idx = scm_i_insert_segment (seg);
+      scm_i_card_statistics (p, tab, seg); 
+      p += SCM_GC_CARD_N_CELLS;
     }
+}
+
+/*
+  count number of marked bits, so we know how much cells are live.
+ */
+int
+scm_i_heap_segment_marked_count (scm_t_heap_segment *seg)
+{
+  scm_t_c_bvec_long *bvec = (scm_t_c_bvec_long *) seg->bounds[1];
+  scm_t_c_bvec_long *bvec_end =
+    (bvec +
+     scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
+  
+  int count = 0;
+  while (bvec < bvec_end)
+    {
+      count += scm_i_uint_bit_count (*bvec);
+      bvec ++;
+    }
+  return count * seg->span;
+}
+
+int
+scm_i_segment_card_number (scm_t_heap_segment *seg,
+			   scm_t_cell *card)
+{
+  return (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
+}
+
+/*
+  Fill SEGMENT with memory both for data and mark bits.
+
+  RETURN: 1 on success, 0 failure  
+ */
+int 
+scm_i_initialize_heap_segment_data (scm_t_heap_segment *segment, size_t requested)
+{
+  /*
+    round upwards
+   */
+  int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
+  int card_count = 1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count; 
 
   /*
-    Why the fuck  try twice? --hwn
+    one card extra due to alignment
+  */
+  size_t mem_needed = (1 + card_count) * SCM_GC_SIZEOF_CARD
+    + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG;
+  scm_t_cell *memory = 0;
+
+  /*
+    We use calloc to alloc the heap, so it is nicely initialized.
    */
-  if (!seg->malloced)
+  SCM_SYSCALL (memory = (scm_t_cell *) calloc (1, mem_needed));
+
+  if (memory == NULL)
+    return 0;
+
+  segment->malloced = memory;
+  segment->bounds[0] = SCM_GC_CARD_UP (memory);
+  segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
+  segment->freelist->heap_total_cells += scm_i_segment_cell_count (segment);
+
+  /*
+    Don't init the mem or the bitvector. This is handled by lazy
+    sweeping.
+  */
+  segment->next_free_card = segment->bounds[0];
+  segment->first_time = 1;
+  return 1;
+}
+
+int
+scm_i_segment_card_count (scm_t_heap_segment *seg)
+{
+  return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
+}
+
+/*
+  Return the number of available single-cell data cells. 
+ */
+int
+scm_i_segment_cell_count (scm_t_heap_segment *seg)
+{
+  return scm_i_segment_card_count (seg)
+    * scm_i_segment_cells_per_card (seg);
+}
+
+int
+scm_i_segment_cells_per_card (scm_t_heap_segment *seg)
+{
+  return (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS
+	  + ((seg->span == 2) ? -1 : 0));
+}
+
+void
+scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
+{
+  scm_t_cell *markspace = seg->bounds[1];
+
+  memset (markspace, 0x00,
+	  scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
+}
+
+
+/*
+  Force a sweep of this entire segment.
+ */
+void
+scm_i_sweep_segment (scm_t_heap_segment *seg,
+		     scm_t_sweep_statistics *sweep_stats)
+{
+  int infinity = 1 << 30;
+  scm_t_cell *remember = seg->next_free_card;  
+  while (scm_i_sweep_some_cards (seg, sweep_stats, infinity) != SCM_EOL)
+    ;
+  seg->next_free_card = remember;
+}
+
+
+/* Sweep cards from SEG until we've gathered THRESHOLD cells.  On
+   return, SWEEP_STATS, if non-NULL, contains the number of cells that
+   have been visited and collected.  A freelist is returned,
+   potentially empty.  */
+SCM
+scm_i_sweep_some_cards (scm_t_heap_segment *seg,
+			scm_t_sweep_statistics *sweep_stats,
+			int threshold)
+{
+  SCM cells = SCM_EOL;
+  int collected = 0;
+  int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment *)
+    = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;
+
+  scm_t_cell *next_free = seg->next_free_card;
+  int cards_swept = 0;
+  while (collected < threshold && next_free < seg->bounds[1])
     {
-      scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE);
+      collected += (*sweeper) (next_free, &cells, seg);
+      next_free += SCM_GC_CARD_N_CELLS;
+      cards_swept ++;
     }
 
-  if (freelist->min_yield_fraction)
+  if (sweep_stats != NULL)
-    freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction
+    {
-			    / 100);
+      int swept = cards_swept 
+	* ((SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
+	   - seg->span + 1);
+      int collected_cells = collected * seg->span;
+      sweep_stats->swept += swept;
+      sweep_stats->collected += collected_cells;
+    }
+  
+  if (next_free == seg->bounds[1])
+    {
+      seg->first_time = 0;
+    }
+
+  seg->next_free_card = next_free;
+  return cells;
 }
+
+
+
+SCM
+scm_i_sweep_for_freelist (scm_t_cell_type_statistics *freelist)
+{
+  scm_t_sweep_statistics stats = { 0 };
+  SCM result = scm_i_sweep_some_segments (freelist, &stats);
+
+  scm_i_gc_sweep_stats.collected += stats.collected;
+  scm_i_gc_sweep_stats.swept += stats.swept;
+
+  freelist->collected += stats.collected;
+  freelist->swept += stats.swept; 
+  return result;
+}
+

libguile/gc.c

@@ -15,8 +15,6 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
-#define _GNU_SOURCE
-
 /* #define DEBUGINFO */
 
 #if HAVE_CONFIG_H
@@ -210,18 +208,17 @@ unsigned long scm_mtrigger;
 unsigned long scm_cells_allocated = 0;
 unsigned long scm_last_cells_allocated = 0;
 unsigned long scm_mallocated = 0;
-
+long int scm_i_find_heap_calls = 0;
 /* Global GC sweep statistics since the last full GC.  */
-static scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 };
+scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 };
-static scm_t_sweep_statistics scm_i_gc_sweep_stats_1 = { 0, 0 };
 
 /* Total count of cells marked/swept.  */
 static double scm_gc_cells_marked_acc = 0.;
+static double scm_gc_cells_marked_conservatively_acc = 0.;
 static double scm_gc_cells_swept_acc = 0.;
 static double scm_gc_cells_allocated_acc = 0.;
 
 static unsigned long scm_gc_time_taken = 0;
-static unsigned long t_before_gc;
 static unsigned long scm_gc_mark_time_taken = 0;
 
 static unsigned long scm_gc_times = 0;
@@ -243,6 +240,7 @@ SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken");
 SCM_SYMBOL (sym_gc_mark_time_taken, "gc-mark-time-taken");
 SCM_SYMBOL (sym_times, "gc-times");
 SCM_SYMBOL (sym_cells_marked, "cells-marked");
+SCM_SYMBOL (sym_cells_marked_conservatively, "cells-marked-conservatively");
 SCM_SYMBOL (sym_cells_swept, "cells-swept");
 SCM_SYMBOL (sym_malloc_yield, "malloc-yield");
 SCM_SYMBOL (sym_cell_yield, "cell-yield");
@@ -318,50 +316,43 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
   unsigned long int local_protected_obj_count;
   double local_scm_gc_cells_swept;
   double local_scm_gc_cells_marked;
+  double local_scm_gc_cells_marked_conservatively;
   double local_scm_total_cells_allocated;
   SCM answer;
   unsigned long *bounds = 0;
-  int table_size = scm_i_heap_segment_table_size;  
+  int table_size = 0;
   SCM_CRITICAL_SECTION_START;
 
-  /*
+  bounds = scm_i_segment_table_info (&table_size);
-    temporarily store the numbers, so as not to cause GC.
-   */
- 
-  bounds = malloc (sizeof (unsigned long)  * table_size * 2);
-  if (!bounds)
-    abort();
-  for (i = table_size; i--; )
-    {
-      bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0];
-      bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1];
-    }
-
 
   /* Below, we cons to produce the resulting list.  We want a snapshot of
    * the heap situation before consing.
    */
   local_scm_mtrigger = scm_mtrigger;
   local_scm_mallocated = scm_mallocated;
-  local_scm_heap_size = SCM_HEAP_SIZE;
+  local_scm_heap_size =
+    (scm_i_master_freelist.heap_total_cells + scm_i_master_freelist2.heap_total_cells);
 
-  local_scm_cells_allocated = scm_cells_allocated;
+  local_scm_cells_allocated =
+    scm_cells_allocated + scm_i_gc_sweep_stats.collected;
   
   local_scm_gc_time_taken = scm_gc_time_taken;
   local_scm_gc_mark_time_taken = scm_gc_mark_time_taken;
   local_scm_gc_times = scm_gc_times;
   local_scm_gc_malloc_yield_percentage = scm_gc_malloc_yield_percentage;
-  local_scm_gc_cell_yield_percentage=  scm_gc_cell_yield_percentage;
+  local_scm_gc_cell_yield_percentage = scm_gc_cell_yield_percentage;
   local_protected_obj_count = protected_obj_count;
   local_scm_gc_cells_swept =
     (double) scm_gc_cells_swept_acc
     + (double) scm_i_gc_sweep_stats.swept;
   local_scm_gc_cells_marked = scm_gc_cells_marked_acc 
-    +(double) scm_i_gc_sweep_stats.swept
+    + (double) scm_i_gc_sweep_stats.swept
-    -(double) scm_i_gc_sweep_stats.collected;
+    - (double) scm_i_gc_sweep_stats.collected;
+  local_scm_gc_cells_marked_conservatively
+    = scm_gc_cells_marked_conservatively_acc;
 
   local_scm_total_cells_allocated = scm_gc_cells_allocated_acc
-    + (double) (scm_cells_allocated - scm_last_cells_allocated);
+    + (double) scm_i_gc_sweep_stats.collected;
   
   for (i = table_size; i--;)
     {
@@ -369,6 +360,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
 				      scm_from_ulong (bounds[2*i+1])),
 			    heap_segs);
     }
+  
   /* njrev: can any of these scm_cons's or scm_list_n signal a memory
      error?  If so we need a frame here. */
   answer =
@@ -380,6 +372,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
 			  scm_from_double (local_scm_total_cells_allocated)),
 		scm_cons (sym_heap_size,
 			  scm_from_ulong (local_scm_heap_size)),
+		scm_cons (sym_cells_marked_conservatively,
+			  scm_from_ulong (local_scm_gc_cells_marked_conservatively)),
 		scm_cons (sym_mallocated,
 			  scm_from_ulong (local_scm_mallocated)),
 		scm_cons (sym_mtrigger,
@@ -393,13 +387,12 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
 		scm_cons (sym_cells_swept,
 			  scm_from_double (local_scm_gc_cells_swept)),
 		scm_cons (sym_malloc_yield,
-			  scm_from_long(local_scm_gc_malloc_yield_percentage)),
+			  scm_from_long (local_scm_gc_malloc_yield_percentage)),
 		scm_cons (sym_cell_yield,
 			  scm_from_long (local_scm_gc_cell_yield_percentage)),
 		scm_cons (sym_protected_objects,
 			  scm_from_ulong (local_protected_obj_count)),
 		scm_cons (sym_heap_segments, heap_segs),
-		
 		SCM_UNDEFINED);
   SCM_CRITICAL_SECTION_END;
   
@@ -408,63 +401,27 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
 }
 #undef FUNC_NAME
 
-/* Update the global sweeping/collection statistics by adding SWEEP_STATS to
+/*
-   SCM_I_GC_SWEEP_STATS and updating related variables.  */
+  Update nice-to-know-statistics.
-static inline void
+ */
-gc_update_stats (scm_t_sweep_statistics sweep_stats)
+static void
+gc_end_stats ()
 {
   /* CELLS SWEPT is another word for the number of cells that were examined
      during GC. YIELD is the number that we cleaned out. MARKED is the number
      that weren't cleaned.  */
-
+  scm_gc_cell_yield_percentage = (scm_i_gc_sweep_stats.collected * 100) /
-  scm_gc_cell_yield_percentage = (sweep_stats.collected * 100) / SCM_HEAP_SIZE;
+    (scm_i_master_freelist.heap_total_cells + scm_i_master_freelist2.heap_total_cells);
-
-  scm_i_sweep_statistics_sum (&scm_i_gc_sweep_stats, sweep_stats);
-
-  if ((scm_i_gc_sweep_stats.collected > scm_i_gc_sweep_stats.swept)
-      || (scm_cells_allocated < sweep_stats.collected))
-    {
-      printf ("internal GC error, please report to `"
-	      PACKAGE_BUGREPORT "'\n");
-      abort ();
-    }
 
   scm_gc_cells_allocated_acc +=
-    (double) (scm_cells_allocated - scm_last_cells_allocated);
+    (double) scm_i_gc_sweep_stats.collected;
-
+  scm_gc_cells_marked_acc += (double) scm_cells_allocated;
-  scm_cells_allocated -= sweep_stats.collected;
+  scm_gc_cells_marked_conservatively_acc += (double) scm_i_find_heap_calls;
-  scm_last_cells_allocated = scm_cells_allocated;
-}
-
-static void
-gc_start_stats (const char *what SCM_UNUSED)
-{
-  t_before_gc = scm_c_get_internal_run_time ();
-
-  scm_gc_malloc_collected = 0;
-}
-
-static void
-gc_end_stats (scm_t_sweep_statistics sweep_stats)
-{
-  unsigned long t = scm_c_get_internal_run_time ();
-
-  scm_gc_time_taken += (t - t_before_gc);
-
-  /* Reset the number of cells swept/collected since the last full GC.  */
-  scm_i_gc_sweep_stats_1 = scm_i_gc_sweep_stats;
-  scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0;
-
-  gc_update_stats (sweep_stats);
-
-  scm_gc_cells_marked_acc += (double) scm_i_gc_sweep_stats.swept
-    - (double) scm_i_gc_sweep_stats.collected;
   scm_gc_cells_swept_acc += (double) scm_i_gc_sweep_stats.swept;
 
   ++scm_gc_times;
 }
 
-
 SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
             (SCM obj),
 	    "Return an integer that for the lifetime of @var{obj} is uniquely\n"
@@ -511,58 +468,50 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
 {
   SCM cell;
   int did_gc = 0;
-  scm_t_sweep_statistics sweep_stats;
 
   scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
   scm_gc_running_p = 1;
-
+  
-  *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
+  *free_cells = scm_i_sweep_for_freelist (freelist);
-  gc_update_stats (sweep_stats);
+  if (*free_cells == SCM_EOL)
-
-  if (*free_cells == SCM_EOL && scm_i_gc_grow_heap_p (freelist))
     {
-      freelist->heap_segment_idx =
+      float delta = scm_i_gc_heap_size_delta (freelist);
-	scm_i_get_new_heap_segment (freelist,
+      if (delta > 0.0)
-				    scm_i_gc_sweep_stats,
+	{
-				    abort_on_error);
+	  size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell);
+	  freelist->heap_segment_idx =
+	    scm_i_get_new_heap_segment (freelist, bytes, abort_on_error);
 
-      *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
+	  *free_cells = scm_i_sweep_for_freelist (freelist);
-      gc_update_stats (sweep_stats);
+	}
     }
-
+  
   if (*free_cells == SCM_EOL)
     {
-      /*
-	with the advent of lazy sweep, GC yield is only known just
-	before doing the GC.
-      */
-      scm_i_adjust_min_yield (freelist,
-			      scm_i_gc_sweep_stats,
-			      scm_i_gc_sweep_stats_1);
-
       /*
 	out of fresh cells. Try to get some new ones.
        */
-
+      char reason[] = "0-cells";
+      reason[0] += freelist->span;
+      
       did_gc = 1;
-      scm_i_gc ("cells");
+      scm_i_gc (reason);
 
-      *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
+      *free_cells = scm_i_sweep_for_freelist (freelist);
-      gc_update_stats (sweep_stats);
     }
   
   if (*free_cells == SCM_EOL)
     {
       /*
 	failed getting new cells. Get new juice or die.
-       */
+      */
+      float delta = scm_i_gc_heap_size_delta (freelist);
+      assert (delta > 0.0);
+      size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell);
       freelist->heap_segment_idx =
-	scm_i_get_new_heap_segment (freelist,
+	scm_i_get_new_heap_segment (freelist, bytes, abort_on_error);
-				    scm_i_gc_sweep_stats,
-				    abort_on_error);
 
-      *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
+      *free_cells = scm_i_sweep_for_freelist (freelist);
-      gc_update_stats (sweep_stats);
     }
   
   if (*free_cells == SCM_EOL)
@@ -588,46 +537,9 @@ scm_t_c_hook scm_before_sweep_c_hook;
 scm_t_c_hook scm_after_sweep_c_hook;
 scm_t_c_hook scm_after_gc_c_hook;
 
-/* Must be called while holding scm_i_sweep_mutex.
+static void
- */
+scm_check_deprecated_memory_return ()
-
-void
-scm_i_gc (const char *what)
 {
-  scm_t_sweep_statistics sweep_stats;
-
-  scm_i_thread_put_to_sleep ();
-
-  scm_c_hook_run (&scm_before_gc_c_hook, 0);
-
-#ifdef DEBUGINFO
-  fprintf (stderr,"gc reason %s\n", what);
-  
-  fprintf (stderr,
-	   scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist))
-	   ? "*"
-	   : (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
-#endif
-
-  gc_start_stats (what);
-
-  /*
-    Set freelists to NULL so scm_cons() always triggers gc, causing
-    the assertion above to fail.
-  */
-  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
-  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
-  
-  /*
-    Let's finish the sweep. The conservative GC might point into the
-    garbage, and marking that would create a mess.
-   */
-  scm_i_sweep_all_segments ("GC", &sweep_stats);
-
-  /* Invariant: the number of cells collected (i.e., freed) must always be
-     lower than or equal to the number of cells "swept" (i.e., visited).  */
-  assert (sweep_stats.collected <= sweep_stats.swept);
-
   if (scm_mallocated < scm_i_deprecated_memory_return)
     {
       /* The byte count of allocated objects has underflowed.  This is
@@ -642,14 +554,68 @@ scm_i_gc (const char *what)
       abort ();
     }
   scm_mallocated -= scm_i_deprecated_memory_return;
+  scm_i_deprecated_memory_return = 0;
+}
 
+/* Must be called while holding scm_i_sweep_mutex.
+
+   This function is fairly long, but it touches various global
+   variables. To not obscure the side effects on global variables,
+   this function has not been split up.
+ */
+void
+scm_i_gc (const char *what)
+{
+  unsigned long t_before_gc = 0;
   
-  /* Mark */
+  scm_i_thread_put_to_sleep ();
+  
+  scm_c_hook_run (&scm_before_gc_c_hook, 0);
 
+#ifdef DEBUGINFO
+  fprintf (stderr,"gc reason %s\n", what);
+  fprintf (stderr,
+	   scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist))
+	   ? "*"
+	   : (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
+#endif
+
+  t_before_gc = scm_c_get_internal_run_time ();
+  scm_gc_malloc_collected = 0;
+
+  /*
+    Set freelists to NULL so scm_cons () always triggers gc, causing
+    the assertion above to fail.
+  */
+  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
+  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
+  
+  /*
+    Let's finish the sweep. The conservative GC might point into the
+    garbage, and marking that would create a mess.
+   */
+  scm_i_sweep_all_segments ("GC", &scm_i_gc_sweep_stats);
+  scm_check_deprecated_memory_return ();
+
+  /* Sanity check our numbers. */
+
+  /* If this was not true, someone touched mark bits outside of the
+     mark phase. */
+  assert (scm_cells_allocated == scm_i_marked_count ());
+  assert (scm_i_gc_sweep_stats.swept
+	  == (scm_i_master_freelist.heap_total_cells
+	      + scm_i_master_freelist2.heap_total_cells));
+  assert (scm_i_gc_sweep_stats.collected + scm_cells_allocated
+	  == scm_i_gc_sweep_stats.swept);
+
+  /* Mark */
   scm_c_hook_run (&scm_before_mark_c_hook, 0);
+
   scm_mark_all ();
   scm_gc_mark_time_taken += (scm_c_get_internal_run_time () - t_before_gc);
 
+  scm_cells_allocated = scm_i_marked_count ();
+ 
   /* Sweep
 
     TODO: the after_sweep hook should probably be moved to just before
@@ -675,18 +641,36 @@ scm_i_gc (const char *what)
     distinct classes of hook functions since this can prevent some
     bad interference when several modules adds gc hooks.
    */
-
   scm_c_hook_run (&scm_before_sweep_c_hook, 0);
-  scm_gc_sweep ();
-  scm_c_hook_run (&scm_after_sweep_c_hook, 0);
-
-  gc_end_stats (sweep_stats);
-
-  scm_i_thread_wake_up ();
 
+  /*
+    Nothing here: lazy sweeping.
+   */
+  scm_i_reset_segments ();
+  
+  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
+  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
+
+  /* Invalidate the freelists of other threads. */
+  scm_i_thread_invalidate_freelists ();
+
+  scm_c_hook_run (&scm_after_sweep_c_hook, 0);
+
+  gc_end_stats ();
+
+  scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0;
+  scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist);
+  scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2);
+  
+  /* Arguably, this statistic is fairly useless: marking will dominate
+     the time taken.
+  */
+  scm_gc_time_taken += (scm_c_get_internal_run_time () - t_before_gc);
+    
+  scm_i_thread_wake_up ();
   /*
     For debugging purposes, you could do
-    scm_i_sweep_all_segments("debug"), but then the remains of the
+    scm_i_sweep_all_segments ("debug"), but then the remains of the
     cell aren't left to analyse.
    */
 }
@@ -790,7 +774,7 @@ scm_permanent_object (SCM obj)
 */
 
 /* Implementation note:  For every object X, there is a counter which
-   scm_gc_protect_object(X) increments and scm_gc_unprotect_object(X) decrements.
+   scm_gc_protect_object (X) increments and scm_gc_unprotect_object (X) decrements.
 */
 
 
@@ -965,11 +949,9 @@ scm_init_storage ()
   while (j)
     scm_sys_protects[--j] = SCM_BOOL_F;
 
-  scm_gc_init_freelist();
+  scm_gc_init_freelist ();
   scm_gc_init_malloc ();
 
-  j = SCM_HEAP_SEG_SIZE;
-  
 #if 0
   /* We can't have a cleanup handler since we have no thread to run it
      in. */
@@ -1089,7 +1071,7 @@ void *
 scm_ia64_ar_bsp (const void *ctx)
 {
   uint64_t bsp;
-  __uc_get_ar_bsp(ctx, &bsp);
+  __uc_get_ar_bsp (ctx, &bsp);
   return (void *) bsp;
 }
 # endif /* hpux */
@@ -1114,21 +1096,6 @@ void
 scm_gc_sweep (void)
 #define FUNC_NAME "scm_gc_sweep"
 {
-  scm_i_deprecated_memory_return = 0;
-
-  scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist);
-  scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2);
-
-  /*
-    NOTHING HERE: LAZY SWEEPING ! 
-   */
-  scm_i_reset_segments ();
-  
-  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
-  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
-
-  /* Invalidate the freelists of other threads. */
-  scm_i_thread_invalidate_freelists ();
 }
 
 #undef FUNC_NAME

libguile/gc.h

@@ -3,7 +3,7 @@
 #ifndef SCM_GC_H
 #define SCM_GC_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -155,6 +155,8 @@ typedef unsigned long scm_t_c_bvec_long;
 
 /* testing and changing GC marks */
 #define SCM_GC_MARK_P(x)   SCM_GC_CELL_GET_BIT (x)
+
+void ensure_marking(void);
 #define SCM_SET_GC_MARK(x) SCM_GC_CELL_SET_BIT (x)
 #define SCM_CLEAR_GC_MARK(x) SCM_GC_CELL_CLEAR_BIT (x)
 
@@ -241,10 +243,10 @@ SCM_API int scm_debug_cells_gc_interval ;
 void scm_i_expensive_validation_check (SCM cell);
 #endif
 
-SCM_API scm_i_pthread_mutex_t scm_i_gc_admin_mutex;
+SCM_INTERNAL scm_i_pthread_mutex_t scm_i_gc_admin_mutex;
 
 #define scm_gc_running_p (SCM_I_CURRENT_THREAD->gc_running_p)
-SCM_API scm_i_pthread_mutex_t scm_i_sweep_mutex;
+SCM_INTERNAL scm_i_pthread_mutex_t scm_i_sweep_mutex;
 
 #ifdef __ia64__
 void *scm_ia64_register_backing_store_base (void);
@@ -283,8 +285,6 @@ SCM_API int scm_gc_malloc_yield_percentage;
 SCM_API unsigned long scm_mallocated;
 SCM_API unsigned long scm_mtrigger;
 
-
-
 SCM_API SCM scm_after_gc_hook;
 
 SCM_API scm_t_c_hook scm_before_gc_c_hook;
@@ -320,7 +320,7 @@ SCM_API SCM scm_gc_live_object_stats (void);
 SCM_API SCM scm_gc (void);
 SCM_API void scm_gc_for_alloc (struct scm_t_cell_type_statistics *freelist);
 SCM_API SCM scm_gc_for_newcell (struct scm_t_cell_type_statistics *master, SCM *freelist);
-SCM_API void scm_i_gc (const char *what);
+SCM_INTERNAL void scm_i_gc (const char *what);
 SCM_API void scm_gc_mark (SCM p);
 SCM_API void scm_gc_mark_dependencies (SCM p);
 SCM_API void scm_mark_locations (SCM_STACKITEM x[], unsigned long n);
@@ -384,7 +384,7 @@ SCM_API void scm_gc_unregister_roots (SCM *b, unsigned long n);
 SCM_API void scm_storage_prehistory (void);
 SCM_API int scm_init_storage (void);
 SCM_API void *scm_get_stack_base (void);
-SCM_API void scm_init_gc (void);
+SCM_INTERNAL void scm_init_gc (void);
 
 #if SCM_ENABLE_DEPRECATED == 1
 

libguile/gc_os_dep.c

@@ -1008,19 +1008,18 @@ scm_get_stack_base ()
 
 # ifdef MIPS
 #   define MACH_TYPE "MIPS"
-/* #   define STACKBOTTOM ((ptr_t)0x7fff8000)  sometimes also works.  */
 #   ifdef LINUX
-      /* This was developed for a linuxce style platform.  Probably	*/
+#       define CPP_WORDSZ _MIPS_SZPTR
-      /* needs to be tweaked for workstation class machines.		*/
+#       define OS_TYPE "LINUX"
-#     define OS_TYPE "LINUX"
+#       define ALIGNMENT 4
-      extern int __data_start;
+#       define ALIGN_DOUBLE
-#     define DATASTART ((ptr_t)(&__data_start))
+        extern int _fdata;
-#     define ALIGNMENT 4
+#       define DATASTART ((ptr_t)(&_fdata))
-#     define USE_GENERIC_PUSH_REGS 1
+        extern int _end;
-#     define STACKBOTTOM 0x80000000
+#       define DATAEND ((ptr_t)(&_end))
-	/* In many cases, this should probably use LINUX_STACKBOTTOM 	*/
+#       define STACKBOTTOM ((ptr_t)0x7fff8000)
-	/* instead. But some kernel versions seem to give the wrong	*/
+#       define USE_GENERIC_PUSH_REGS 1
-	/* value from /proc.						*/
+#       define DYNAMIC_LOADING
 #   endif /* Linux */
 #   ifdef ULTRIX
 #	define HEURISTIC2

libguile/gdbint.h

@@ -3,7 +3,7 @@
 #ifndef SCM_GDBINT_H
 #define SCM_GDBINT_H
 
-/* Copyright (C) 1996,2000, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -28,7 +28,7 @@
 
 SCM_API int scm_print_carefully_p;
 
-SCM_API void scm_init_gdbint (void);
+SCM_INTERNAL void scm_init_gdbint (void);
 
 #endif  /* SCM_GDBINT_H */
 

libguile/gen-scmconfig.c

@@ -121,7 +121,7 @@
 #  include <config.h>
 #endif
 
-#include "gen-scmconfig.h"
+#include <libguile/gen-scmconfig.h>
 
 #include <stdio.h>
 #include <string.h>
@@ -387,6 +387,19 @@ main (int argc, char *argv[])
   pf ("#define SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER %d /* 0 or 1 */\n",
       SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER);
 
+  pf ("\n\n/*** File system access ***/\n");
+
+  pf ("/* Define to 1 if `struct dirent64' is available.  */\n");
+  pf ("#define SCM_HAVE_STRUCT_DIRENT64 %d /* 0 or 1 */\n",
+      SCM_I_GSC_HAVE_STRUCT_DIRENT64);
+
+  pf ("/* Define to 1 if `readdir64_r ()' is available.  */\n");
+#ifdef HAVE_READDIR64_R
+  pf ("#define SCM_HAVE_READDIR64_R 1 /* 0 or 1 */\n");
+#else
+  pf ("#define SCM_HAVE_READDIR64_R 0 /* 0 or 1 */\n");
+#endif
+
 #if USE_DLL_IMPORT
   pf ("\n");
   pf ("/* Define some additional CPP macros on Win32 platforms. */\n");

libguile/gen-scmconfig.h.in

@@ -30,6 +30,7 @@
 #define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@
 #define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT@
 #define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER@
+#define SCM_I_GSC_HAVE_STRUCT_DIRENT64 @SCM_I_GSC_HAVE_STRUCT_DIRENT64@
 
 /*
   Local Variables:

libguile/gettext.h

@@ -3,7 +3,7 @@
 #ifndef SCM_GETTEXT_H
 #define SCM_GETTEXT_H
 
-/* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -28,9 +28,9 @@ SCM_API SCM scm_textdomain (SCM domainname);
 SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory);
 SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding);
 
-SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all);
+SCM_INTERNAL int scm_i_to_lc_category (SCM category, int allow_lc_all);
 
-SCM_API void scm_init_gettext (void);
+SCM_INTERNAL void scm_init_gettext (void);
 
 #endif  /* SCM_GETTEXT_H */
 

libguile/goops.c

@@ -25,6 +25,7 @@
  */
 
 #include <stdio.h>
+#include <assert.h>
 
 #include "libguile/_scm.h"
 #include "libguile/alist.h"
@@ -1705,11 +1706,10 @@ go_to_hell (void *o)
 {
   SCM obj = SCM_PACK ((scm_t_bits) o);
   scm_lock_mutex (hell_mutex);
-  if (n_hell == hell_size)
+  if (n_hell >= hell_size)
     {
-      long new_size = 2 * hell_size;
+      hell_size *= 2;
-      hell = scm_realloc (hell, new_size);
+      hell = scm_realloc (hell, hell_size * sizeof(*hell));
-      hell_size = new_size;
     }
   hell[n_hell++] = SCM_STRUCT_DATA (obj);
   scm_unlock_mutex (hell_mutex);
@@ -2995,7 +2995,7 @@ scm_init_goops_builtins (void)
 
   list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method));
 
-  hell = scm_malloc (hell_size);
+  hell = scm_calloc (hell_size * sizeof (*hell));
   hell_mutex = scm_permanent_object (scm_make_mutex ());
 
   create_basic_classes ();

libguile/goops.h

@@ -3,7 +3,7 @@
 #ifndef SCM_GOOPS_H
 #define SCM_GOOPS_H
 
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -254,7 +254,8 @@ SCM_API SCM scm_pure_generic_p (SCM obj);
 #endif
 
 SCM_API SCM scm_sys_compute_slots (SCM c);
-SCM_API SCM scm_i_get_keyword (SCM key, SCM l, long len, SCM default_value, const char *subr);
+SCM_INTERNAL SCM scm_i_get_keyword (SCM key, SCM l, long len,
+				    SCM default_value, const char *subr);
 SCM_API SCM scm_get_keyword (SCM key, SCM l, SCM default_value);
 SCM_API SCM scm_sys_initialize_object (SCM obj, SCM initargs);
 SCM_API SCM scm_sys_prep_layout_x (SCM c);
@@ -297,8 +298,8 @@ SCM_API SCM scm_make (SCM args);
 SCM_API SCM scm_find_method (SCM args);
 SCM_API SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs);
 
-SCM_API SCM scm_init_goops_builtins (void);
+SCM_INTERNAL SCM scm_init_goops_builtins (void);
-SCM_API void scm_init_goops (void);
+SCM_INTERNAL void scm_init_goops (void);
 
 #if (SCM_ENABLE_DEPRECATED == 1)
 

libguile/gsubr.h

@@ -3,7 +3,7 @@
 #ifndef SCM_GSUBR_H
 #define SCM_GSUBR_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -51,7 +51,7 @@ SCM_API SCM scm_c_define_gsubr_with_generic (const char *name,
 					     SCM (*fcn) (), SCM *gf);
 
 SCM_API SCM scm_gsubr_apply (SCM args);
-SCM_API void scm_init_gsubr (void);
+SCM_INTERNAL void scm_init_gsubr (void);
 
 #endif  /* SCM_GSUBR_H */
 

libguile/guardians.h

@@ -3,7 +3,7 @@
 #ifndef SCM_GUARDIANS_H
 #define SCM_GUARDIANS_H
 
-/* Copyright (C) 1998,2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -26,11 +26,11 @@
 
 SCM_API SCM scm_make_guardian (void);
 
-SCM_API void scm_i_init_guardians_for_gc (void);
+SCM_INTERNAL void scm_i_init_guardians_for_gc (void);
-SCM_API void scm_i_identify_inaccessible_guardeds (void);
+SCM_INTERNAL void scm_i_identify_inaccessible_guardeds (void);
-SCM_API int scm_i_mark_inaccessible_guardeds (void);
+SCM_INTERNAL int scm_i_mark_inaccessible_guardeds (void);
 
-SCM_API void scm_init_guardians (void);
+SCM_INTERNAL void scm_init_guardians (void);
 
 #endif  /* SCM_GUARDIANS_H */
 

libguile/hash.h

@@ -3,7 +3,7 @@
 #ifndef SCM_HASH_H
 #define SCM_HASH_H
 
-/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -34,7 +34,7 @@ SCM_API unsigned long scm_ihashv (SCM obj, unsigned long n);
 SCM_API SCM scm_hashv (SCM obj, SCM n);
 SCM_API unsigned long scm_ihash (SCM obj, unsigned long n);
 SCM_API SCM scm_hash (SCM obj, SCM n);
-SCM_API void scm_init_hash (void);
+SCM_INTERNAL void scm_init_hash (void);
 
 #endif  /* SCM_HASH_H */