Merge branch 'stable-2.0'

Conflicts:
	GUILE-VERSION
	NEWS
	guile-readline/ice-9/readline.scm
	libguile/async.c
	libguile/backtrace.c
	libguile/deprecated.h
	libguile/gc-malloc.c
	libguile/gdbint.c
	libguile/init.c
	libguile/ioext.c
	libguile/mallocs.c
	libguile/print.c
	libguile/rw.c
	libguile/scmsigs.c
	libguile/script.c
	libguile/simpos.c
	libguile/snarf.h
	libguile/strports.c
	libguile/threads.c
	libguile/vm-i-scheme.c
	libguile/vm-i-system.c
	module/srfi/srfi-18.scm
	test-suite/Makefile.am
	test-suite/standalone/test-num2integral.c

Makefile.am

@@ -1,7 +1,8 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007,
-##        2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+##        2008, 2009, 2010, 2011, 2012, 2013,
+##        2014 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -45,6 +46,16 @@ libguileinclude_HEADERS = libguile.h
 schemelibdir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)
 schemelib_DATA = libguile/guile-procedures.txt
 
+# Our own implementation of Gnulib's lock interface.
+noinst_HEADERS = lib/glthread/lock.h
+
+# Our lib/glthreads/lock.h header indirectly includes
+# libguile/scmconfig.h.  Make sure it is built before we recurse into
+# lib/.
+BUILT_SOURCES = libguile/scmconfig.h
+libguile/scmconfig.h:
+	$(MAKE) -C libguile scmconfig.h
+
 # Build it from here so that all the modules are compiled by the time we
 # build it.
 libguile/guile-procedures.txt: libguile/guile-procedures.texi
@@ -94,7 +105,7 @@ gen-ChangeLog:
 	  mv $(distdir)/cl-t $(distdir)/ChangeLog;			\
 	fi
 
-BUILT_SOURCES = $(top_srcdir)/.version
+BUILT_SOURCES += $(top_srcdir)/.version
 $(top_srcdir)/.version:
 	echo $(VERSION) > $@-t && mv $@-t $@
 gen-tarball-version:

NEWS

@@ -378,6 +378,372 @@ longer installed to the libdir.  This change should be transparent to
 users, but packagers may be interested.
 
 
+
+Changes in 2.0.11 (since 2.0.10):
+
+This release fixes an embarrassing regression introduced in the C
+interface to SRFI-4 vectors.  See
+<https://lists.gnu.org/archive/html/guile-devel/2014-03/msg00047.html>
+for details.
+
+
+Changes in 2.0.10 (since 2.0.9):
+
+* Notable changes
+
+** New GDB extension to support Guile
+
+Guile now comes with an extension for GDB 7.8 or later (unreleased at
+the time of writing) that simplifies debugging of C code that uses
+Guile.  See "GDB Support" in the manual.
+
+** Improved integration between R6RS and native Guile exceptions
+
+R6RS exception handlers, established using 'with-exception-handler' or
+'guard', are now able to catch native Guile exceptions, which are
+automatically converted into appropriate R6RS condition objects.
+
+** Support for HTTP proxies
+
+Guile's built-in web client now honors the 'http_proxy' environment
+variable, as well as the new 'current-http-proxy' parameter.  See
+"Web Client" in the manual for details.
+
+** Lexical syntax improvements
+
+*** Support |...| symbol notation.
+
+Guile's core reader and printer now support the R7RS |...| notation
+for writing symbols with arbitrary characters, as a more portable and
+attractive alternative to Guile's native #{...}# notation.  To enable
+this notation by default, put one or both of the following in your
+~/.guile:
+
+  (read-enable  'r7rs-symbols)
+  (print-enable 'r7rs-symbols)
+
+*** Support '#true' and '#false' notation for booleans.
+
+The booleans '#t' and '#f' may now be written as '#true' and '#false'
+for improved readability, per R7RS.
+
+*** Recognize '#\escape' character name.
+
+The escape character '#\esc' may now be written as '#\escape', per R7RS.
+
+*** Accept "\|" in string literals.
+
+The pipe character may now be preceded by a backslash, per R7RS.
+
+** Custom binary input ports now support 'setvbuf'.
+
+Until now, ports returned by 'make-custom-binary-input-port' were always
+full-buffered.  Now, their buffering mode can be changed using 'setvbuf'.
+
+** SRFI-4 predicates and length accessors no longer accept arrays.
+
+Given that the SRFI-4 accessors don't work for arrays, the fact that the
+predicates and length accessors returned true for arrays was a bug.
+
+** GUILE_PROGS now supports specifying a minimum required version.
+
+The 'GUILE_PROGS' autoconf macro in guile.m4 now allows an optional
+argument to specify a minimum required Guile version.  By default, it
+requires Guile >= 2.0.  A micro version can also be specified, e.g.:
+GUILE_PROGS([2.0.10])
+
+** Error reporting improvements
+
+*** Improved run-time error reporting in (ice-9 match).
+
+If no pattern matches in a 'match' form, the datum that failed to match
+is printed along with the location of the failed 'match' invocation.
+
+*** Print the faulty object upon invalid-keyword errors.
+*** Improved error reporting of procedures defined by define-inlinable.
+*** Improved error reporting for misplaced ellipses in macro definitions.
+*** Improved error checking in 'define-public' and 'module-add!'.
+*** Improved error when 'include' form with relative path is not in a file.
+
+** Speed improvements
+
+*** 'scm_c_read' on ISO-8859-1 (e.g. binary) unbuffered ports is faster.
+*** New inline asm for VM fixnum multiply, for faster overflow checking.
+*** New inline asm for VM fixnum operations on ARM and 32-bit x86.
+*** 'positive?' and 'negative?' are now compiled to VM primitives.
+*** Numerical comparisons with more than 2 arguments are compiled to VM code.
+*** Several R6RS bitwise operators have been optimized.
+
+** Miscellaneous
+
+*** Web: 'content-disposition' headers are now supported.
+*** Web: 'uri-encode' hexadecimal percent-encoding is now uppercase.
+*** Size argument to 'make-doubly-weak-hash-table' is now optional.
+*** Timeout for 'unlock-mutex' and SRFI-18 'mutex-unlock!' may now be #f.
+
+** Gnulib update
+
+Guile's copy of Gnulib was updated to v0.1-92-g546ff82.  The following
+modules were imported from Gnulib: copysign, fsync, isfinite, link,
+lstat, mkdir, mkstemp, readlink, rename, rmdir, and unistd.
+
+* New interfaces
+
+** Cooperative REPL servers
+
+This new facility supports REPLs that run at specified times within an
+existing thread, for example in programs utilizing an event loop or in
+single-threaded programs.  This allows for safe access and mutation of
+a program's data structures from the REPL without concern for thread
+synchronization.  See "Cooperative REPL Servers" in the manual for
+details.
+
+** SRFI-43 (Vector Library)
+
+Guile now includes SRFI-43, a comprehensive library of vector operations
+analogous to the SRFI-1 list library.  See "SRFI-43" in the manual for
+details.
+
+** SRFI-64 (A Scheme API for test suites)
+
+Guile now includes SRFI-64, a flexible framework for creating test
+suites.  The reference implementation of SRFI-64 has also been updated
+to fully support earlier versions of Guile.
+
+** SRFI-111 (Boxes)
+
+See "SRFI-111" in the manual.
+
+** 'define-values'
+
+See "Binding multiple return values" in the manual.
+
+** Custom ellipsis identifiers using 'with-ellipsis' or SRFI-46.
+
+Guile now allows macro definitions to use identifiers other than '...'
+as the ellipsis.  This is convenient when writing macros that generate
+macro definitions.  The desired ellipsis identifier can be given as the
+first operand to 'syntax-rules', as specified in SRFI-46 and R7RS, or by
+using the new 'with-ellipsis' special form in procedural macros.  With
+this addition, Guile now fully supports SRFI-46.
+
+See "Specifying a Custom Ellipsis Identifier" and "Custom Ellipsis
+Identifiers for syntax-case Macros" in the manual for details.
+
+** R7RS 'syntax-error'
+
+Guile now supports 'syntax-error', as specified by R7RS, allowing for
+improved compile-time error reporting from 'syntax-rules' macros.  See
+"Reporting Syntax Errors in Macros" in the manual for details.
+
+** New procedures to convert association lists into hash tables
+
+Guile now includes the convenience procedures 'alist->hash-table',
+'alist->hashq-table', 'alist->hashv-table', and 'alist->hashx-table'.
+See "Hash Table Reference" in the manual.
+
+** New predicates: 'exact-integer?' and 'scm_is_exact_integer'
+
+See "Integers" in the manual.
+
+** 'weak-vector-length', 'weak-vector-ref', and 'weak-vector-set!'
+
+These should now be used to access weak vectors, instead of
+'vector-length', 'vector-ref', and 'vector-set!'.
+
+* Manual updates
+
+** Improve docs for 'eval-when'.
+
+Each 'eval-when' condition is now explained in detail, including
+'expand' which was previously undocumented.  (expand load eval) is now
+the recommended set of conditions, instead of (compile load eval).
+See "Eval When" in the manual, for details.
+
+** Update the section on SMOBs and memory management.
+
+See "Defining New Types (Smobs)" in the manual.
+
+** Fixes
+
+*** GOOPS: #:dsupers is the init keyword for the dsupers slot.
+*** 'unfold-right' takes a tail, not a tail generator.
+*** Clarify that 'append!' and 'reverse!' might not mutate.
+*** Fix doc that incorrectly claimed (integer? +inf.0) => #t.
+    (http://bugs.gnu.org/16356)
+*** Document that we support SRFI-62 (S-expression comments).
+*** Document that we support SRFI-87 (=> in case clauses).
+*** Document 'equal?' in the list of R6RS incompatibilities.
+*** Remove outdated documentation of LTDL_LIBRARY_PATH.
+*** Fix 'weak-vector?' doc: Weak hash tables are not weak vectors.
+*** Fix 'my-or' examples to use let-bound variable.
+    (http://bugs.gnu.org/14203)
+
+* New deprecations
+
+** General 'uniform-vector' interface
+
+This interface lacked both generality and specificity.  The general
+replacements are 'array-length', 'array-ref', and friends on the scheme
+side, and the array handle interface on the C side.  On the specific
+side of things, there are the specific bytevector, SRFI-4, and bitvector
+interfaces.
+
+** Use of the vector interface on arrays
+** 'vector-length', 'vector-ref', and 'vector-set!' on weak vectors
+** 'vector-length', 'vector-ref', and 'vector-set!' as primitive-generics
+
+Making the vector interface operate only on a single representation will
+allow future versions of Guile to compile loops involving vectors to
+more efficient native code.
+
+** 'htons', 'htonl', 'ntohs', 'ntohl'
+
+These procedures, like their C counterpart, were used to convert numbers
+to/from network byte order, typically in conjunction with the
+now-deprecated uniform vector API.
+
+This functionality is now covered by the bytevector and binary I/O APIs.
+See "Interpreting Bytevector Contents as Integers" in the manual.
+
+** 'gc-live-object-stats'
+
+It hasn't worked in the whole 2.0 series.  There is no replacement,
+unfortunately.
+
+** 'scm_c_program_source'
+
+This internal VM function was not meant to be public.  Use
+'scm_procedure_source' instead.
+
+* Build fixes
+
+** Fix build with Clang 3.4.
+
+** MinGW build fixes
+*** Do not add $(EXEEXT) to guild or guile-tools.
+*** tests: Use double quotes around shell arguments, for Windows.
+*** tests: Don't rely on $TMPDIR and /tmp on Windows.
+*** tests: Skip FFI tests that use `qsort' when it's not accessible.
+*** tests: Remove symlink only when it exists.
+*** tests: Don't rely on `scm_call_2' being visible.
+
+** Fix computation of LIBLOBJS so dependencies work properly.
+   (http://bugs.gnu.org/14193)
+
+* Bug fixes
+
+** Web: Fix web client with methods other than GET.
+   (http://bugs.gnu.org/15908)
+** Web: Add Content-Length header for empty bodies.
+** Web: Accept "UTC" as the zone offset in date headers.
+   (http://bugs.gnu.org/14128)
+** Web: Don't throw if a response is longer than its Content-Length says.
+** Web: Write out HTTP Basic auth headers correctly.
+   (http://bugs.gnu.org/14370)
+** Web: Always print a path component in 'write-request-line'.
+** Fix 'define-public' from (ice-9 curried-definitions).
+** psyntax: toplevel variable definitions discard previous syntactic binding.
+   (http://bugs.gnu.org/11988)
+** Fix thread-unsafe lazy initializations.
+** Make (ice-9 popen) thread-safe.
+   (http://bugs.gnu.org/15683)
+** Make guardians thread-safe.
+** Make regexp_exec thread-safe.
+   (http://bugs.gnu.org/14404)
+** vm: Gracefully handle stack overflows.
+   (http://bugs.gnu.org/15065)
+** Fix 'rationalize'.
+   (http://bugs.gnu.org/14905)
+** Fix inline asm for VM fixnum operations on x32.
+** Fix 'SCM_SYSCALL' to really swallow EINTR.
+** Hide EINTR returns from 'accept'.
+** SRFI-19: Update the table of leap seconds.
+** Add missing files to the test-suite Makefile.
+** Make sure 'ftw' allows directory traversal when running as root.
+** Fix 'hash-for-each' for weak hash tables.
+** SRFI-18: Export 'current-thread'.
+   (http://bugs.gnu.org/16890)
+** Fix inlining of tail list to apply.
+   (http://bugs.gnu.org/15533)
+** Fix bug in remqueue in threads.c when removing last element.
+** Fix build when '>>' on negative integers is not arithmetic.
+** Fix 'bitwise-bit-count' for negative arguments.
+   (http://bugs.gnu.org/14864)
+** Fix VM 'ash' for right shifts by large amounts.
+   (http://bugs.gnu.org/14864)
+** Fix rounding in scm_i_divide2double for negative arguments.
+** Avoid lossy conversion from inum to double in numerical comparisons.
+** Fix numerical comparison of fractions to infinities.
+** Allow fl+ and fl* to accept zero arguments.
+   (http://bugs.gnu.org/14869)
+** flonum? returns false for complex number objects.
+   (http://bugs.gnu.org/14866)
+** flfinite? applied to a NaN returns false.
+   (http://bugs.gnu.org/14868)
+** Flonum operations always return flonums.
+   (http://bugs.gnu.org/14871)
+** min and max: NaNs beat infinities, per R6RS errata.
+   (http://bugs.gnu.org/14865)
+** Fix 'fxbit-count' for negative arguments.
+** 'gcd' and 'lcm' support inexact integer arguments.
+   (http://bugs.gnu.org/14870)
+** Fix R6RS 'fixnum-width'.
+   (http://bugs.gnu.org/14879)
+** tests: Use shell constructs that /bin/sh on Solaris 10 can understand.
+   (http://bugs.gnu.org/14042)
+** Fix display of symbols containing backslashes.
+   (http://bugs.gnu.org/15033)
+** Fix truncated-print for uniform vectors.
+** Define `AF_UNIX' only when Unix-domain sockets are supported.
+** Decompiler: fix handling of empty 'case-lambda' expressions.
+** Fix handling of signed zeroes and infinities in 'numerator' and 'denominator'.
+** dereference-pointer: check for null pointer.
+** Optimizer: Numerical comparisons are not negatable, for correct NaN handling.
+** Compiler: Evaluate '-' and '/' in left-to-right order.
+   (for more robust floating-point arithmetic)
+** snarf.h: Declare static const function name vars as SCM_UNUSED.
+** chars.c: Remove duplicate 'const' specifiers.
+** Modify SCM_UNPACK type check to avoid warnings in clang.
+** Arrange so that 'file-encoding' does not truncate the encoding name.
+   (http://bugs.gnu.org/16463)
+** Improve error checking in bytevector->uint-list and bytevector->sint-list.
+   (http://bugs.gnu.org/15100)
+** Fix (ash -1 SCM_I_FIXNUM_BIT-1) to return a fixnum instead of a bignum.
+** i18n: Fix null pointer dereference when locale info is missing.
+** Fix 'string-copy!' to work properly with overlapping src/dest.
+** Fix hashing of vectors to run in bounded time.
+** 'port-position' works on CBIPs that do not support 'set-port-position!'.
+** Custom binary input ports sanity-check the return value of 'read!'.
+** bdw-gc.h: Check SCM_USE_PTHREAD_THREADS using #if not #ifdef.
+** REPL Server: Don't establish a SIGINT handler.
+** REPL Server: Redirect warnings to client socket.
+** REPL Server: Improve robustness of 'stop-server-and-clients!'.
+** Add srfi-16, srfi-30, srfi-46, srfi-62, srfi-87 to %cond-expand-features.
+** Fix trap handlers to handle applicable structs.
+   (http://bugs.gnu.org/15691)
+** Fix optional end argument in `uniform-vector-read!'.
+   (http://bugs.gnu.org/15370)
+** Fix brainfuck->scheme compiler.
+** texinfo: Fix newline preservation in @example with lines beginning with @
+
+** C standards conformance improvements
+
+Improvements and bug fixes were made to the C part of Guile's run-time
+support (libguile).
+
+*** Don't use the identifier 'noreturn'.
+    (http://bugs.gnu.org/15798)
+*** Rewrite SCM_I_INUM to avoid unspecified behavior when not using GNU C.
+*** Improve fallback implemention of SCM_SRS to avoid unspecified behavior.
+*** SRFI-60: Reimplement 'rotate-bit-field' on inums to be more portable.
+*** Improve compliance with C standards regarding signed integer shifts.
+*** Avoid signed overflow in random.c.
+*** VM: Avoid signed overflows in 'add1' and 'sub1'.
+*** VM: Avoid overflow in ASM_ADD when the result is most-positive-fixnum.
+*** read: Avoid signed integer overflow in 'read_decimal_integer'.
+
+
 
 Changes in 2.0.9 (since 2.0.7):
 

README

@@ -82,7 +82,7 @@ Guile requires the following external packages:
 
     libgc (aka. the Boehm-Demers-Weiser garbage collector) is the
     conservative garbage collector used by Guile.  It is available
-    from http://www.hpl.hp.com/personal/Hans_Boehm/gc/ .
+    from http://www.hboehm.info/gc/ .
 
   - libffi
 

THANKS

@@ -5,6 +5,7 @@ Contributors since the last release:
           Aleix Conchillo Flaqué
         Ludovic Courtès
           Jason Earl
+           Paul Eggert
           Brian Gough
          Volker Grabsch
          Julian Graham
@@ -183,6 +184,7 @@ For fixes or providing information which led to a fix:
 	Andreas Vögele
         Michael Talbot-Wilson
         Michael Tuexen
+            Xin Wang
          Thomas Wawrzinek
         Mark H. Weaver
           Göran Weinholt

configure.ac

@@ -51,6 +51,10 @@ GUILE_VERSION="$PACKAGE_VERSION"
 AC_CONFIG_HEADERS([config.h])
 AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/)
 
+dnl We require the pkg.m4 set of macros from pkg-config.
+dnl Make sure it's available.
+m4_pattern_forbid([PKG_CHECK_MODULES])
+
 #--------------------------------------------------------------------
 
 AC_LANG([C])
@@ -72,6 +76,13 @@ AM_PROG_AR
 dnl Gnulib.
 gl_INIT
 
+dnl We provide our own lib/glthread/lock.h, so let other Gnulib modules
+dnl know that we have it.  This allows them to be compiled with adequate
+dnl locking support.  See <http://bugs.gnu.org/14404>.
+AC_DEFINE([GNULIB_LOCK], [1],
+  [Define to allow Gnulib modules to use Guile's locks.])
+
+
 AC_PROG_CC_C89
 
 # for per-target cflags in the libguile subdir
@@ -1409,10 +1420,13 @@ 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
 
+dnl Normally Gnulib's 'threadlib' module would define this macro, but
+dnl since we don't use it, define it by ourselves.
+AC_DEFINE([USE_POSIX_THREADS], [1],
+  [Define to let Gnulib modules know that we use POSIX threads.])
+
 AC_MSG_CHECKING([whether pthread_attr_getstack works for the main thread])
 old_CFLAGS="$CFLAGS"
 CFLAGS="$PTHREAD_CFLAGS $CFLAGS"
@@ -1488,7 +1502,8 @@ AC_SUBST(HOST_CC)
 
 GUILE_CHECK_GUILE_FOR_BUILD
   			
-## If we're using GCC, ask for aggressive warnings.
+## If we're using GCC, add flags to reduce strictness of undefined
+## behavior, and ask for aggressive warnings.
 GCC_CFLAGS=""
 case "$GCC" in
   yes )
@@ -1498,13 +1513,13 @@ case "$GCC" in
     ## -Wundef was removed because Gnulib prevented it (see
     ## <http://thread.gmane.org/gmane.lisp.guile.bugs/5329>.)
 
-    ## Build with `-fno-strict-aliasing' to prevent miscompilation on
+    ## Build with `-fno-strict-aliasing' and `-fwrapv' to prevent
-    ## some platforms.  See
+    ## miscompilation on some platforms.  See
     ## <http://lists.gnu.org/archive/html/guile-devel/2012-01/msg00487.html>.
 
     POTENTIAL_GCC_CFLAGS="-Wall -Wmissing-prototypes \
       -Wdeclaration-after-statement -Wpointer-arith \
-      -Wswitch-enum -fno-strict-aliasing"
+      -Wswitch-enum -fno-strict-aliasing -fwrapv"
     # 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
@@ -1597,6 +1612,9 @@ AC_SUBST(top_builddir_absolute)
 top_srcdir_absolute=`(cd $srcdir && pwd)`
 AC_SUBST(top_srcdir_absolute)
 
+dnl Add -I flag so that lib/glthread/lock.h finds <libguile/threads.h>.
+CPPFLAGS="-I$top_srcdir_absolute $CPPFLAGS"
+
 dnl `sitedir' goes into libpath.h and the pkg-config file.
 pkgdatadir="$datadir/$PACKAGE_TARNAME"
 sitedir="$pkgdatadir/site/$GUILE_EFFECTIVE_VERSION"

doc/ref/api-compound.texi

@@ -1,7 +1,7 @@
 @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, 2007,
-@c   2007, 2009, 2010, 2011, 2012, 2013  Free Software Foundation, Inc.
+@c   2009, 2010, 2011, 2012, 2013, 2014  Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node Compound Data Types
@@ -673,6 +673,8 @@ that vectors are the special case of one dimensional non-uniform arrays
 and that most array procedures operate happily on vectors
 (@pxref{Arrays}).
 
+Also see @ref{SRFI-43}, for a comprehensive vector library.
+
 @menu
 * Vector Syntax::               Read syntax for vectors.
 * Vector Creation::             Dynamic vector creation and validation.

doc/ref/api-data.texi

@@ -5543,6 +5543,8 @@ approach to properties, see @ref{Object Properties}.
 @node Symbol Read Syntax
 @subsubsection Extended Read Syntax for Symbols
 
+@cindex r7rs-symbols
+
 The read syntax for a symbol is a sequence of letters, digits, and
 @dfn{extended alphabetic characters}, beginning with a character that
 cannot begin a number.  In addition, the special cases of @code{+},
@@ -5603,6 +5605,16 @@ double quotes.
 |\| is a vertical bar|
 @end example
 
+Note that there's also an @code{r7rs-symbols} print option
+(@pxref{Scheme Write}).  To enable the use of this notation, evaluate
+one or both of the following expressions:
+
+@example
+(read-enable  'r7rs-symbols)
+(print-enable 'r7rs-symbols)
+@end example
+
+
 @node Symbol Uninterned
 @subsubsection Uninterned Symbols
 

doc/ref/api-debug.texi

@@ -17,8 +17,9 @@ infrastructure that builds on top of those calls.
 @menu
 * Evaluation Model::            Evaluation and the Scheme stack.
 * Source Properties::           From expressions to source locations.
-* Programmatic Error Handling:: Debugging when an error occurs.
+* Programmatic Error Handling::  Debugging when an error occurs.
 * Traps::                       Breakpoints, tracepoints, oh my!
+* GDB Support::                 C-level debugging with GDB.
 @end menu
 
 @node Evaluation Model
@@ -1478,6 +1479,43 @@ This is a stepping trap, used to implement the ``step'', ``next'',
 ``step-instruction'', and ``next-instruction'' REPL commands.
 @end deffn
 
+@node GDB Support
+@subsection GDB Support
+
+@cindex GDB support
+
+Sometimes, you may find it necessary to debug Guile applications at the
+C level.  Doing so can be tedious, in particular because the debugger is
+oblivious to Guile's @code{SCM} type, and thus unable to display
+@code{SCM} values in any meaningful way:
+
+@example
+(gdb) frame
+#0  scm_display (obj=0xf04310, port=0x6f9f30) at print.c:1437
+@end example
+
+To address that, Guile comes with an extension of the GNU Debugger (GDB)
+that contains a ``pretty-printer'' for @code{SCM} values.  With this GDB
+extension, the C frame in the example above shows up like this:
+
+@example
+(gdb) frame
+#0  scm_display (obj=("hello" GDB!), port=#<port file 6f9f30>) at print.c:1437
+@end example
+
+@noindent
+Here GDB was able to decode the list pointed to by @var{obj}, and to
+print it using Scheme's read syntax.
+
+That extension is a @code{.scm} file installed alongside the
+@file{libguile} shared library.  When GDB 7.8 or later is installed and
+compiled with support for extensions written in Guile, the extension is
+automatically loaded when debugging a program linked against
+@file{libguile} (@pxref{Auto-loading,,, gdb, Debugging with GDB}).  Note
+that the directory where @file{libguile} is installed must be among
+GDB's auto-loading ``safe directories'' (@pxref{Auto-loading safe
+path,,, gdb, Debugging with GDB}).
+
 
 @c Local Variables:
 @c TeX-master: "guile.texi"

doc/ref/api-evaluation.texi

@@ -23,6 +23,7 @@ loading, evaluating, and compiling Scheme code at run time.
 * Local Evaluation::            Evaluation in a local lexical environment.
 * Local Inclusion::             Compile-time inclusion of one file in another.
 * REPL Servers::                Serving a REPL over a socket.
+* Cooperative REPL Servers::    REPL server for single-threaded applications.
 @end menu
 
 
@@ -1267,6 +1268,54 @@ with no arguments.
 
 @deffn {Scheme Procedure} stop-server-and-clients!
 Closes the connection on all running server sockets.
+
+Please note that in the current implementation, the REPL threads are
+cancelled without unwinding their stacks.  If any of them are holding
+mutexes or are within a critical section, the results are unspecified.
+@end deffn
+
+@node Cooperative REPL Servers
+@subsection Cooperative REPL Servers
+
+@cindex Cooperative REPL server
+
+The procedures in this section are provided by
+@lisp
+(use-modules (system repl coop-server))
+@end lisp
+
+Whereas ordinary REPL servers run in their own threads (@pxref{REPL
+Servers}), sometimes it is more convenient to provide REPLs that run at
+specified times within an existing thread, for example in programs
+utilizing an event loop or in single-threaded programs.  This allows for
+safe access and mutation of a program's data structures from the REPL,
+without concern for thread synchronization.
+
+Although the REPLs are run in the thread that calls
+@code{spawn-coop-repl-server} and @code{poll-coop-repl-server},
+dedicated threads are spawned so that the calling thread is not blocked.
+The spawned threads read input for the REPLs and to listen for new
+connections.
+
+Cooperative REPL servers must be polled periodically to evaluate any
+pending expressions by calling @code{poll-coop-repl-server} with the
+object returned from @code{spawn-coop-repl-server}.  The thread that
+calls @code{poll-coop-repl-server} will be blocked for as long as the
+expression takes to be evaluated or if the debugger is entered.
+
+@deffn {Scheme Procedure} spawn-coop-repl-server [server-socket]
+Create and return a new cooperative REPL server object, and spawn a new
+thread to listen for connections on @var{server-socket}.  Proper
+functioning of the REPL server requires that
+@code{poll-coop-repl-server} be called periodically on the returned
+server object.
+@end deffn
+
+@deffn {Scheme Procedure} poll-coop-repl-server coop-server
+Poll the cooperative REPL server @var{coop-server} and apply a pending
+operation if there is one, such as evaluating an expression typed at the
+REPL prompt.  This procedure must be called from the same thread that
+called @code{spawn-coop-repl-server}.
 @end deffn
 
 @c Local Variables:

doc/ref/api-foreign.texi

@@ -604,7 +604,7 @@ Unpack the pointer value from a pointer object.
 Wrapped pointers are untyped, so they are essentially equivalent to C
 @code{void} pointers.  As in C, the memory region pointed to by a
 pointer can be accessed at the byte level.  This is achieved using
-@emph{bytevectors} (@pxref{Bytevectors}).  The @code{(rnrs bytevector)}
+@emph{bytevectors} (@pxref{Bytevectors}).  The @code{(rnrs bytevectors)}
 module contains procedures that can be used to convert byte sequences to
 Scheme objects such as strings, floating point numbers, or integers.
 

doc/ref/srfi-modules.texi

@@ -4626,8 +4626,8 @@ comparisons are performed is unspecified.
 @subsubsection SRFI-43 Selectors
 
 @deffn {Scheme Procedure} vector-ref vec i
-Return the value that the location in @var{vec} at @var{i} is mapped to
+Return the element at index @var{i} in @var{vec}.  Indexing is based on
-in the store.  Indexing is based on zero.
+zero.
 @end deffn
 
 @deffn {Scheme Procedure} vector-length vec

guile-readline/ice-9/readline.scm

@@ -1,6 +1,7 @@
 ;;;; readline.scm --- support functions for command-line editing
 ;;;;
-;;;; 	Copyright (C) 1997, 1999, 2000, 2001, 2002, 2006, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2006, 2009, 2010, 2011,
+;;;;   2013, 2014 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
@@ -105,7 +106,7 @@
                                            (set! history-buffer
                                                  (if history-buffer
                                                      (string-append history-buffer
-                                                                    " "
+                                                                    "\n"
                                                                     str)
                                                      str)))
                                        str)))))

lib/Makefile.am

@@ -21,7 +21,7 @@
 # the same distribution terms as the rest of that program.
 #
 # Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --local-dir=gnulib-local --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap c-strcase canonicalize-lgpl ceil clock-time close connect copysign dirfd duplocale environ extensions flock floor fpieee frexp fstat full-read full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isfinite isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring listen localcharset locale log1p maintainer-makefile malloc-gnu malloca nl_langinfo nproc open pipe-posix pipe2 poll putenv recv recvfrom regex rename select send sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat time times trunc verify vsnprintf warnings wchar
+# Reproduce by: gnulib-tool --import --dir=. --local-dir=gnulib-local --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=lock --lgpl=3 --no-conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap c-strcase canonicalize-lgpl ceil clock-time close connect copysign dirfd duplocale environ extensions flock floor fpieee frexp fstat fsync full-read full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isfinite isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring link listen localcharset locale log1p lstat maintainer-makefile malloc-gnu malloca mkdir mkstemp nl_langinfo nproc open pipe-posix pipe2 poll putenv readlink recv recvfrom regex rename rmdir select send sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat time times trunc unistd verify vsnprintf warnings wchar
 
 AUTOMAKE_OPTIONS = 1.9.6 gnits subdir-objects
 
@@ -69,7 +69,6 @@ libgnu_la_LDFLAGS += $(LOG1P_LIBM)
 libgnu_la_LDFLAGS += $(LOG_LIBM)
 libgnu_la_LDFLAGS += $(LTLIBICONV)
 libgnu_la_LDFLAGS += $(LTLIBINTL)
-libgnu_la_LDFLAGS += $(LTLIBTHREAD)
 libgnu_la_LDFLAGS += $(LTLIBUNISTRING)
 libgnu_la_LDFLAGS += $(ROUND_LIBM)
 libgnu_la_LDFLAGS += $(SERVENT_LIB)
@@ -567,6 +566,15 @@ EXTRA_libgnu_la_SOURCES += fstat.c
 
 ## end   gnulib module fstat
 
+## begin gnulib module fsync
+
+
+EXTRA_DIST += fsync.c
+
+EXTRA_libgnu_la_SOURCES += fsync.c
+
+## end   gnulib module fsync
+
 ## begin gnulib module full-read
 
 libgnu_la_SOURCES += full-read.h full-read.c
@@ -905,6 +913,15 @@ EXTRA_DIST += libunistring.valgrind
 
 ## end   gnulib module libunistring
 
+## begin gnulib module link
+
+
+EXTRA_DIST += link.c
+
+EXTRA_libgnu_la_SOURCES += link.c
+
+## end   gnulib module link
+
 ## begin gnulib module listen
 
 
@@ -1032,12 +1049,6 @@ EXTRA_libgnu_la_SOURCES += localeconv.c
 
 ## end   gnulib module localeconv
 
-## begin gnulib module lock
-
-libgnu_la_SOURCES += glthread/lock.h glthread/lock.c
-
-## end   gnulib module lock
-
 ## begin gnulib module log
 
 
@@ -1417,6 +1428,24 @@ EXTRA_libgnu_la_SOURCES += memchr.c
 
 ## end   gnulib module memchr
 
+## begin gnulib module mkdir
+
+
+EXTRA_DIST += mkdir.c
+
+EXTRA_libgnu_la_SOURCES += mkdir.c
+
+## end   gnulib module mkdir
+
+## begin gnulib module mkstemp
+
+
+EXTRA_DIST += mkstemp.c
+
+EXTRA_libgnu_la_SOURCES += mkstemp.c
+
+## end   gnulib module mkstemp
+
 ## begin gnulib module msvc-inval
 
 
@@ -1701,6 +1730,15 @@ EXTRA_DIST += same-inode.h
 
 ## end   gnulib module same-inode
 
+## begin gnulib module secure_getenv
+
+
+EXTRA_DIST += secure_getenv.c
+
+EXTRA_libgnu_la_SOURCES += secure_getenv.c
+
+## end   gnulib module secure_getenv
+
 ## begin gnulib module select
 
 
@@ -2318,6 +2356,15 @@ EXTRA_DIST += stdlib.in.h
 
 ## end   gnulib module stdlib
 
+## begin gnulib module strdup-posix
+
+
+EXTRA_DIST += strdup.c
+
+EXTRA_libgnu_la_SOURCES += strdup.c
+
+## end   gnulib module strdup-posix
+
 ## begin gnulib module streq
 
 
@@ -2737,13 +2784,13 @@ EXTRA_DIST += sys_uio.in.h
 
 ## end   gnulib module sys_uio
 
-## begin gnulib module threadlib
+## begin gnulib module tempname
 
-libgnu_la_SOURCES += glthread/threadlib.c
+libgnu_la_SOURCES += tempname.c
 
-EXTRA_DIST += $(top_srcdir)/build-aux/config.rpath
+EXTRA_DIST += tempname.h
 
-## end   gnulib module threadlib
+## end   gnulib module tempname
 
 ## begin gnulib module time
 

lib/fsync.c

@@ -0,0 +1,83 @@
+/* Emulate fsync on platforms that lack it, primarily Windows and
+   cross-compilers like MinGW.
+
+   This is derived from sqlite3 sources.
+   http://www.sqlite.org/cvstrac/rlog?f=sqlite/src/os_win.c
+   http://www.sqlite.org/copyright.html
+
+   Written by Richard W.M. Jones <rjones.at.redhat.com>
+
+   Copyright (C) 2008-2014 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 program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+#include <unistd.h>
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+
+/* FlushFileBuffers */
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+
+# include <errno.h>
+
+/* Get _get_osfhandle.  */
+# include "msvc-nothrow.h"
+
+int
+fsync (int fd)
+{
+  HANDLE h = (HANDLE) _get_osfhandle (fd);
+  DWORD err;
+
+  if (h == INVALID_HANDLE_VALUE)
+    {
+      errno = EBADF;
+      return -1;
+    }
+
+  if (!FlushFileBuffers (h))
+    {
+      /* Translate some Windows errors into rough approximations of Unix
+       * errors.  MSDN is useless as usual - in this case it doesn't
+       * document the full range of errors.
+       */
+      err = GetLastError ();
+      switch (err)
+        {
+        case ERROR_ACCESS_DENIED:
+          /* For a read-only handle, fsync should succeed, even though we have
+             no way to sync the access-time changes.  */
+          return 0;
+
+          /* eg. Trying to fsync a tty. */
+        case ERROR_INVALID_HANDLE:
+          errno = EINVAL;
+          break;
+
+        default:
+          errno = EIO;
+        }
+      return -1;
+    }
+
+  return 0;
+}
+
+#else /* !Windows */
+
+# error "This platform lacks fsync function, and Gnulib doesn't provide a replacement. This is a bug in Gnulib."
+
+#endif /* !Windows */

lib/glthread/lock.h

@@ -1,927 +1,38 @@
-/* Locking in multithreaded situations.
+#ifndef SCM_GLTHREADS_H
-   Copyright (C) 2005-2014 Free Software Foundation, Inc.
+#define SCM_GLTHREADS_H
 
-   This program is free software; you can redistribute it and/or modify
+/* Copyright (C) 2014 Free Software Foundation, Inc.
-   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)
+ * This library is free software; you can redistribute it and/or
-   any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
 
-   This program is distributed in the hope that it will be useful,
+/* This file implements Gnulib's glthreads/lock.h interface in terms of
-   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   Guile's locking API.  This allows Gnulib modules such as 'regex' to
-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   be built with thread-safety support via Guile's locks (see
-   GNU Lesser General Public License for more details.
+   <http://bugs.gnu.org/14404>.)  */
 
-   You should have received a copy of the GNU Lesser General Public License
+#include <libguile/threads.h>
-   along with this program; if not, see <http://www.gnu.org/licenses/>.  */
-
-/* Written by Bruno Haible <bruno@clisp.org>, 2005.
-   Based on GCC's gthr-posix.h, gthr-posix95.h, gthr-solaris.h,
-   gthr-win32.h.  */
-
-/* This file contains locking primitives for use with a given thread library.
-   It does not contain primitives for creating threads or for other
-   synchronization primitives.
-
-   Normal (non-recursive) locks:
-     Type:                gl_lock_t
-     Declaration:         gl_lock_define(extern, name)
-     Initializer:         gl_lock_define_initialized(, name)
-     Initialization:      gl_lock_init (name);
-     Taking the lock:     gl_lock_lock (name);
-     Releasing the lock:  gl_lock_unlock (name);
-     De-initialization:   gl_lock_destroy (name);
-   Equivalent functions with control of error handling:
-     Initialization:      err = glthread_lock_init (&name);
-     Taking the lock:     err = glthread_lock_lock (&name);
-     Releasing the lock:  err = glthread_lock_unlock (&name);
-     De-initialization:   err = glthread_lock_destroy (&name);
-
-   Read-Write (non-recursive) locks:
-     Type:                gl_rwlock_t
-     Declaration:         gl_rwlock_define(extern, name)
-     Initializer:         gl_rwlock_define_initialized(, name)
-     Initialization:      gl_rwlock_init (name);
-     Taking the lock:     gl_rwlock_rdlock (name);
-                          gl_rwlock_wrlock (name);
-     Releasing the lock:  gl_rwlock_unlock (name);
-     De-initialization:   gl_rwlock_destroy (name);
-   Equivalent functions with control of error handling:
-     Initialization:      err = glthread_rwlock_init (&name);
-     Taking the lock:     err = glthread_rwlock_rdlock (&name);
-                          err = glthread_rwlock_wrlock (&name);
-     Releasing the lock:  err = glthread_rwlock_unlock (&name);
-     De-initialization:   err = glthread_rwlock_destroy (&name);
-
-   Recursive locks:
-     Type:                gl_recursive_lock_t
-     Declaration:         gl_recursive_lock_define(extern, name)
-     Initializer:         gl_recursive_lock_define_initialized(, name)
-     Initialization:      gl_recursive_lock_init (name);
-     Taking the lock:     gl_recursive_lock_lock (name);
-     Releasing the lock:  gl_recursive_lock_unlock (name);
-     De-initialization:   gl_recursive_lock_destroy (name);
-   Equivalent functions with control of error handling:
-     Initialization:      err = glthread_recursive_lock_init (&name);
-     Taking the lock:     err = glthread_recursive_lock_lock (&name);
-     Releasing the lock:  err = glthread_recursive_lock_unlock (&name);
-     De-initialization:   err = glthread_recursive_lock_destroy (&name);
-
-  Once-only execution:
-     Type:                gl_once_t
-     Initializer:         gl_once_define(extern, name)
-     Execution:           gl_once (name, initfunction);
-   Equivalent functions with control of error handling:
-     Execution:           err = glthread_once (&name, initfunction);
-*/
-
-
-#ifndef _LOCK_H
-#define _LOCK_H
-
-#include <errno.h>
 #include <stdlib.h>
 
-/* ========================================================================= */
+#define gl_lock_define(klass, name)		\
+  klass scm_i_pthread_mutex_t name;
 
-#if USE_POSIX_THREADS
+#define glthread_lock_init(lock) scm_i_pthread_mutex_init ((lock), NULL)
-
+#define glthread_lock_destroy    scm_i_pthread_mutex_destroy
-/* Use the POSIX threads library.  */
+#define glthread_lock_lock       scm_i_pthread_mutex_lock
-
+#define glthread_lock_unlock     scm_i_pthread_mutex_unlock
-# include <pthread.h>
-
-# ifdef __cplusplus
-extern "C" {
-# endif
-
-# if PTHREAD_IN_USE_DETECTION_HARD
-
-/* The pthread_in_use() detection needs to be done at runtime.  */
-#  define pthread_in_use() \
-     glthread_in_use ()
-extern int glthread_in_use (void);
-
-# endif
-
-# if USE_POSIX_THREADS_WEAK
-
-/* Use weak references to the POSIX threads library.  */
-
-/* Weak references avoid dragging in external libraries if the other parts
-   of the program don't use them.  Here we use them, because we don't want
-   every program that uses libintl to depend on libpthread.  This assumes
-   that libpthread would not be loaded after libintl; i.e. if libintl is
-   loaded first, by an executable that does not depend on libpthread, and
-   then a module is dynamically loaded that depends on libpthread, libintl
-   will not be multithread-safe.  */
-
-/* The way to test at runtime whether libpthread is present is to test
-   whether a function pointer's value, such as &pthread_mutex_init, is
-   non-NULL.  However, some versions of GCC have a bug through which, in
-   PIC mode, &foo != NULL always evaluates to true if there is a direct
-   call to foo(...) in the same function.  To avoid this, we test the
-   address of a function in libpthread that we don't use.  */
-
-#  pragma weak pthread_mutex_init
-#  pragma weak pthread_mutex_lock
-#  pragma weak pthread_mutex_unlock
-#  pragma weak pthread_mutex_destroy
-#  pragma weak pthread_rwlock_init
-#  pragma weak pthread_rwlock_rdlock
-#  pragma weak pthread_rwlock_wrlock
-#  pragma weak pthread_rwlock_unlock
-#  pragma weak pthread_rwlock_destroy
-#  pragma weak pthread_once
-#  pragma weak pthread_cond_init
-#  pragma weak pthread_cond_wait
-#  pragma weak pthread_cond_signal
-#  pragma weak pthread_cond_broadcast
-#  pragma weak pthread_cond_destroy
-#  pragma weak pthread_mutexattr_init
-#  pragma weak pthread_mutexattr_settype
-#  pragma weak pthread_mutexattr_destroy
-#  ifndef pthread_self
-#   pragma weak pthread_self
-#  endif
-
-#  if !PTHREAD_IN_USE_DETECTION_HARD
-#   pragma weak pthread_cancel
-#   define pthread_in_use() (pthread_cancel != NULL)
-#  endif
-
-# else
-
-#  if !PTHREAD_IN_USE_DETECTION_HARD
-#   define pthread_in_use() 1
-#  endif
-
-# endif
-
-/* -------------------------- gl_lock_t datatype -------------------------- */
-
-typedef pthread_mutex_t gl_lock_t;
-# define gl_lock_define(STORAGECLASS, NAME) \
-    STORAGECLASS pthread_mutex_t NAME;
-# define gl_lock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS pthread_mutex_t NAME = gl_lock_initializer;
-# define gl_lock_initializer \
-    PTHREAD_MUTEX_INITIALIZER
-# define glthread_lock_init(LOCK) \
-    (pthread_in_use () ? pthread_mutex_init (LOCK, NULL) : 0)
-# define glthread_lock_lock(LOCK) \
-    (pthread_in_use () ? pthread_mutex_lock (LOCK) : 0)
-# define glthread_lock_unlock(LOCK) \
-    (pthread_in_use () ? pthread_mutex_unlock (LOCK) : 0)
-# define glthread_lock_destroy(LOCK) \
-    (pthread_in_use () ? pthread_mutex_destroy (LOCK) : 0)
-
-/* ------------------------- gl_rwlock_t datatype ------------------------- */
-
-# if HAVE_PTHREAD_RWLOCK
-
-#  ifdef PTHREAD_RWLOCK_INITIALIZER
-
-typedef pthread_rwlock_t gl_rwlock_t;
-#   define gl_rwlock_define(STORAGECLASS, NAME) \
-      STORAGECLASS pthread_rwlock_t NAME;
-#   define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
-      STORAGECLASS pthread_rwlock_t NAME = gl_rwlock_initializer;
-#   define gl_rwlock_initializer \
-      PTHREAD_RWLOCK_INITIALIZER
-#   define glthread_rwlock_init(LOCK) \
-      (pthread_in_use () ? pthread_rwlock_init (LOCK, NULL) : 0)
-#   define glthread_rwlock_rdlock(LOCK) \
-      (pthread_in_use () ? pthread_rwlock_rdlock (LOCK) : 0)
-#   define glthread_rwlock_wrlock(LOCK) \
-      (pthread_in_use () ? pthread_rwlock_wrlock (LOCK) : 0)
-#   define glthread_rwlock_unlock(LOCK) \
-      (pthread_in_use () ? pthread_rwlock_unlock (LOCK) : 0)
-#   define glthread_rwlock_destroy(LOCK) \
-      (pthread_in_use () ? pthread_rwlock_destroy (LOCK) : 0)
-
-#  else
-
-typedef struct
-        {
-          int initialized;
-          pthread_mutex_t guard;   /* protects the initialization */
-          pthread_rwlock_t rwlock; /* read-write lock */
-        }
-        gl_rwlock_t;
-#   define gl_rwlock_define(STORAGECLASS, NAME) \
-      STORAGECLASS gl_rwlock_t NAME;
-#   define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
-      STORAGECLASS gl_rwlock_t NAME = gl_rwlock_initializer;
-#   define gl_rwlock_initializer \
-      { 0, PTHREAD_MUTEX_INITIALIZER }
-#   define glthread_rwlock_init(LOCK) \
-      (pthread_in_use () ? glthread_rwlock_init_multithreaded (LOCK) : 0)
-#   define glthread_rwlock_rdlock(LOCK) \
-      (pthread_in_use () ? glthread_rwlock_rdlock_multithreaded (LOCK) : 0)
-#   define glthread_rwlock_wrlock(LOCK) \
-      (pthread_in_use () ? glthread_rwlock_wrlock_multithreaded (LOCK) : 0)
-#   define glthread_rwlock_unlock(LOCK) \
-      (pthread_in_use () ? glthread_rwlock_unlock_multithreaded (LOCK) : 0)
-#   define glthread_rwlock_destroy(LOCK) \
-      (pthread_in_use () ? glthread_rwlock_destroy_multithreaded (LOCK) : 0)
-extern int glthread_rwlock_init_multithreaded (gl_rwlock_t *lock);
-extern int glthread_rwlock_rdlock_multithreaded (gl_rwlock_t *lock);
-extern int glthread_rwlock_wrlock_multithreaded (gl_rwlock_t *lock);
-extern int glthread_rwlock_unlock_multithreaded (gl_rwlock_t *lock);
-extern int glthread_rwlock_destroy_multithreaded (gl_rwlock_t *lock);
-
-#  endif
-
-# else
-
-typedef struct
-        {
-          pthread_mutex_t lock; /* protects the remaining fields */
-          pthread_cond_t waiting_readers; /* waiting readers */
-          pthread_cond_t waiting_writers; /* waiting writers */
-          unsigned int waiting_writers_count; /* number of waiting writers */
-          int runcount; /* number of readers running, or -1 when a writer runs */
-        }
-        gl_rwlock_t;
-# define gl_rwlock_define(STORAGECLASS, NAME) \
-    STORAGECLASS gl_rwlock_t NAME;
-# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS gl_rwlock_t NAME = gl_rwlock_initializer;
-# define gl_rwlock_initializer \
-    { PTHREAD_MUTEX_INITIALIZER, PTHREAD_COND_INITIALIZER, PTHREAD_COND_INITIALIZER, 0, 0 }
-# define glthread_rwlock_init(LOCK) \
-    (pthread_in_use () ? glthread_rwlock_init_multithreaded (LOCK) : 0)
-# define glthread_rwlock_rdlock(LOCK) \
-    (pthread_in_use () ? glthread_rwlock_rdlock_multithreaded (LOCK) : 0)
-# define glthread_rwlock_wrlock(LOCK) \
-    (pthread_in_use () ? glthread_rwlock_wrlock_multithreaded (LOCK) : 0)
-# define glthread_rwlock_unlock(LOCK) \
-    (pthread_in_use () ? glthread_rwlock_unlock_multithreaded (LOCK) : 0)
-# define glthread_rwlock_destroy(LOCK) \
-    (pthread_in_use () ? glthread_rwlock_destroy_multithreaded (LOCK) : 0)
-extern int glthread_rwlock_init_multithreaded (gl_rwlock_t *lock);
-extern int glthread_rwlock_rdlock_multithreaded (gl_rwlock_t *lock);
-extern int glthread_rwlock_wrlock_multithreaded (gl_rwlock_t *lock);
-extern int glthread_rwlock_unlock_multithreaded (gl_rwlock_t *lock);
-extern int glthread_rwlock_destroy_multithreaded (gl_rwlock_t *lock);
-
-# endif
-
-/* --------------------- gl_recursive_lock_t datatype --------------------- */
-
-# if HAVE_PTHREAD_MUTEX_RECURSIVE
-
-#  if defined PTHREAD_RECURSIVE_MUTEX_INITIALIZER || defined PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP
-
-typedef pthread_mutex_t gl_recursive_lock_t;
-#   define gl_recursive_lock_define(STORAGECLASS, NAME) \
-      STORAGECLASS pthread_mutex_t NAME;
-#   define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
-      STORAGECLASS pthread_mutex_t NAME = gl_recursive_lock_initializer;
-#   ifdef PTHREAD_RECURSIVE_MUTEX_INITIALIZER
-#    define gl_recursive_lock_initializer \
-       PTHREAD_RECURSIVE_MUTEX_INITIALIZER
-#   else
-#    define gl_recursive_lock_initializer \
-       PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP
-#   endif
-#   define glthread_recursive_lock_init(LOCK) \
-      (pthread_in_use () ? glthread_recursive_lock_init_multithreaded (LOCK) : 0)
-#   define glthread_recursive_lock_lock(LOCK) \
-      (pthread_in_use () ? pthread_mutex_lock (LOCK) : 0)
-#   define glthread_recursive_lock_unlock(LOCK) \
-      (pthread_in_use () ? pthread_mutex_unlock (LOCK) : 0)
-#   define glthread_recursive_lock_destroy(LOCK) \
-      (pthread_in_use () ? pthread_mutex_destroy (LOCK) : 0)
-extern int glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t *lock);
-
-#  else
-
-typedef struct
-        {
-          pthread_mutex_t recmutex; /* recursive mutex */
-          pthread_mutex_t guard;    /* protects the initialization */
-          int initialized;
-        }
-        gl_recursive_lock_t;
-#   define gl_recursive_lock_define(STORAGECLASS, NAME) \
-      STORAGECLASS gl_recursive_lock_t NAME;
-#   define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
-      STORAGECLASS gl_recursive_lock_t NAME = gl_recursive_lock_initializer;
-#   define gl_recursive_lock_initializer \
-      { PTHREAD_MUTEX_INITIALIZER, PTHREAD_MUTEX_INITIALIZER, 0 }
-#   define glthread_recursive_lock_init(LOCK) \
-      (pthread_in_use () ? glthread_recursive_lock_init_multithreaded (LOCK) : 0)
-#   define glthread_recursive_lock_lock(LOCK) \
-      (pthread_in_use () ? glthread_recursive_lock_lock_multithreaded (LOCK) : 0)
-#   define glthread_recursive_lock_unlock(LOCK) \
-      (pthread_in_use () ? glthread_recursive_lock_unlock_multithreaded (LOCK) : 0)
-#   define glthread_recursive_lock_destroy(LOCK) \
-      (pthread_in_use () ? glthread_recursive_lock_destroy_multithreaded (LOCK) : 0)
-extern int glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t *lock);
-
-#  endif
-
-# else
-
-/* Old versions of POSIX threads on Solaris did not have recursive locks.
-   We have to implement them ourselves.  */
-
-typedef struct
-        {
-          pthread_mutex_t mutex;
-          pthread_t owner;
-          unsigned long depth;
-        }
-        gl_recursive_lock_t;
-#  define gl_recursive_lock_define(STORAGECLASS, NAME) \
-     STORAGECLASS gl_recursive_lock_t NAME;
-#  define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
-     STORAGECLASS gl_recursive_lock_t NAME = gl_recursive_lock_initializer;
-#  define gl_recursive_lock_initializer \
-     { PTHREAD_MUTEX_INITIALIZER, (pthread_t) 0, 0 }
-#  define glthread_recursive_lock_init(LOCK) \
-     (pthread_in_use () ? glthread_recursive_lock_init_multithreaded (LOCK) : 0)
-#  define glthread_recursive_lock_lock(LOCK) \
-     (pthread_in_use () ? glthread_recursive_lock_lock_multithreaded (LOCK) : 0)
-#  define glthread_recursive_lock_unlock(LOCK) \
-     (pthread_in_use () ? glthread_recursive_lock_unlock_multithreaded (LOCK) : 0)
-#  define glthread_recursive_lock_destroy(LOCK) \
-     (pthread_in_use () ? glthread_recursive_lock_destroy_multithreaded (LOCK) : 0)
-extern int glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t *lock);
-
-# endif
-
-/* -------------------------- gl_once_t datatype -------------------------- */
-
-typedef pthread_once_t gl_once_t;
-# define gl_once_define(STORAGECLASS, NAME) \
-    STORAGECLASS pthread_once_t NAME = PTHREAD_ONCE_INIT;
-# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
-    (pthread_in_use ()                                                         \
-     ? pthread_once (ONCE_CONTROL, INITFUNCTION)                               \
-     : (glthread_once_singlethreaded (ONCE_CONTROL) ? (INITFUNCTION (), 0) : 0))
-extern int glthread_once_singlethreaded (pthread_once_t *once_control);
-
-# ifdef __cplusplus
-}
-# endif
 
 #endif
-
-/* ========================================================================= */
-
-#if USE_PTH_THREADS
-
-/* Use the GNU Pth threads library.  */
-
-# include <pth.h>
-
-# ifdef __cplusplus
-extern "C" {
-# endif
-
-# if USE_PTH_THREADS_WEAK
-
-/* Use weak references to the GNU Pth threads library.  */
-
-#  pragma weak pth_mutex_init
-#  pragma weak pth_mutex_acquire
-#  pragma weak pth_mutex_release
-#  pragma weak pth_rwlock_init
-#  pragma weak pth_rwlock_acquire
-#  pragma weak pth_rwlock_release
-#  pragma weak pth_once
-
-#  pragma weak pth_cancel
-#  define pth_in_use() (pth_cancel != NULL)
-
-# else
-
-#  define pth_in_use() 1
-
-# endif
-
-/* -------------------------- gl_lock_t datatype -------------------------- */
-
-typedef pth_mutex_t gl_lock_t;
-# define gl_lock_define(STORAGECLASS, NAME) \
-    STORAGECLASS pth_mutex_t NAME;
-# define gl_lock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS pth_mutex_t NAME = gl_lock_initializer;
-# define gl_lock_initializer \
-    PTH_MUTEX_INIT
-# define glthread_lock_init(LOCK) \
-    (pth_in_use () && !pth_mutex_init (LOCK) ? errno : 0)
-# define glthread_lock_lock(LOCK) \
-    (pth_in_use () && !pth_mutex_acquire (LOCK, 0, NULL) ? errno : 0)
-# define glthread_lock_unlock(LOCK) \
-    (pth_in_use () && !pth_mutex_release (LOCK) ? errno : 0)
-# define glthread_lock_destroy(LOCK) \
-    ((void)(LOCK), 0)
-
-/* ------------------------- gl_rwlock_t datatype ------------------------- */
-
-typedef pth_rwlock_t gl_rwlock_t;
-#  define gl_rwlock_define(STORAGECLASS, NAME) \
-     STORAGECLASS pth_rwlock_t NAME;
-#  define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
-     STORAGECLASS pth_rwlock_t NAME = gl_rwlock_initializer;
-#  define gl_rwlock_initializer \
-     PTH_RWLOCK_INIT
-#  define glthread_rwlock_init(LOCK) \
-     (pth_in_use () && !pth_rwlock_init (LOCK) ? errno : 0)
-#  define glthread_rwlock_rdlock(LOCK) \
-     (pth_in_use () && !pth_rwlock_acquire (LOCK, PTH_RWLOCK_RD, 0, NULL) ? errno : 0)
-#  define glthread_rwlock_wrlock(LOCK) \
-     (pth_in_use () && !pth_rwlock_acquire (LOCK, PTH_RWLOCK_RW, 0, NULL) ? errno : 0)
-#  define glthread_rwlock_unlock(LOCK) \
-     (pth_in_use () && !pth_rwlock_release (LOCK) ? errno : 0)
-#  define glthread_rwlock_destroy(LOCK) \
-     ((void)(LOCK), 0)
-
-/* --------------------- gl_recursive_lock_t datatype --------------------- */
-
-/* In Pth, mutexes are recursive by default.  */
-typedef pth_mutex_t gl_recursive_lock_t;
-#  define gl_recursive_lock_define(STORAGECLASS, NAME) \
-     STORAGECLASS pth_mutex_t NAME;
-#  define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
-     STORAGECLASS pth_mutex_t NAME = gl_recursive_lock_initializer;
-#  define gl_recursive_lock_initializer \
-     PTH_MUTEX_INIT
-#  define glthread_recursive_lock_init(LOCK) \
-     (pth_in_use () && !pth_mutex_init (LOCK) ? errno : 0)
-#  define glthread_recursive_lock_lock(LOCK) \
-     (pth_in_use () && !pth_mutex_acquire (LOCK, 0, NULL) ? errno : 0)
-#  define glthread_recursive_lock_unlock(LOCK) \
-     (pth_in_use () && !pth_mutex_release (LOCK) ? errno : 0)
-#  define glthread_recursive_lock_destroy(LOCK) \
-     ((void)(LOCK), 0)
-
-/* -------------------------- gl_once_t datatype -------------------------- */
-
-typedef pth_once_t gl_once_t;
-# define gl_once_define(STORAGECLASS, NAME) \
-    STORAGECLASS pth_once_t NAME = PTH_ONCE_INIT;
-# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
-    (pth_in_use ()                                                             \
-     ? glthread_once_multithreaded (ONCE_CONTROL, INITFUNCTION)                \
-     : (glthread_once_singlethreaded (ONCE_CONTROL) ? (INITFUNCTION (), 0) : 0))
-extern int glthread_once_multithreaded (pth_once_t *once_control, void (*initfunction) (void));
-extern int glthread_once_singlethreaded (pth_once_t *once_control);
-
-# ifdef __cplusplus
-}
-# endif
-
-#endif
-
-/* ========================================================================= */
-
-#if USE_SOLARIS_THREADS
-
-/* Use the old Solaris threads library.  */
-
-# include <thread.h>
-# include <synch.h>
-
-# ifdef __cplusplus
-extern "C" {
-# endif
-
-# if USE_SOLARIS_THREADS_WEAK
-
-/* Use weak references to the old Solaris threads library.  */
-
-#  pragma weak mutex_init
-#  pragma weak mutex_lock
-#  pragma weak mutex_unlock
-#  pragma weak mutex_destroy
-#  pragma weak rwlock_init
-#  pragma weak rw_rdlock
-#  pragma weak rw_wrlock
-#  pragma weak rw_unlock
-#  pragma weak rwlock_destroy
-#  pragma weak thr_self
-
-#  pragma weak thr_suspend
-#  define thread_in_use() (thr_suspend != NULL)
-
-# else
-
-#  define thread_in_use() 1
-
-# endif
-
-/* -------------------------- gl_lock_t datatype -------------------------- */
-
-typedef mutex_t gl_lock_t;
-# define gl_lock_define(STORAGECLASS, NAME) \
-    STORAGECLASS mutex_t NAME;
-# define gl_lock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS mutex_t NAME = gl_lock_initializer;
-# define gl_lock_initializer \
-    DEFAULTMUTEX
-# define glthread_lock_init(LOCK) \
-    (thread_in_use () ? mutex_init (LOCK, USYNC_THREAD, NULL) : 0)
-# define glthread_lock_lock(LOCK) \
-    (thread_in_use () ? mutex_lock (LOCK) : 0)
-# define glthread_lock_unlock(LOCK) \
-    (thread_in_use () ? mutex_unlock (LOCK) : 0)
-# define glthread_lock_destroy(LOCK) \
-    (thread_in_use () ? mutex_destroy (LOCK) : 0)
-
-/* ------------------------- gl_rwlock_t datatype ------------------------- */
-
-typedef rwlock_t gl_rwlock_t;
-# define gl_rwlock_define(STORAGECLASS, NAME) \
-    STORAGECLASS rwlock_t NAME;
-# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS rwlock_t NAME = gl_rwlock_initializer;
-# define gl_rwlock_initializer \
-    DEFAULTRWLOCK
-# define glthread_rwlock_init(LOCK) \
-    (thread_in_use () ? rwlock_init (LOCK, USYNC_THREAD, NULL) : 0)
-# define glthread_rwlock_rdlock(LOCK) \
-    (thread_in_use () ? rw_rdlock (LOCK) : 0)
-# define glthread_rwlock_wrlock(LOCK) \
-    (thread_in_use () ? rw_wrlock (LOCK) : 0)
-# define glthread_rwlock_unlock(LOCK) \
-    (thread_in_use () ? rw_unlock (LOCK) : 0)
-# define glthread_rwlock_destroy(LOCK) \
-    (thread_in_use () ? rwlock_destroy (LOCK) : 0)
-
-/* --------------------- gl_recursive_lock_t datatype --------------------- */
-
-/* Old Solaris threads did not have recursive locks.
-   We have to implement them ourselves.  */
-
-typedef struct
-        {
-          mutex_t mutex;
-          thread_t owner;
-          unsigned long depth;
-        }
-        gl_recursive_lock_t;
-# define gl_recursive_lock_define(STORAGECLASS, NAME) \
-    STORAGECLASS gl_recursive_lock_t NAME;
-# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS gl_recursive_lock_t NAME = gl_recursive_lock_initializer;
-# define gl_recursive_lock_initializer \
-    { DEFAULTMUTEX, (thread_t) 0, 0 }
-# define glthread_recursive_lock_init(LOCK) \
-    (thread_in_use () ? glthread_recursive_lock_init_multithreaded (LOCK) : 0)
-# define glthread_recursive_lock_lock(LOCK) \
-    (thread_in_use () ? glthread_recursive_lock_lock_multithreaded (LOCK) : 0)
-# define glthread_recursive_lock_unlock(LOCK) \
-    (thread_in_use () ? glthread_recursive_lock_unlock_multithreaded (LOCK) : 0)
-# define glthread_recursive_lock_destroy(LOCK) \
-    (thread_in_use () ? glthread_recursive_lock_destroy_multithreaded (LOCK) : 0)
-extern int glthread_recursive_lock_init_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_lock_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_unlock_multithreaded (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_destroy_multithreaded (gl_recursive_lock_t *lock);
-
-/* -------------------------- gl_once_t datatype -------------------------- */
-
-typedef struct
-        {
-          volatile int inited;
-          mutex_t mutex;
-        }
-        gl_once_t;
-# define gl_once_define(STORAGECLASS, NAME) \
-    STORAGECLASS gl_once_t NAME = { 0, DEFAULTMUTEX };
-# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
-    (thread_in_use ()                                                          \
-     ? glthread_once_multithreaded (ONCE_CONTROL, INITFUNCTION)                \
-     : (glthread_once_singlethreaded (ONCE_CONTROL) ? (INITFUNCTION (), 0) : 0))
-extern int glthread_once_multithreaded (gl_once_t *once_control, void (*initfunction) (void));
-extern int glthread_once_singlethreaded (gl_once_t *once_control);
-
-# ifdef __cplusplus
-}
-# endif
-
-#endif
-
-/* ========================================================================= */
-
-#if USE_WINDOWS_THREADS
-
-# define WIN32_LEAN_AND_MEAN  /* avoid including junk */
-# include <windows.h>
-
-# ifdef __cplusplus
-extern "C" {
-# endif
-
-/* We can use CRITICAL_SECTION directly, rather than the native Windows Event,
-   Mutex, Semaphore types, because
-     - we need only to synchronize inside a single process (address space),
-       not inter-process locking,
-     - we don't need to support trylock operations.  (TryEnterCriticalSection
-       does not work on Windows 95/98/ME.  Packages that need trylock usually
-       define their own mutex type.)  */
-
-/* There is no way to statically initialize a CRITICAL_SECTION.  It needs
-   to be done lazily, once only.  For this we need spinlocks.  */
-
-typedef struct { volatile int done; volatile long started; } gl_spinlock_t;
-
-/* -------------------------- gl_lock_t datatype -------------------------- */
-
-typedef struct
-        {
-          gl_spinlock_t guard; /* protects the initialization */
-          CRITICAL_SECTION lock;
-        }
-        gl_lock_t;
-# define gl_lock_define(STORAGECLASS, NAME) \
-    STORAGECLASS gl_lock_t NAME;
-# define gl_lock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS gl_lock_t NAME = gl_lock_initializer;
-# define gl_lock_initializer \
-    { { 0, -1 } }
-# define glthread_lock_init(LOCK) \
-    (glthread_lock_init_func (LOCK), 0)
-# define glthread_lock_lock(LOCK) \
-    glthread_lock_lock_func (LOCK)
-# define glthread_lock_unlock(LOCK) \
-    glthread_lock_unlock_func (LOCK)
-# define glthread_lock_destroy(LOCK) \
-    glthread_lock_destroy_func (LOCK)
-extern void glthread_lock_init_func (gl_lock_t *lock);
-extern int glthread_lock_lock_func (gl_lock_t *lock);
-extern int glthread_lock_unlock_func (gl_lock_t *lock);
-extern int glthread_lock_destroy_func (gl_lock_t *lock);
-
-/* ------------------------- gl_rwlock_t datatype ------------------------- */
-
-/* It is impossible to implement read-write locks using plain locks, without
-   introducing an extra thread dedicated to managing read-write locks.
-   Therefore here we need to use the low-level Event type.  */
-
-typedef struct
-        {
-          HANDLE *array; /* array of waiting threads, each represented by an event */
-          unsigned int count; /* number of waiting threads */
-          unsigned int alloc; /* length of allocated array */
-          unsigned int offset; /* index of first waiting thread in array */
-        }
-        gl_carray_waitqueue_t;
-typedef struct
-        {
-          gl_spinlock_t guard; /* protects the initialization */
-          CRITICAL_SECTION lock; /* protects the remaining fields */
-          gl_carray_waitqueue_t waiting_readers; /* waiting readers */
-          gl_carray_waitqueue_t waiting_writers; /* waiting writers */
-          int runcount; /* number of readers running, or -1 when a writer runs */
-        }
-        gl_rwlock_t;
-# define gl_rwlock_define(STORAGECLASS, NAME) \
-    STORAGECLASS gl_rwlock_t NAME;
-# define gl_rwlock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS gl_rwlock_t NAME = gl_rwlock_initializer;
-# define gl_rwlock_initializer \
-    { { 0, -1 } }
-# define glthread_rwlock_init(LOCK) \
-    (glthread_rwlock_init_func (LOCK), 0)
-# define glthread_rwlock_rdlock(LOCK) \
-    glthread_rwlock_rdlock_func (LOCK)
-# define glthread_rwlock_wrlock(LOCK) \
-    glthread_rwlock_wrlock_func (LOCK)
-# define glthread_rwlock_unlock(LOCK) \
-    glthread_rwlock_unlock_func (LOCK)
-# define glthread_rwlock_destroy(LOCK) \
-    glthread_rwlock_destroy_func (LOCK)
-extern void glthread_rwlock_init_func (gl_rwlock_t *lock);
-extern int glthread_rwlock_rdlock_func (gl_rwlock_t *lock);
-extern int glthread_rwlock_wrlock_func (gl_rwlock_t *lock);
-extern int glthread_rwlock_unlock_func (gl_rwlock_t *lock);
-extern int glthread_rwlock_destroy_func (gl_rwlock_t *lock);
-
-/* --------------------- gl_recursive_lock_t datatype --------------------- */
-
-/* The native Windows documentation says that CRITICAL_SECTION already
-   implements a recursive lock.  But we need not rely on it: It's easy to
-   implement a recursive lock without this assumption.  */
-
-typedef struct
-        {
-          gl_spinlock_t guard; /* protects the initialization */
-          DWORD owner;
-          unsigned long depth;
-          CRITICAL_SECTION lock;
-        }
-        gl_recursive_lock_t;
-# define gl_recursive_lock_define(STORAGECLASS, NAME) \
-    STORAGECLASS gl_recursive_lock_t NAME;
-# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME) \
-    STORAGECLASS gl_recursive_lock_t NAME = gl_recursive_lock_initializer;
-# define gl_recursive_lock_initializer \
-    { { 0, -1 }, 0, 0 }
-# define glthread_recursive_lock_init(LOCK) \
-    (glthread_recursive_lock_init_func (LOCK), 0)
-# define glthread_recursive_lock_lock(LOCK) \
-    glthread_recursive_lock_lock_func (LOCK)
-# define glthread_recursive_lock_unlock(LOCK) \
-    glthread_recursive_lock_unlock_func (LOCK)
-# define glthread_recursive_lock_destroy(LOCK) \
-    glthread_recursive_lock_destroy_func (LOCK)
-extern void glthread_recursive_lock_init_func (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_lock_func (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_unlock_func (gl_recursive_lock_t *lock);
-extern int glthread_recursive_lock_destroy_func (gl_recursive_lock_t *lock);
-
-/* -------------------------- gl_once_t datatype -------------------------- */
-
-typedef struct
-        {
-          volatile int inited;
-          volatile long started;
-          CRITICAL_SECTION lock;
-        }
-        gl_once_t;
-# define gl_once_define(STORAGECLASS, NAME) \
-    STORAGECLASS gl_once_t NAME = { -1, -1 };
-# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
-    (glthread_once_func (ONCE_CONTROL, INITFUNCTION), 0)
-extern void glthread_once_func (gl_once_t *once_control, void (*initfunction) (void));
-
-# ifdef __cplusplus
-}
-# endif
-
-#endif
-
-/* ========================================================================= */
-
-#if !(USE_POSIX_THREADS || USE_PTH_THREADS || USE_SOLARIS_THREADS || USE_WINDOWS_THREADS)
-
-/* Provide dummy implementation if threads are not supported.  */
-
-/* -------------------------- gl_lock_t datatype -------------------------- */
-
-typedef int gl_lock_t;
-# define gl_lock_define(STORAGECLASS, NAME)
-# define gl_lock_define_initialized(STORAGECLASS, NAME)
-# define glthread_lock_init(NAME) 0
-# define glthread_lock_lock(NAME) 0
-# define glthread_lock_unlock(NAME) 0
-# define glthread_lock_destroy(NAME) 0
-
-/* ------------------------- gl_rwlock_t datatype ------------------------- */
-
-typedef int gl_rwlock_t;
-# define gl_rwlock_define(STORAGECLASS, NAME)
-# define gl_rwlock_define_initialized(STORAGECLASS, NAME)
-# define glthread_rwlock_init(NAME) 0
-# define glthread_rwlock_rdlock(NAME) 0
-# define glthread_rwlock_wrlock(NAME) 0
-# define glthread_rwlock_unlock(NAME) 0
-# define glthread_rwlock_destroy(NAME) 0
-
-/* --------------------- gl_recursive_lock_t datatype --------------------- */
-
-typedef int gl_recursive_lock_t;
-# define gl_recursive_lock_define(STORAGECLASS, NAME)
-# define gl_recursive_lock_define_initialized(STORAGECLASS, NAME)
-# define glthread_recursive_lock_init(NAME) 0
-# define glthread_recursive_lock_lock(NAME) 0
-# define glthread_recursive_lock_unlock(NAME) 0
-# define glthread_recursive_lock_destroy(NAME) 0
-
-/* -------------------------- gl_once_t datatype -------------------------- */
-
-typedef int gl_once_t;
-# define gl_once_define(STORAGECLASS, NAME) \
-    STORAGECLASS gl_once_t NAME = 0;
-# define glthread_once(ONCE_CONTROL, INITFUNCTION) \
-    (*(ONCE_CONTROL) == 0 ? (*(ONCE_CONTROL) = ~ 0, INITFUNCTION (), 0) : 0)
-
-#endif
-
-/* ========================================================================= */
-
-/* Macros with built-in error handling.  */
-
-/* -------------------------- gl_lock_t datatype -------------------------- */
-
-#define gl_lock_init(NAME) \
-   do                                  \
-     {                                 \
-       if (glthread_lock_init (&NAME)) \
-         abort ();                     \
-     }                                 \
-   while (0)
-#define gl_lock_lock(NAME) \
-   do                                  \
-     {                                 \
-       if (glthread_lock_lock (&NAME)) \
-         abort ();                     \
-     }                                 \
-   while (0)
-#define gl_lock_unlock(NAME) \
-   do                                    \
-     {                                   \
-       if (glthread_lock_unlock (&NAME)) \
-         abort ();                       \
-     }                                   \
-   while (0)
-#define gl_lock_destroy(NAME) \
-   do                                     \
-     {                                    \
-       if (glthread_lock_destroy (&NAME)) \
-         abort ();                        \
-     }                                    \
-   while (0)
-
-/* ------------------------- gl_rwlock_t datatype ------------------------- */
-
-#define gl_rwlock_init(NAME) \
-   do                                    \
-     {                                   \
-       if (glthread_rwlock_init (&NAME)) \
-         abort ();                       \
-     }                                   \
-   while (0)
-#define gl_rwlock_rdlock(NAME) \
-   do                                      \
-     {                                     \
-       if (glthread_rwlock_rdlock (&NAME)) \
-         abort ();                         \
-     }                                     \
-   while (0)
-#define gl_rwlock_wrlock(NAME) \
-   do                                      \
-     {                                     \
-       if (glthread_rwlock_wrlock (&NAME)) \
-         abort ();                         \
-     }                                     \
-   while (0)
-#define gl_rwlock_unlock(NAME) \
-   do                                      \
-     {                                     \
-       if (glthread_rwlock_unlock (&NAME)) \
-         abort ();                         \
-     }                                     \
-   while (0)
-#define gl_rwlock_destroy(NAME) \
-   do                                       \
-     {                                      \
-       if (glthread_rwlock_destroy (&NAME)) \
-         abort ();                          \
-     }                                      \
-   while (0)
-
-/* --------------------- gl_recursive_lock_t datatype --------------------- */
-
-#define gl_recursive_lock_init(NAME) \
-   do                                            \
-     {                                           \
-       if (glthread_recursive_lock_init (&NAME)) \
-         abort ();                               \
-     }                                           \
-   while (0)
-#define gl_recursive_lock_lock(NAME) \
-   do                                            \
-     {                                           \
-       if (glthread_recursive_lock_lock (&NAME)) \
-         abort ();                               \
-     }                                           \
-   while (0)
-#define gl_recursive_lock_unlock(NAME) \
-   do                                              \
-     {                                             \
-       if (glthread_recursive_lock_unlock (&NAME)) \
-         abort ();                                 \
-     }                                             \
-   while (0)
-#define gl_recursive_lock_destroy(NAME) \
-   do                                               \
-     {                                              \
-       if (glthread_recursive_lock_destroy (&NAME)) \
-         abort ();                                  \
-     }                                              \
-   while (0)
-
-/* -------------------------- gl_once_t datatype -------------------------- */
-
-#define gl_once(NAME, INITFUNCTION) \
-   do                                           \
-     {                                          \
-       if (glthread_once (&NAME, INITFUNCTION)) \
-         abort ();                              \
-     }                                          \
-   while (0)
-
-/* ========================================================================= */
-
-#endif /* _LOCK_H */

lib/glthread/threadlib.c

@@ -1,73 +0,0 @@
-/* Multithreading primitives.
-   Copyright (C) 2005-2014 Free Software Foundation, Inc.
-
-   This program is free software; you can redistribute it and/or modify
-   it under the terms of the GNU Lesser General Public License as published by
-   the Free Software Foundation; either version 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, see <http://www.gnu.org/licenses/>.  */
-
-/* Written by Bruno Haible <bruno@clisp.org>, 2005.  */
-
-#include <config.h>
-
-/* ========================================================================= */
-
-#if USE_POSIX_THREADS
-
-/* Use the POSIX threads library.  */
-
-# include <pthread.h>
-# include <stdlib.h>
-
-# if PTHREAD_IN_USE_DETECTION_HARD
-
-/* The function to be executed by a dummy thread.  */
-static void *
-dummy_thread_func (void *arg)
-{
-  return arg;
-}
-
-int
-glthread_in_use (void)
-{
-  static int tested;
-  static int result; /* 1: linked with -lpthread, 0: only with libc */
-
-  if (!tested)
-    {
-      pthread_t thread;
-
-      if (pthread_create (&thread, NULL, dummy_thread_func, NULL) != 0)
-        /* Thread creation failed.  */
-        result = 0;
-      else
-        {
-          /* Thread creation works.  */
-          void *retval;
-          if (pthread_join (thread, &retval) != 0)
-            abort ();
-          result = 1;
-        }
-      tested = 1;
-    }
-  return result;
-}
-
-# endif
-
-#endif
-
-/* ========================================================================= */
-
-/* This declaration is solely to ensure that after preprocessing
-   this file is never empty.  */
-typedef int dummy;

lib/link.c

@@ -0,0 +1,211 @@
+/* Emulate link on platforms that lack it, namely native Windows platforms.
+
+   Copyright (C) 2009-2014 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 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, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#include <unistd.h>
+
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+
+#if !HAVE_LINK
+# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+
+#  define WIN32_LEAN_AND_MEAN
+#  include <windows.h>
+
+/* CreateHardLink was introduced only in Windows 2000.  */
+typedef BOOL (WINAPI * CreateHardLinkFuncType) (LPCTSTR lpFileName,
+                                                LPCTSTR lpExistingFileName,
+                                                LPSECURITY_ATTRIBUTES lpSecurityAttributes);
+static CreateHardLinkFuncType CreateHardLinkFunc = NULL;
+static BOOL initialized = FALSE;
+
+static void
+initialize (void)
+{
+  HMODULE kernel32 = GetModuleHandle ("kernel32.dll");
+  if (kernel32 != NULL)
+    {
+      CreateHardLinkFunc =
+        (CreateHardLinkFuncType) GetProcAddress (kernel32, "CreateHardLinkA");
+    }
+  initialized = TRUE;
+}
+
+int
+link (const char *file1, const char *file2)
+{
+  char *dir;
+  size_t len1 = strlen (file1);
+  size_t len2 = strlen (file2);
+  if (!initialized)
+    initialize ();
+  if (CreateHardLinkFunc == NULL)
+    {
+      /* System does not support hard links.  */
+      errno = EPERM;
+      return -1;
+    }
+  /* Reject trailing slashes on non-directories; mingw does not
+     support hard-linking directories.  */
+  if ((len1 && (file1[len1 - 1] == '/' || file1[len1 - 1] == '\\'))
+      || (len2 && (file2[len2 - 1] == '/' || file2[len2 - 1] == '\\')))
+    {
+      struct stat st;
+      if (stat (file1, &st) == 0 && S_ISDIR (st.st_mode))
+        errno = EPERM;
+      else
+        errno = ENOTDIR;
+      return -1;
+    }
+  /* CreateHardLink("b/.","a",NULL) creates file "b", so we must check
+     that dirname(file2) exists.  */
+  dir = strdup (file2);
+  if (!dir)
+    return -1;
+  {
+    struct stat st;
+    char *p = strchr (dir, '\0');
+    while (dir < p && (*--p != '/' && *p != '\\'));
+    *p = '\0';
+    if (p != dir && stat (dir, &st) == -1)
+      {
+        int saved_errno = errno;
+        free (dir);
+        errno = saved_errno;
+        return -1;
+      }
+    free (dir);
+  }
+  /* Now create the link.  */
+  if (CreateHardLinkFunc (file2, file1, NULL) == 0)
+    {
+      /* It is not documented which errors CreateHardLink() can produce.
+       * The following conversions are based on tests on a Windows XP SP2
+       * system. */
+      DWORD err = GetLastError ();
+      switch (err)
+        {
+        case ERROR_ACCESS_DENIED:
+          errno = EACCES;
+          break;
+
+        case ERROR_INVALID_FUNCTION:    /* fs does not support hard links */
+          errno = EPERM;
+          break;
+
+        case ERROR_NOT_SAME_DEVICE:
+          errno = EXDEV;
+          break;
+
+        case ERROR_PATH_NOT_FOUND:
+        case ERROR_FILE_NOT_FOUND:
+          errno = ENOENT;
+          break;
+
+        case ERROR_INVALID_PARAMETER:
+          errno = ENAMETOOLONG;
+          break;
+
+        case ERROR_TOO_MANY_LINKS:
+          errno = EMLINK;
+          break;
+
+        case ERROR_ALREADY_EXISTS:
+          errno = EEXIST;
+          break;
+
+        default:
+          errno = EIO;
+        }
+      return -1;
+    }
+
+  return 0;
+}
+
+# else /* !Windows */
+
+#  error "This platform lacks a link function, and Gnulib doesn't provide a replacement. This is a bug in Gnulib."
+
+# endif /* !Windows */
+#else /* HAVE_LINK */
+
+# undef link
+
+/* Create a hard link from FILE1 to FILE2, working around platform bugs.  */
+int
+rpl_link (char const *file1, char const *file2)
+{
+  size_t len1;
+  size_t len2;
+  struct stat st;
+
+  /* Don't allow IRIX to dereference dangling file2 symlink.  */
+  if (!lstat (file2, &st))
+    {
+      errno = EEXIST;
+      return -1;
+    }
+
+  /* Reject trailing slashes on non-directories.  */
+  len1 = strlen (file1);
+  len2 = strlen (file2);
+  if ((len1 && file1[len1 - 1] == '/')
+      || (len2 && file2[len2 - 1] == '/'))
+    {
+      /* Let link() decide whether hard-linking directories is legal.
+         If stat() fails, then link() should fail for the same reason
+         (although on Solaris 9, link("file/","oops") mistakenly
+         succeeds); if stat() succeeds, require a directory.  */
+      if (stat (file1, &st))
+        return -1;
+      if (!S_ISDIR (st.st_mode))
+        {
+          errno = ENOTDIR;
+          return -1;
+        }
+    }
+  else
+    {
+      /* Fix Cygwin 1.5.x bug where link("a","b/.") creates file "b".  */
+      char *dir = strdup (file2);
+      char *p;
+      if (!dir)
+        return -1;
+      /* We already know file2 does not end in slash.  Strip off the
+         basename, then check that the dirname exists.  */
+      p = strrchr (dir, '/');
+      if (p)
+        {
+          *p = '\0';
+          if (stat (dir, &st) == -1)
+            {
+              int saved_errno = errno;
+              free (dir);
+              errno = saved_errno;
+              return -1;
+            }
+        }
+      free (dir);
+    }
+  return link (file1, file2);
+}
+#endif /* HAVE_LINK */

lib/mkdir.c

@@ -0,0 +1,93 @@
+/* On some systems, mkdir ("foo/", 0700) fails because of the trailing
+   slash.  On those systems, this wrapper removes the trailing slash.
+
+   Copyright (C) 2001, 2003, 2006, 2008-2014 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 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/>.  */
+
+/* written by Jim Meyering */
+
+#include <config.h>
+
+/* Specification.  */
+#include <sys/stat.h>
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "dirname.h"
+
+/* Disable the definition of mkdir to rpl_mkdir (from the <sys/stat.h>
+   substitute) in this file.  Otherwise, we'd get an endless recursion.  */
+#undef mkdir
+
+/* mingw's _mkdir() function has 1 argument, but we pass 2 arguments.
+   Additionally, it declares _mkdir (and depending on compile flags, an
+   alias mkdir), only in the nonstandard includes <direct.h> and <io.h>,
+   which are included in the <sys/stat.h> override.  */
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+# define mkdir(name,mode) _mkdir (name)
+# define maybe_unused _GL_UNUSED
+#else
+# define maybe_unused /* empty */
+#endif
+
+/* This function is required at least for NetBSD 1.5.2.  */
+
+int
+rpl_mkdir (char const *dir, mode_t mode maybe_unused)
+{
+  int ret_val;
+  char *tmp_dir;
+  size_t len = strlen (dir);
+
+  if (len && dir[len - 1] == '/')
+    {
+      tmp_dir = strdup (dir);
+      if (!tmp_dir)
+        {
+          /* Rather than rely on strdup-posix, we set errno ourselves.  */
+          errno = ENOMEM;
+          return -1;
+        }
+      strip_trailing_slashes (tmp_dir);
+    }
+  else
+    {
+      tmp_dir = (char *) dir;
+    }
+#if FUNC_MKDIR_DOT_BUG
+  /* Additionally, cygwin 1.5 mistakenly creates a directory "d/./".  */
+  {
+    char *last = last_component (tmp_dir);
+    if (*last == '.' && (last[1] == '\0'
+                         || (last[1] == '.' && last[2] == '\0')))
+      {
+        struct stat st;
+        if (stat (tmp_dir, &st) == 0)
+          errno = EEXIST;
+        return -1;
+      }
+  }
+#endif /* FUNC_MKDIR_DOT_BUG */
+
+  ret_val = mkdir (tmp_dir, mode);
+
+  if (tmp_dir != dir)
+    free (tmp_dir);
+
+  return ret_val;
+}

lib/mkstemp.c

@@ -0,0 +1,50 @@
+/* Copyright (C) 1998-1999, 2001, 2005-2007, 2009-2014 Free Software
+   Foundation, Inc.
+   This file is derived from the one in the GNU C Library.
+
+   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/>.  */
+
+#if !_LIBC
+# include <config.h>
+#endif
+
+#include <stdlib.h>
+
+#if !_LIBC
+# include "tempname.h"
+# define __gen_tempname gen_tempname
+# ifndef __GT_FILE
+#  define __GT_FILE GT_FILE
+# endif
+#endif
+
+#include <stdio.h>
+
+#ifndef __GT_FILE
+# define __GT_FILE 0
+#endif
+
+/* Generate a unique temporary file name from XTEMPLATE.
+   The last six characters of XTEMPLATE must be "XXXXXX";
+   they are replaced with a string that makes the file name unique.
+   Then open the file and return a fd.
+
+   If you are creating temporary files which will later be removed,
+   consider using the clean-temp module, which avoids several pitfalls
+   of using mkstemp directly. */
+int
+mkstemp (char *xtemplate)
+{
+  return __gen_tempname (xtemplate, 0, 0, __GT_FILE);
+}

lib/secure_getenv.c

@@ -0,0 +1,41 @@
+/* Look up an environment variable more securely.
+
+   Copyright 2013-2014 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 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/>.  */
+
+#include <config.h>
+
+#include <stdlib.h>
+
+#if !HAVE___SECURE_GETENV
+# if HAVE_ISSETUGID
+#  include <unistd.h>
+# else
+#  undef issetugid
+#  define issetugid() 1
+# endif
+#endif
+
+char *
+secure_getenv (char const *name)
+{
+#if HAVE___SECURE_GETENV
+  return __secure_getenv (name);
+#else
+  if (issetugid ())
+    return 0;
+  return getenv (name);
+#endif
+}

lib/strdup.c

@@ -0,0 +1,54 @@
+/* Copyright (C) 1991, 1996-1998, 2002-2004, 2006-2007, 2009-2014 Free Software
+   Foundation, Inc.
+
+   This file is part of the GNU C Library.
+
+   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, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _LIBC
+# include <config.h>
+#endif
+
+/* Get specification.  */
+#include <string.h>
+
+#include <stdlib.h>
+
+#undef __strdup
+#ifdef _LIBC
+# undef strdup
+#endif
+
+#ifndef weak_alias
+# define __strdup strdup
+#endif
+
+/* Duplicate S, returning an identical malloc'd string.  */
+char *
+__strdup (const char *s)
+{
+  size_t len = strlen (s) + 1;
+  void *new = malloc (len);
+
+  if (new == NULL)
+    return NULL;
+
+  return (char *) memcpy (new, s, len);
+}
+#ifdef libc_hidden_def
+libc_hidden_def (__strdup)
+#endif
+#ifdef weak_alias
+weak_alias (__strdup, strdup)
+#endif

lib/tempname.c

@@ -0,0 +1,306 @@
+/* tempname.c - generate the name of a temporary file.
+
+   Copyright (C) 1991-2003, 2005-2007, 2009-2014 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 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/>.  */
+
+/* Extracted from glibc sysdeps/posix/tempname.c.  See also tmpdir.c.  */
+
+#if !_LIBC
+# include <config.h>
+# include "tempname.h"
+#endif
+
+#include <sys/types.h>
+#include <assert.h>
+
+#include <errno.h>
+#ifndef __set_errno
+# define __set_errno(Val) errno = (Val)
+#endif
+
+#include <stdio.h>
+#ifndef P_tmpdir
+# define P_tmpdir "/tmp"
+#endif
+#ifndef TMP_MAX
+# define TMP_MAX 238328
+#endif
+#ifndef __GT_FILE
+# define __GT_FILE      0
+# define __GT_DIR       1
+# define __GT_NOCREATE  2
+#endif
+#if !_LIBC && (GT_FILE != __GT_FILE || GT_DIR != __GT_DIR       \
+               || GT_NOCREATE != __GT_NOCREATE)
+# error report this to bug-gnulib@gnu.org
+#endif
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <fcntl.h>
+#include <sys/time.h>
+#include <stdint.h>
+#include <unistd.h>
+
+#include <sys/stat.h>
+
+#if _LIBC
+# define struct_stat64 struct stat64
+#else
+# define struct_stat64 struct stat
+# define __gen_tempname gen_tempname
+# define __getpid getpid
+# define __gettimeofday gettimeofday
+# define __mkdir mkdir
+# define __open open
+# define __lxstat64(version, file, buf) lstat (file, buf)
+# define __secure_getenv secure_getenv
+#endif
+
+#ifdef _LIBC
+# include <hp-timing.h>
+# if HP_TIMING_AVAIL
+#  define RANDOM_BITS(Var) \
+  if (__builtin_expect (value == UINT64_C (0), 0))                            \
+    {                                                                         \
+      /* If this is the first time this function is used initialize           \
+         the variable we accumulate the value in to some somewhat             \
+         random value.  If we'd not do this programs at startup time          \
+         might have a reduced set of possible names, at least on slow         \
+         machines.  */                                                        \
+      struct timeval tv;                                                      \
+      __gettimeofday (&tv, NULL);                                             \
+      value = ((uint64_t) tv.tv_usec << 16) ^ tv.tv_sec;                      \
+    }                                                                         \
+  HP_TIMING_NOW (Var)
+# endif
+#endif
+
+/* Use the widest available unsigned type if uint64_t is not
+   available.  The algorithm below extracts a number less than 62**6
+   (approximately 2**35.725) from uint64_t, so ancient hosts where
+   uintmax_t is only 32 bits lose about 3.725 bits of randomness,
+   which is better than not having mkstemp at all.  */
+#if !defined UINT64_MAX && !defined uint64_t
+# define uint64_t uintmax_t
+#endif
+
+#if _LIBC
+/* Return nonzero if DIR is an existent directory.  */
+static int
+direxists (const char *dir)
+{
+  struct_stat64 buf;
+  return __xstat64 (_STAT_VER, dir, &buf) == 0 && S_ISDIR (buf.st_mode);
+}
+
+/* Path search algorithm, for tmpnam, tmpfile, etc.  If DIR is
+   non-null and exists, uses it; otherwise uses the first of $TMPDIR,
+   P_tmpdir, /tmp that exists.  Copies into TMPL a template suitable
+   for use with mk[s]temp.  Will fail (-1) if DIR is non-null and
+   doesn't exist, none of the searched dirs exists, or there's not
+   enough space in TMPL. */
+int
+__path_search (char *tmpl, size_t tmpl_len, const char *dir, const char *pfx,
+               int try_tmpdir)
+{
+  const char *d;
+  size_t dlen, plen;
+
+  if (!pfx || !pfx[0])
+    {
+      pfx = "file";
+      plen = 4;
+    }
+  else
+    {
+      plen = strlen (pfx);
+      if (plen > 5)
+        plen = 5;
+    }
+
+  if (try_tmpdir)
+    {
+      d = __secure_getenv ("TMPDIR");
+      if (d != NULL && direxists (d))
+        dir = d;
+      else if (dir != NULL && direxists (dir))
+        /* nothing */ ;
+      else
+        dir = NULL;
+    }
+  if (dir == NULL)
+    {
+      if (direxists (P_tmpdir))
+        dir = P_tmpdir;
+      else if (strcmp (P_tmpdir, "/tmp") != 0 && direxists ("/tmp"))
+        dir = "/tmp";
+      else
+        {
+          __set_errno (ENOENT);
+          return -1;
+        }
+    }
+
+  dlen = strlen (dir);
+  while (dlen > 1 && dir[dlen - 1] == '/')
+    dlen--;                     /* remove trailing slashes */
+
+  /* check we have room for "${dir}/${pfx}XXXXXX\0" */
+  if (tmpl_len < dlen + 1 + plen + 6 + 1)
+    {
+      __set_errno (EINVAL);
+      return -1;
+    }
+
+  sprintf (tmpl, "%.*s/%.*sXXXXXX", (int) dlen, dir, (int) plen, pfx);
+  return 0;
+}
+#endif /* _LIBC */
+
+/* These are the characters used in temporary file names.  */
+static const char letters[] =
+"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
+
+/* Generate a temporary file name based on TMPL.  TMPL must match the
+   rules for mk[s]temp (i.e. end in "XXXXXX", possibly with a suffix).
+   The name constructed does not exist at the time of the call to
+   __gen_tempname.  TMPL is overwritten with the result.
+
+   KIND may be one of:
+   __GT_NOCREATE:       simply verify that the name does not exist
+                        at the time of the call.
+   __GT_FILE:           create the file using open(O_CREAT|O_EXCL)
+                        and return a read-write fd.  The file is mode 0600.
+   __GT_DIR:            create a directory, which will be mode 0700.
+
+   We use a clever algorithm to get hard-to-predict names. */
+int
+__gen_tempname (char *tmpl, int suffixlen, int flags, int kind)
+{
+  int len;
+  char *XXXXXX;
+  static uint64_t value;
+  uint64_t random_time_bits;
+  unsigned int count;
+  int fd = -1;
+  int save_errno = errno;
+  struct_stat64 st;
+
+  /* A lower bound on the number of temporary files to attempt to
+     generate.  The maximum total number of temporary file names that
+     can exist for a given template is 62**6.  It should never be
+     necessary to try all of these combinations.  Instead if a reasonable
+     number of names is tried (we define reasonable as 62**3) fail to
+     give the system administrator the chance to remove the problems.  */
+#define ATTEMPTS_MIN (62 * 62 * 62)
+
+  /* The number of times to attempt to generate a temporary file.  To
+     conform to POSIX, this must be no smaller than TMP_MAX.  */
+#if ATTEMPTS_MIN < TMP_MAX
+  unsigned int attempts = TMP_MAX;
+#else
+  unsigned int attempts = ATTEMPTS_MIN;
+#endif
+
+  len = strlen (tmpl);
+  if (len < 6 + suffixlen || memcmp (&tmpl[len - 6 - suffixlen], "XXXXXX", 6))
+    {
+      __set_errno (EINVAL);
+      return -1;
+    }
+
+  /* This is where the Xs start.  */
+  XXXXXX = &tmpl[len - 6 - suffixlen];
+
+  /* Get some more or less random data.  */
+#ifdef RANDOM_BITS
+  RANDOM_BITS (random_time_bits);
+#else
+  {
+    struct timeval tv;
+    __gettimeofday (&tv, NULL);
+    random_time_bits = ((uint64_t) tv.tv_usec << 16) ^ tv.tv_sec;
+  }
+#endif
+  value += random_time_bits ^ __getpid ();
+
+  for (count = 0; count < attempts; value += 7777, ++count)
+    {
+      uint64_t v = value;
+
+      /* Fill in the random bits.  */
+      XXXXXX[0] = letters[v % 62];
+      v /= 62;
+      XXXXXX[1] = letters[v % 62];
+      v /= 62;
+      XXXXXX[2] = letters[v % 62];
+      v /= 62;
+      XXXXXX[3] = letters[v % 62];
+      v /= 62;
+      XXXXXX[4] = letters[v % 62];
+      v /= 62;
+      XXXXXX[5] = letters[v % 62];
+
+      switch (kind)
+        {
+        case __GT_FILE:
+          fd = __open (tmpl,
+                       (flags & ~O_ACCMODE)
+                       | O_RDWR | O_CREAT | O_EXCL, S_IRUSR | S_IWUSR);
+          break;
+
+        case __GT_DIR:
+          fd = __mkdir (tmpl, S_IRUSR | S_IWUSR | S_IXUSR);
+          break;
+
+        case __GT_NOCREATE:
+          /* This case is backward from the other three.  __gen_tempname
+             succeeds if __xstat fails because the name does not exist.
+             Note the continue to bypass the common logic at the bottom
+             of the loop.  */
+          if (__lxstat64 (_STAT_VER, tmpl, &st) < 0)
+            {
+              if (errno == ENOENT)
+                {
+                  __set_errno (save_errno);
+                  return 0;
+                }
+              else
+                /* Give up now. */
+                return -1;
+            }
+          continue;
+
+        default:
+          assert (! "invalid KIND in __gen_tempname");
+          abort ();
+        }
+
+      if (fd >= 0)
+        {
+          __set_errno (save_errno);
+          return fd;
+        }
+      else if (errno != EEXIST)
+        return -1;
+    }
+
+  /* We got out of the loop because we ran out of combinations to try.  */
+  __set_errno (EEXIST);
+  return -1;
+}

lib/tempname.h

@@ -0,0 +1,50 @@
+/* Create a temporary file or directory.
+
+   Copyright (C) 2006, 2009-2014 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 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/>.  */
+
+/* header written by Eric Blake */
+
+#ifndef GL_TEMPNAME_H
+# define GL_TEMPNAME_H
+
+# include <stdio.h>
+
+# ifdef __GT_FILE
+#  define GT_FILE     __GT_FILE
+#  define GT_DIR      __GT_DIR
+#  define GT_NOCREATE __GT_NOCREATE
+# else
+#  define GT_FILE     0
+#  define GT_DIR      1
+#  define GT_NOCREATE 2
+# endif
+
+/* Generate a temporary file name based on TMPL.  TMPL must match the
+   rules for mk[s]temp (i.e. end in "XXXXXX", possibly with a suffix).
+   The name constructed does not exist at the time of the call to
+   gen_tempname.  TMPL is overwritten with the result.
+
+   KIND may be one of:
+   GT_NOCREATE:         simply verify that the name does not exist
+                        at the time of the call.
+   GT_FILE:             create a large file using open(O_CREAT|O_EXCL)
+                        and return a read-write fd.  The file is mode 0600.
+   GT_DIR:              create a directory, which will be mode 0700.
+
+   We use a clever algorithm to get hard-to-predict names. */
+extern int gen_tempname (char *tmpl, int suffixlen, int flags, int kind);
+
+#endif /* GL_TEMPNAME_H */

lib/unistd.in.h

@@ -21,9 +21,23 @@
 #endif
 @PRAGMA_COLUMNS@
 
+#ifdef _GL_INCLUDING_UNISTD_H
+/* Special invocation convention:
+   - On Mac OS X 10.3.9 we have a sequence of nested includes
+     <unistd.h> -> <signal.h> -> <pthread.h> -> <unistd.h>
+     In this situation, the functions are not yet declared, therefore we cannot
+     provide the C++ aliases.  */
+
+#@INCLUDE_NEXT@ @NEXT_UNISTD_H@
+
+#else
+/* Normal invocation convention.  */
+
 /* The include_next requires a split double-inclusion guard.  */
 #if @HAVE_UNISTD_H@
+# define _GL_INCLUDING_UNISTD_H
 # @INCLUDE_NEXT@ @NEXT_UNISTD_H@
+# undef _GL_INCLUDING_UNISTD_H
 #endif
 
 /* Get all possible declarations of gethostname().  */
@@ -1539,4 +1553,5 @@ _GL_CXXALIASWARN (write);
 _GL_INLINE_HEADER_END
 
 #endif /* _@GUARD_PREFIX@_UNISTD_H */
+#endif /* _GL_INCLUDING_UNISTD_H */
 #endif /* _@GUARD_PREFIX@_UNISTD_H */

libguile/Makefile.am

@@ -92,11 +92,12 @@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c
 ## Override default rule; this should be compiled for BUILD host.
 ## For some reason, OBJEXT does not include the dot
 c-tokenize.$(OBJEXT): c-tokenize.c
-	$(AM_V_GEN) \
+	$(AM_V_GEN)							\
-	if [ "$(cross_compiling)" = "yes" ]; then \
+	if [ "$(cross_compiling)" = "yes" ]; then			\
-		$(CC_FOR_BUILD) -I$(top_builddir) -c -o $@ $<; \
+		$(CC_FOR_BUILD) -DCROSS_COMPILING=1 -I$(top_builddir)	\
-	else \
+	           -c -o "$@" "$<";					\
-		$(COMPILE) -c -o $@ $<; \
+	else								\
+		$(COMPILE) -c -o "$@" "$<";				\
 	fi
 
 ## Override default rule; this should run on BUILD host.
@@ -460,6 +461,37 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h		\
 install-exec-hook:
 	rm -f $(DESTDIR)$(bindir)/guile-snarf.awk
 
+install-data-hook: libguile-2.2-gdb.scm
+	@$(MKDIR_P) $(DESTDIR)$(libdir)
+## We want to install libguile-2.2-gdb.scm as SOMETHING-gdb.scm.
+## SOMETHING is the full name of the final library.  We want to ignore
+## symlinks, the .la file, and any previous -gdb.py file.  This is
+## inherently fragile, but there does not seem to be a better option,
+## because libtool hides the real names from us.  (Trick courtesy of
+## GNU libstdc++.)
+	@here=`pwd`; cd $(DESTDIR)$(libdir);			\
+	  for file in libguile-@GUILE_EFFECTIVE_VERSION@*; do	\
+	    case $$file in					\
+	      *-gdb.scm) ;;					\
+	      *.la) ;;						\
+	      *) if test -h $$file; then			\
+	           continue;					\
+	         fi;						\
+	         libname=$$file;;				\
+	    esac;						\
+	  done;							\
+	cd $$here;						\
+	echo " $(INSTALL_DATA) $<				\
+$(DESTDIR)$(libdir)/$$libname-gdb.scm";				\
+	$(INSTALL_DATA) "$<"					\
+	    "$(DESTDIR)$(libdir)/$$libname-gdb.scm"
+
+# Remove the GDB support file and the Info 'dir' file that
+# 'install-info' 5.x installs.
+uninstall-hook:
+	-rm "$(DESTDIR)$(libdir)/libguile-@GUILE_EFFECTIVE_VERSION@"*-gdb.scm
+	-rm -f "$(DESTDIR)$(infodir)/dir"
+
 ## This is kind of nasty... there are ".c" files that we don't want to
 ## compile, since they are #included.  So instead we list them here.
 ## Perhaps we can deal with them normally once the merge seems to be
@@ -650,12 +682,13 @@ bin_SCRIPTS = guile-snarf
 # and people feel like maintaining them.  For now, this is not the case.
 noinst_SCRIPTS = guile-snarf-docs
 
-EXTRA_DIST = ChangeLog-scm ChangeLog-threads		\
+EXTRA_DIST = ChangeLog-scm ChangeLog-threads				\
-    ChangeLog-1996-1999 ChangeLog-2000 ChangeLog-2008	\
+    ChangeLog-1996-1999 ChangeLog-2000 ChangeLog-2008			\
-    guile-func-name-check				\
+    guile-func-name-check						\
-    cpp-E.syms cpp-E.c cpp-SIG.syms cpp-SIG.c			\
+    cpp-E.syms cpp-E.c cpp-SIG.syms cpp-SIG.c				\
-    c-tokenize.lex						\
+    c-tokenize.lex							\
-    scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map
+    scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map	\
+    libguile-2.2-gdb.scm
 #    $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
 #    guile-procedures.txt guile.texi
 

libguile/async.c

@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008,
+ *   2009, 2010, 2011, 2014 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
@@ -36,9 +37,7 @@
 #ifdef HAVE_STRING_H
 #include <string.h>
 #endif
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #include <full-write.h>
 

libguile/backtrace.c

@@ -1,5 +1,6 @@
 /* Printing of backtraces and error messages
- * Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 2011, 2014 Free Software Foundation
+ * Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2009,
+ *   2010, 2011, 2014 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -26,9 +27,7 @@
 
 #include "libguile/_scm.h"
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif

libguile/bdw-gc.h

@@ -23,7 +23,7 @@
 
 #include "libguile/scmconfig.h"
 
-#ifdef SCM_USE_PTHREAD_THREADS
+#if SCM_USE_PTHREAD_THREADS
 
 /* When pthreads are used, let `libgc' know about it and redirect allocation
    calls such as `GC_MALLOC ()' to (contention-free, faster) thread-local

libguile/c-tokenize.lex

@@ -1,3 +1,14 @@
+%top{
+/* Include <config.h> before anything else because Gnulib headers such
+   as <stdio.h> rely on it.
+
+   However, when cross-compiling, don't include <config.h> because it
+   contains information about the host, not about the build.  */
+#ifndef CROSS_COMPILING
+# include <config.h>
+#endif
+}
+
 %option noyywrap
 %option nounput
 %pointer
@@ -14,8 +25,6 @@ FLOQUAL		(f|F|l|L)
 INTQUAL		(l|L|ll|LL|lL|Ll|u|U)
 
 %{
-#include <config.h>
-
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>

libguile/chars.c

@@ -536,7 +536,7 @@ static const char *const scm_r5rs_charnames[] = {
   "space", "newline"
 };
 
-static const scm_t_uint32 const scm_r5rs_charnums[] = {
+static const scm_t_uint32 scm_r5rs_charnums[] = {
   0x20, 0x0a
 };
 
@@ -548,7 +548,7 @@ static const char *const scm_r6rs_charnames[] = {
   /* 'space' and 'newline' are already included from the R5RS list.  */
 };
 
-static const scm_t_uint32 const scm_r6rs_charnums[] = {
+static const scm_t_uint32 scm_r6rs_charnums[] = {
   0x00, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c,
   0x0d, 0x1b, 0x7f
 };
@@ -559,7 +559,7 @@ static const char *const scm_r7rs_charnames[] = {
   "escape"
 };
 
-static const scm_t_uint32 const scm_r7rs_charnums[] = {
+static const scm_t_uint32 scm_r7rs_charnums[] = {
   0x1b
 };
 
@@ -575,7 +575,7 @@ static const char *const scm_C0_control_charnames[] = {
   "sp", "del"
 };
 
-static const scm_t_uint32 const scm_C0_control_charnums[] = {
+static const scm_t_uint32 scm_C0_control_charnums[] = {
   0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
   0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
   0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
@@ -589,7 +589,7 @@ static const char *const scm_alt_charnames[] = {
   "null", "nl", "np"
 };
 
-static const scm_t_uint32 const scm_alt_charnums[] = {
+static const scm_t_uint32 scm_alt_charnums[] = {
   0x00, 0x0a, 0x0c
 };
 

libguile/error.c

@@ -40,9 +40,7 @@
 #ifdef HAVE_STRING_H
 #include <string.h>
 #endif
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 /* For Windows... */
 #ifdef HAVE_IO_H

libguile/filesys.c

@@ -1,5 +1,5 @@
 /* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2006,
- *   2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 2014 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
@@ -71,9 +71,7 @@
 # endif
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #ifdef LIBC_H_WITH_UNISTD_H
 #include <libc.h>
@@ -109,12 +107,6 @@
 #include <full-write.h>
 
 
-/* Some more definitions for the native Windows port. */
-#ifdef __MINGW32__
-# define fsync(fd) _commit (fd)
-#endif /* __MINGW32__ */
-
-
 
 
 /* Two helper macros for an often used pattern */
@@ -564,7 +556,6 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
 }
 #undef FUNC_NAME
 
-#ifdef HAVE_LSTAT
 SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0, 
             (SCM str),
 	    "Similar to @code{stat}, but does not follow symbolic links, i.e.,\n"
@@ -587,7 +578,6 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
   return scm_stat2scm (&stat_temp);
 }
 #undef FUNC_NAME
-#endif /* HAVE_LSTAT */
 
 
 #ifdef HAVE_POSIX
@@ -595,7 +585,6 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
 /* {Modifying Directories}
  */
 
-#ifdef HAVE_LINK
 SCM_DEFINE (scm_link, "link", 2, 0, 0,
             (SCM oldpath, SCM newpath),
 	    "Creates a new name @var{newpath} in the file system for the\n"
@@ -614,7 +603,6 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-#endif /* HAVE_LINK */
 
 
 /* {Navigating Directories}
@@ -1017,7 +1005,6 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SYMLINK */
 
-#ifdef HAVE_READLINK
 SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, 
             (SCM path),
 	    "Return the value of the symbolic link named by @var{path} (a\n"
@@ -1056,7 +1043,6 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
   return result;
 }
 #undef FUNC_NAME
-#endif /* HAVE_READLINK */
 
 SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
             (SCM oldfile, SCM newfile),
@@ -1259,7 +1245,6 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_GETCWD */
 
-#ifdef HAVE_MKDIR
 SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
             (SCM path, SCM mode),
 	    "Create a new directory named by @var{path}.  If @var{mode} is omitted\n"
@@ -1286,9 +1271,7 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-#endif /* HAVE_MKDIR */
 
-#ifdef HAVE_RMDIR
 SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0, 
             (SCM path),
 	    "Remove the existing directory named by @var{path}.  The directory must\n"
@@ -1303,27 +1286,6 @@ SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-#endif
-
-#ifdef HAVE_RENAME
-#define my_rename rename
-#else
-static int
-my_rename (const char *oldname, const char *newname)
-{
-  int rv;
-
-  SCM_SYSCALL (rv = link (oldname, newname));
-  if (rv == 0)
-    {
-      SCM_SYSCALL (rv = unlink (oldname));
-      if (rv != 0)
-	/* unlink failed.  remove new name */
-	SCM_SYSCALL (unlink (newname)); 
-    }
-  return rv;
-}
-#endif
 
 SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
             (SCM oldname, SCM newname),
@@ -1335,7 +1297,7 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
 
   STRING2_SYSCALL (oldname, c_oldname,
 		   newname, c_newname,
-		   rv = my_rename (c_oldname, c_newname));
+		   rv = rename (c_oldname, c_newname));
   if (rv != 0)
     SCM_SYSERROR;
   return SCM_UNSPECIFIED;
@@ -1470,10 +1432,6 @@ SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
 }
 #undef FUNC_NAME
 
-#ifndef HAVE_MKSTEMP
-extern int mkstemp (char *);
-#endif
-
 SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
 	    (SCM tmpl),
 	    "Create a new unique file in the file system and return a new\n"

libguile/finalizers.c

@@ -23,9 +23,7 @@
 # include <config.h>
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #include <fcntl.h>
 
 #include <full-write.h>

libguile/fports.c

@@ -33,9 +33,7 @@
 #ifdef HAVE_STRING_H
 #include <string.h>
 #endif
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif

libguile/gc-malloc.c

@@ -1,5 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013,
+ *   2014 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
@@ -56,9 +57,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
 #include "libguile/debug-malloc.h"
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 /*
   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will

libguile/gc.c

@@ -66,9 +66,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
 #include "libguile/debug-malloc.h"
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 /* Size in bytes of the initial heap.  This should be about the size of
    result of 'guile -c "(display (assq-ref (gc-stats)

libguile/guile-snarf.in

@@ -1,7 +1,8 @@
 #!/bin/sh
 # Extract the initialization actions from source files.
 #
-#  Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+#  Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002, 2004, 2006, 2008,
+#    2009, 2014 Free Software Foundation, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU Lesser General Public License as
@@ -51,19 +52,21 @@ modern_snarf ()                         # writes stdout
     ## empty file.
     echo "/* cpp arguments: $@ */" ;
     ${cpp} -DSCM_MAGIC_SNARF_INITS -DSCM_MAGIC_SNARFER "$@" > ${temp} && cpp_ok_p=true
-    sed -ne 's/ *\^ *: *\^/\
+    sed -ne 's/ *\^ *\^ */\
 /
-h
+s/.*\n//
-s/\n.*//
 t x
 d
 : x
-s/.*\^ *\^ *\(.*\)/\1;/
+s/ *\^ *: *\^ */;\
+/
 t y
-d
+N
+s/\n\(#.*\)/ /
+s/\n/ /
+t x
 : y
-p
+P
-x
 D' ${temp}
 }
 

libguile/init.c

@@ -1,5 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2006, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2004, 2006, 2009, 2010, 2011, 2012, 2013,
+ *   2014 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
@@ -144,9 +145,7 @@
 #ifdef HAVE_STRING_H
 #include <string.h>
 #endif
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 
 

libguile/ioext.c

@@ -1,4 +1,5 @@
-/* 	Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006,
+ *   2011, 2014 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
@@ -41,9 +42,7 @@
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 
 SCM_DEFINE (scm_ftell, "ftell", 1, 0, 0, 

libguile/iselect.h

@@ -29,8 +29,6 @@
 /* Needed for FD_SET on some systems.  */
 #include <sys/types.h>
 
-#if SCM_HAVE_SYS_SELECT_H
-
 #include <sys/select.h>
 
 SCM_API int scm_std_select (int fds,
@@ -41,8 +39,6 @@ SCM_API int scm_std_select (int fds,
 
 #define SELECT_TYPE fd_set
 
-#endif /* SCM_HAVE_SYS_SELECT_H */
-
 #endif  /* SCM_ISELECT_H */
 
 /*

libguile/libguile-2.2-gdb.scm

@@ -0,0 +1,164 @@
+;;; GDB debugging support for Guile.
+;;;
+;;; Copyright 2014 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 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guile-gdb)
+  #:use-module (system base types)
+  #:use-module ((gdb) #:hide (symbol?))
+  #:use-module (gdb printing)
+  #:use-module (srfi srfi-11)
+  #:export (%gdb-memory-backend
+            display-vm-frames))
+
+;;; Commentary:
+;;;
+;;; This file defines GDB extensions to pretty-print 'SCM' objects, and
+;;; to walk Guile's virtual machine stack.
+;;;
+;;; This file is installed under a name that follows the convention that
+;;; allows GDB to auto-load it anytime the user is debugging libguile
+;;; (info "(gdb) objfile-gdbdotext file").
+;;;
+;;; Code:
+
+(define (type-name-from-descriptor descriptor-array type-number)
+  "Return the name of the type TYPE-NUMBER as seen in DESCRIPTOR-ARRAY, or #f
+if the information is not available."
+  (let ((descriptors (lookup-global-symbol descriptor-array)))
+    (and descriptors
+         (let ((code (type-code (symbol-type descriptors))))
+           (or (= TYPE_CODE_ARRAY code)
+               (= TYPE_CODE_PTR code)))
+         (let* ((type-descr (value-subscript (symbol-value descriptors)
+                                             type-number))
+                (name       (value-field type-descr "name")))
+           (value->string name)))))
+
+(define %gdb-memory-backend
+  ;; The GDB back-end to access the inferior's memory.
+  (let ((void* (type-pointer (lookup-type "void"))))
+    (define (dereference-word address)
+      ;; Return the word at ADDRESS.
+      (value->integer
+       (value-dereference (value-cast (make-value address)
+                                      (type-pointer void*)))))
+
+    (define (open address size)
+      ;; Return a port to the SIZE bytes starting at ADDRESS.
+      (if size
+          (open-memory #:start address #:size size)
+          (open-memory #:start address)))
+
+    (define (type-name kind number)
+      ;; Return the type name of KIND type NUMBER.
+      (type-name-from-descriptor (case kind
+                                   ((smob) "scm_smobs")
+                                   ((port) "scm_ptobs"))
+                                 number))
+
+    (memory-backend dereference-word open type-name)))
+
+
+;;;
+;;; GDB pretty-printer registration.
+;;;
+
+(define scm-value->string
+  (lambda* (value #:optional (backend %gdb-memory-backend))
+    "Return a representation of value VALUE as a string."
+    (object->string (scm->object (value->integer value) backend))))
+
+(define %scm-pretty-printer
+  (make-pretty-printer "SCM"
+                       (lambda (pp value)
+                         (let ((name (type-name (value-type value))))
+                           (and (and name (string=? name "SCM"))
+                                (make-pretty-printer-worker
+                                 #f              ; display hint
+                                 (lambda (printer)
+                                   (scm-value->string value %gdb-memory-backend))
+                                 #f))))))
+
+(define* (register-pretty-printer #:optional objfile)
+  (prepend-pretty-printer! objfile %scm-pretty-printer))
+
+(register-pretty-printer)
+
+
+;;;
+;;; VM stack walking.
+;;;
+
+(define (find-vm-engine-frame)
+  "Return the bottom-most frame containing a call to the VM engine."
+  (define (vm-engine-frame? frame)
+    (let ((sym (frame-function frame)))
+      (and sym
+           (member (symbol-name sym)
+                   '("vm_debug_engine" "vm_regular_engine")))))
+
+  (let loop ((frame (newest-frame)))
+    (and frame
+         (if (vm-engine-frame? frame)
+             frame
+             (loop (frame-older frame))))))
+
+(define (vm-stack-pointer)
+  "Return the current value of the VM stack pointer or #f."
+  (let ((frame (find-vm-engine-frame)))
+    (and frame
+         (frame-read-var frame "sp"))))
+
+(define (vm-frame-pointer)
+  "Return the current value of the VM frame pointer or #f."
+  (let ((frame (find-vm-engine-frame)))
+    (and frame
+         (frame-read-var frame "fp"))))
+
+(define* (display-vm-frames #:optional (port (current-output-port)))
+  "Display the VM frames on PORT."
+  (define (display-objects start end)
+    ;; Display all the objects (arguments and local variables) located
+    ;; between START and END.
+    (let loop ((number  0)
+               (address start))
+      (when (and (> start 0) (<= address end))
+        (let ((object (dereference-word %gdb-memory-backend address)))
+          ;; TODO: Push onto GDB's value history.
+          (format port "  slot ~a -> ~s~%"
+                  number (scm->object object %gdb-memory-backend)))
+        (loop (+ 1 number) (+ address %word-size)))))
+
+  (let loop ((number 0)
+             (sp     (value->integer (vm-stack-pointer)))
+             (fp     (value->integer (vm-frame-pointer))))
+    (unless (zero? fp)
+      (let-values (((ra mvra link proc)
+                    (vm-frame fp %gdb-memory-backend)))
+        (format port "#~a ~s~%" number (scm->object proc %gdb-memory-backend))
+        (display-objects fp sp)
+        (loop (+ 1 number) (- fp (* 5 %word-size)) link)))))
+
+;; See libguile/frames.h.
+(define* (vm-frame fp #:optional (backend %gdb-memory-backend))
+  "Return the components of the stack frame at FP."
+  (let ((caller (dereference-word backend (- fp %word-size)))
+        (ra     (dereference-word backend (- fp (* 2 %word-size))))
+        (mvra   (dereference-word backend (- fp (* 3 %word-size))))
+        (link   (dereference-word backend (- fp (* 4 %word-size)))))
+    (values ra mvra link caller)))
+
+;;; libguile-2.2-gdb.scm ends here

libguile/list.c

@@ -374,18 +374,49 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
 	    "@code{reverse!}")
 #define FUNC_NAME s_scm_reverse_x
 {
-  SCM_VALIDATE_LIST (1, lst);
+  SCM old_lst = lst;
+  SCM tail = SCM_BOOL_F;
+
   if (SCM_UNBNDP (new_tail))
     new_tail = SCM_EOL;
 
-  while (!SCM_NULL_OR_NIL_P (lst))
+  if (SCM_NULL_OR_NIL_P (lst))
+    return new_tail;
+
+  /* SCM_VALIDATE_LIST would run through the whole list to make sure it
+     is not eventually circular.  In contrast to most list operations,
+     reverse! cannot get stuck in an infinite loop but arrives back at
+     the start when given an eventually or fully circular list.  Because
+     of that, we can save the cost of an upfront proper list check at
+     the price of having to do a double reversal in the error case.
+  */
+
+  while (scm_is_pair (lst))
     {
       SCM old_tail = SCM_CDR (lst);
-      SCM_SETCDR (lst, new_tail);
+      SCM_SETCDR (lst, tail);
-      new_tail = lst;
+      tail = lst;
       lst = old_tail;
     }
-  return new_tail;
+
+  if (SCM_LIKELY (SCM_NULL_OR_NIL_P (lst)))
+    {
+      SCM_SETCDR (old_lst, new_tail);
+      return tail;
+    }
+
+  /* We did not start with a proper list.  Undo the reversal. */
+
+  while (scm_is_pair (tail))
+    {
+      SCM old_tail = SCM_CDR (tail);
+      SCM_SETCDR (tail, lst);
+      lst = tail;
+      tail = old_tail;
+    }
+
+  SCM_WRONG_TYPE_ARG (1, lst);
+  return lst;
 }
 #undef FUNC_NAME
 

libguile/load.c

@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 2014 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
@@ -49,10 +49,7 @@
 
 #include <sys/types.h>
 #include <sys/stat.h>
-
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif /* HAVE_UNISTD_H */
 
 #ifdef HAVE_PWD_H
 #include <pwd.h>

libguile/mallocs.c

@@ -1,5 +1,6 @@
 /* classes: src_files 
- * Copyright (C) 1995,1997,1998,2000,2001, 2006, 2011 Free Software Foundation, Inc.
+ * Copyright (C) 1995,1997,1998,2000,2001, 2006, 2011,
+ *   2014 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
@@ -32,9 +33,7 @@
 
 #include "libguile/mallocs.h"
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 
 

libguile/mkstemp.c

@@ -1,4 +1,6 @@
-/* Copyright (C) 1991, 1992, 1996, 1998, 2001, 2006, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1991, 1992, 1996, 1998, 2001, 2006, 2013,
+     2014 Free Software Foundation, Inc.
+
    This file is derived from mkstemps.c from the GNU Libiberty Library
    which in turn is derived from the GNU C Library.
 
@@ -33,9 +35,7 @@
 #include <errno.h>
 #include <stdio.h>
 #include <fcntl.h>
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #ifdef HAVE_SYS_TIME_H
 #include <sys/time.h>
 #endif

libguile/numbers.c

@@ -1,6 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
  *   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012,
- *   2013 Free Software Foundation, Inc.
+ *   2013, 2014 Free Software Foundation, Inc.
  *
  * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
  * and Bellcore.  See scm_divide.
@@ -4679,9 +4679,15 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0,
 
   if (SCM_I_INUMP (j))
     {
-      /* bits above what's in an inum follow the sign bit */
+      if (iindex < SCM_LONG_BIT - 1)
-      iindex = min (iindex, SCM_LONG_BIT - 1);
+        /* Arrange for the number to be converted to unsigned before
-      return scm_from_bool ((1L << iindex) & SCM_I_INUM (j));
+           checking the bit, to ensure that we're testing the bit in a
+           two's complement representation (regardless of the native
+           representation.  */
+        return scm_from_bool ((1UL << iindex) & SCM_I_INUM (j));
+      else
+        /* Portably check the sign.  */
+        return scm_from_bool (SCM_I_INUM (j) < 0);
     }
   else if (SCM_BIGP (j))
     {
@@ -4991,7 +4997,7 @@ left_shift_exact_integer (SCM n, long count)
       else if (count < SCM_I_FIXNUM_BIT-1 &&
                ((scm_t_bits) (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - count)) + 1)
                 <= 1))
-        return SCM_I_MAKINUM (nn << count);
+        return SCM_I_MAKINUM (nn < 0 ? -(-nn << count) : (nn << count));
       else
         {
           SCM result = scm_i_inum2big (nn);

libguile/numbers.h

@@ -4,7 +4,7 @@
 #define SCM_NUMBERS_H
 
 /* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006,
- *   2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+ *   2008, 2009, 2010, 2011, 2013, 2014 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
@@ -49,19 +49,43 @@ typedef scm_t_int32 scm_t_wchar;
 #define SCM_MOST_POSITIVE_FIXNUM ((SCM_T_SIGNED_BITS_MAX-3)/4)
 #define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM-1)
 
-/* SCM_SRS is signed right shift */
+/* SCM_SRS (X, Y) is signed right shift, defined as floor (X / 2^Y),
-#if (-1 == (((-1) << 2) + 2) >> 2)
+   where Y must be non-negative and less than the width in bits of X.
-# define SCM_SRS(x, y) ((x) >> (y))
+   It's common for >> to do this, but the C standards do not specify
-#else
+   what happens when X is negative.
-# define SCM_SRS(x, y) ((x) < 0 ? ~((~(x)) >> (y)) : ((x) >> (y)))
-#endif /* (-1 == (((-1) << 2) + 2) >> 2) */
 
+   NOTE: X must not perform side effects.  */
+#if (-1 >> 2 == -1) && (-4 >> 2 == -1) && (-5 >> 2 == -2) && (-8 >> 2 == -2)
+# define SCM_SRS(x, y)  ((x) >> (y))
+#else
+# define SCM_SRS(x, y)                                   \
+  ((x) < 0                                               \
+   ? -1 - (scm_t_signed_bits) (~(scm_t_bits)(x) >> (y))  \
+   : ((x) >> (y)))
+#endif
+
+
+/* The first implementation of SCM_I_INUM below depends on behavior that
+   is specified by GNU C but not by C standards, namely that when
+   casting to a signed integer of width N, the value is reduced modulo
+   2^N to be within range of the type.  The second implementation below
+   should be portable to all conforming C implementations, but may be
+   less efficient if the compiler is not sufficiently clever.
+
+   NOTE: X must not perform side effects.  */
+#ifdef __GNUC__
+# define SCM_I_INUM(x)  (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2))
+#else
+# define SCM_I_INUM(x)                                \
+  (SCM_UNPACK (x) > LONG_MAX                          \
+   ? -1 - (scm_t_signed_bits) (~SCM_UNPACK (x) >> 2)  \
+   : (scm_t_signed_bits) (SCM_UNPACK (x) >> 2))
+#endif
 
 #define SCM_I_INUMP(x)	(2 & SCM_UNPACK (x))
 #define SCM_I_NINUMP(x) (!SCM_I_INUMP (x))
 #define SCM_I_MAKINUM(x) \
-  (SCM_PACK ((((scm_t_signed_bits) (x)) << 2) + scm_tc2_int))
+  (SCM_PACK ((((scm_t_bits) (x)) << 2) + scm_tc2_int))
-#define SCM_I_INUM(x)   (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2))
 
 /* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */
 #define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)

libguile/ports.c

@@ -1,5 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- *   2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ *   2014 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
@@ -70,9 +71,7 @@
 #include <io.h>
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #ifdef HAVE_SYS_IOCTL_H
 #include <sys/ioctl.h>

libguile/posix.c

@@ -1,5 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ *   2014 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
@@ -46,9 +47,7 @@
 # endif
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #ifdef LIBC_H_WITH_UNISTD_H
 #include <libc.h>

libguile/print.c

@@ -1549,6 +1549,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   if (scm_is_eq (destination, SCM_BOOL_T))
     {
       destination = port = scm_current_output_port ();
+      SCM_VALIDATE_OPORT_VALUE (1, destination);
     }
   else if (scm_is_false (destination))
     {

libguile/r6rs-ports.c

@@ -20,10 +20,7 @@
 # include <config.h>
 #endif
 
-#ifdef HAVE_UNISTD_H
+#include <unistd.h>
-# include <unistd.h>
-#endif
-
 #include <string.h>
 #include <stdio.h>
 #include <assert.h>

libguile/random.c

@@ -1,5 +1,6 @@
 /* Copyright (C) 1999, 2000, 2001, 2003, 2005, 2006, 2009, 2010,
- *    2012, 2013 Free Software Foundation, Inc.
+ *    2012, 2013, 2014 Free Software Foundation, Inc.
+ *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
  * as published by the Free Software Foundation; either version 3 of
@@ -31,10 +32,7 @@
 #include <math.h>
 #include <string.h>
 #include <sys/types.h>
-
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #include "libguile/smob.h"
 #include "libguile/numbers.h"
@@ -257,7 +255,7 @@ scm_i_mask32 (scm_t_uint32 m)
 	     ? scm_masktab[m >> 8] << 8 | 0xff
 	     : (m < 0x1000000
 		? scm_masktab[m >> 16] << 16 | 0xffff
-		: scm_masktab[m >> 24] << 24 | 0xffffff)));
+		: ((scm_t_uint32) scm_masktab[m >> 24]) << 24 | 0xffffff)));
 }
 
 scm_t_uint32

libguile/rw.c

@@ -1,4 +1,4 @@
-/* 	Copyright (C) 2001, 2006, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2006, 2009, 2011, 2014 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
@@ -37,9 +37,7 @@
 #include "libguile/modules.h"
 #include "libguile/strports.h"
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif

libguile/scmsigs.c

@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008, 2009, 2011, 2013, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006,
+ *   2007, 2008, 2009, 2011, 2013, 2014 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
@@ -32,9 +33,7 @@
 #include <process.h>    /* for mingw */
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #ifdef HAVE_SYS_TIME_H
 #include <sys/time.h>

libguile/script.c

@@ -1,4 +1,5 @@
-/* Copyright (C) 1994-1998, 2000-2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1994-1998, 2000-2011, 2013, 2014 Free Software Foundation, Inc.
+ *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
  * as published by the Free Software Foundation; either version 3 of
@@ -45,9 +46,7 @@
 #include <string.h>
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>		/* for X_OK define */
-#endif
 
 #ifdef HAVE_IO_H
 #include <io.h>
@@ -220,6 +219,21 @@ script_get_backslash (FILE *f)
 }
 #undef FUNC_NAME
 
+/*
+ * Like `realloc', but free memory on failure;
+ * unlike `scm_realloc', return NULL, not aborts.
+*/
+static void*
+realloc0 (void *ptr, size_t size)
+{
+  void *new_ptr = realloc (ptr, size);
+  if (!new_ptr)
+    {
+      free (ptr);
+    }
+  return new_ptr;
+}
+
 
 static char *
 script_read_arg (FILE *f)
@@ -245,7 +259,7 @@ script_read_arg (FILE *f)
 	  if (len >= size)
 	    {
 	      size = (size + 1) * 2;
-	      buf = realloc (buf, size);
+	      buf = realloc0 (buf, size);
 	      if (! buf)
 		return 0;
 	    }
@@ -328,9 +342,9 @@ scm_get_meta_args (int argc, char **argv)
 	found_args:
           /* FIXME: we leak the result of calling script_read_arg.  */
 	  while ((narg = script_read_arg (f)))
-	    if (!(nargv = (char **) realloc (nargv,
+	    if (!(nargv = (char **) realloc0 (nargv,
 					     (1 + ++nargc) * sizeof (char *))))
-	        return 0L;
+	      return 0L;
 	    else
 	      nargv[nargi++] = narg;
 	  fclose (f);

libguile/simpos.c

@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, 2009,
- *   2010, 2012, 2013 Free Software Foundation, Inc.
+ *   2010, 2012, 2013, 2014 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
@@ -40,9 +40,7 @@
 #ifdef HAVE_STRING_H
 #include <string.h>
 #endif
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #if HAVE_SYS_WAIT_H
 # include <sys/wait.h>
 #endif

libguile/snarf.h

@@ -4,7 +4,7 @@
 #define SCM_SNARF_H
 
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2006, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+ *   2004, 2006, 2009, 2010, 2011, 2013, 2014 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
@@ -87,7 +87,7 @@ DOCSTRING ^^ }
 
 #define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
 SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
 SCM FNAME ARGLIST\
 )\
 SCM_SNARF_INIT(\
@@ -102,7 +102,7 @@ SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
 
 #define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
 SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
 static SCM g_ ## FNAME; \
 SCM FNAME ARGLIST\
 )\
@@ -116,7 +116,7 @@ SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
 
 #define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
 SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
 SCM FNAME ARGLIST\
 )\
 SCM_SNARF_INIT(\
@@ -127,12 +127,12 @@ scm_c_export (s_ ## FNAME, NULL); \
 SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
 
 #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
-SCM_SNARF_HERE(static const char RANAME[]=STR) \
+SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
 SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
                                    (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
 
 #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
-SCM_SNARF_HERE(static const char RANAME[]=STR) \
+SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
 SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
                                    (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
 SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
@@ -140,7 +140,7 @@ SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
 
 #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF)  \
 SCM_SNARF_HERE(\
-static const char RANAME[]=STR;\
+SCM_UNUSED static const char RANAME[]=STR;\
 static SCM GF \
 )SCM_SNARF_INIT(\
 GF = SCM_PACK (0);  /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \

libguile/socket.c

@@ -33,9 +33,7 @@
 #ifdef HAVE_STRING_H
 #include <string.h>
 #endif
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #include <sys/types.h>
 #include <sys/socket.h>
 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
@@ -66,7 +64,7 @@
 
 
 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
-#define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
+#define SUN_LEN(ptr) (offsetof (struct sockaddr_un, sun_path) \
 		      + strlen ((ptr)->sun_path))
 #endif
 

libguile/srfi-4.c

@@ -137,12 +137,13 @@
                                               scm_t_array_handle *h,    \
                                               size_t *lenp, ssize_t *incp) \
   {                                                                     \
+    size_t byte_width = width * sizeof (ctype);                         \
     if (!scm_is_bytevector (uvec)                                       \
-        || (scm_c_bytevector_length (uvec) % width))                    \
+        || (scm_c_bytevector_length (uvec) % byte_width))               \
       scm_wrong_type_arg_msg (NULL, 0, uvec, #tag "vector");            \
     scm_array_get_handle (uvec, h);                                     \
     if (lenp)                                                           \
-      *lenp = scm_c_bytevector_length (uvec) / width;                   \
+      *lenp = scm_c_bytevector_length (uvec) / byte_width;              \
     if (incp)                                                           \
       *incp = 1;                                                        \
     return ((ctype *)h->writable_elements);                             \

libguile/srfi-60.c

@@ -1,6 +1,6 @@
 /* srfi-60.c --- Integers as Bits
  *
- * Copyright (C) 2005, 2006, 2008, 2010 Free Software Foundation, Inc.
+ * Copyright (C) 2005, 2006, 2008, 2010, 2014 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
@@ -155,7 +155,12 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
   SCM_ASSERT_RANGE (3, end, (ee >= ss));
   ww = ee - ss;
 
-  cc = scm_to_ulong (scm_modulo (count, scm_difference (end, start)));
+  /* we must avoid division by zero, and a field whose width is 0 or 1
+     will be left unchanged anyway, so in that case we set cc to 0. */
+  if (ww <= 1)
+    cc = 0;
+  else
+    cc = scm_to_ulong (scm_modulo (count, scm_difference (end, start)));
 
   if (SCM_I_INUMP (n))
     {
@@ -163,22 +168,40 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
 
       if (ee <= SCM_LONG_BIT-1)
         {
-          /* all within a long */
+          /* Everything fits within a long.  To avoid undefined behavior
-          long below = nn & ((1L << ss) - 1);  /* before start */
+             when shifting negative numbers, we do all operations using
-          long above = nn & (-1L << ee);       /* above end */
+             unsigned values, and then convert to signed at the end. */
-          long fmask = (-1L << ss) & ((1L << ee) - 1);  /* field mask */
+          unsigned long unn = nn;
-          long ff = nn & fmask;                /* field */
+          unsigned long below = unn &  ((1UL << ss) - 1);  /* below start */
+          unsigned long above = unn & ~((1UL << ee) - 1);  /* above end */
+          unsigned long fmask = ((1UL << ww) - 1) << ss;   /* field mask */
+          unsigned long ff = unn & fmask;                  /* field */
+          unsigned long uresult = (above
+                                   | ((ff << cc) & fmask)
+                                   | ((ff >> (ww-cc)) & fmask)
+                                   | below);
+          long result;
 
-          return scm_from_long (above
+          if (uresult > LONG_MAX)
-                                | ((ff << cc) & fmask)
+            /* The high bit is set in uresult, so the result is
-                                | ((ff >> (ww-cc)) & fmask)
+               negative.  We have to handle the conversion to signed
-                                | below);
+               integer carefully, to avoid undefined behavior.  First we
+               compute ~uresult, equivalent to (ULONG_MAX - uresult),
+               which will be between 0 and LONG_MAX (inclusive): exactly
+               the set of numbers that can be represented as both signed
+               and unsigned longs and thus convertible between them.  We
+               cast that difference to a signed long and then substract
+               it from -1. */
+            result = -1 - (long) ~uresult;
+          else
+            result = (long) uresult;
+
+          return scm_from_long (result);
         }
       else
         {
-          /* either no movement, or a field of only 0 or 1 bits, result
+          /* if there's no movement, avoid creating a bignum. */
-             unchanged, avoid creating a bignum */
+          if (cc == 0)
-          if (cc == 0 || ww <= 1)
             return n;
 
           n = scm_i_long2big (nn);
@@ -190,9 +213,8 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
       mpz_t tmp;
       SCM r;
 
-      /* either no movement, or in a field of only 0 or 1 bits, result
+      /* if there's no movement, avoid creating a new bignum. */
-         unchanged, avoid creating a new bignum */
+      if (cc == 0)
-      if (cc == 0 || ww <= 1)
         return n;
 
     big:
@@ -209,7 +231,7 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
       mpz_mul_2exp (tmp, tmp, ss + cc);
       mpz_ior (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), tmp);
 
-      /* field high part, count bits from end-count go to start */
+      /* field low part, count bits from end-count go to start */
       mpz_fdiv_q_2exp (tmp, SCM_I_BIG_MPZ (n), ee - cc);
       mpz_fdiv_r_2exp (tmp, tmp, cc);
       mpz_mul_2exp (tmp, tmp, ss);

libguile/stime.c

@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006,
+ *   2007, 2008, 2009, 2011, 2013, 2014 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
@@ -59,9 +60,7 @@
 #include "libguile/validate.h"
 #include "libguile/stime.h"
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 
 #ifdef HAVE_CLOCK_GETTIME

libguile/strports.c

@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2006,
- *   2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 2014 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
@@ -27,9 +27,7 @@
 #include "libguile/_scm.h"
 
 #include <stdio.h>
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 #include "libguile/bytevectors.h"
 #include "libguile/eval.h"

libguile/threads.c

@@ -1,6 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- *   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014
+ *   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
- *   Free Software Foundation, Inc.
+ *   2014 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
@@ -29,9 +29,7 @@
 #include "libguile/_scm.h"
 
 #include <stdlib.h>
-#if HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #include <stdio.h>
 
 #ifdef HAVE_STRING_H
@@ -1779,14 +1777,6 @@ do_std_select (void *args)
   return NULL;
 }
 
-#if !SCM_HAVE_SYS_SELECT_H
-static int scm_std_select (int nfds,
-                           fd_set *readfds,
-                           fd_set *writefds,
-                           fd_set *exceptfds,
-                           struct timeval *timeout);
-#endif
-
 int
 scm_std_select (int nfds,
 		fd_set *readfds,

libguile/vm-engine.c

@@ -1,4 +1,5 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013,
+ *   2014 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
@@ -2481,7 +2482,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
                   && ((scm_t_bits)
                       (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
                       <= 1))
-                RETURN (SCM_I_MAKINUM (nn << bits_to_shift));
+                RETURN (SCM_I_MAKINUM (nn < 0
+                                       ? -(-nn << bits_to_shift)
+                                       : (nn << bits_to_shift)));
               /* fall through */
             }
           /* fall through */

m4/fsync.m4

@@ -0,0 +1,17 @@
+# fsync.m4 serial 2
+dnl Copyright (C) 2008-2014 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_FSYNC],
+[
+  AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+  AC_CHECK_FUNCS_ONCE([fsync])
+  if test $ac_cv_func_fsync = no; then
+    HAVE_FSYNC=0
+  fi
+])
+
+# Prerequisites of lib/fsync.c.
+AC_DEFUN([gl_PREREQ_FSYNC], [:])

m4/gnulib-cache.m4

@@ -27,7 +27,7 @@
 
 
 # Specification in the form of a command-line invocation:
-#   gnulib-tool --import --dir=. --local-dir=gnulib-local --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap c-strcase canonicalize-lgpl ceil clock-time close connect copysign dirfd duplocale environ extensions flock floor fpieee frexp fstat full-read full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isfinite isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring listen localcharset locale log1p maintainer-makefile malloc-gnu malloca nl_langinfo nproc open pipe-posix pipe2 poll putenv recv recvfrom regex rename select send sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat time times trunc verify vsnprintf warnings wchar
+#   gnulib-tool --import --dir=. --local-dir=gnulib-local --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=lock --lgpl=3 --no-conditional-dependencies --libtool --macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen autobuild bind byteswap c-strcase canonicalize-lgpl ceil clock-time close connect copysign dirfd duplocale environ extensions flock floor fpieee frexp fstat fsync full-read full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton isfinite isinf isnan ldexp lib-symbol-versions lib-symbol-visibility libunistring link listen localcharset locale log1p lstat maintainer-makefile malloc-gnu malloca mkdir mkstemp nl_langinfo nproc open pipe-posix pipe2 poll putenv readlink recv recvfrom regex rename rmdir select send sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat time times trunc unistd verify vsnprintf warnings wchar
 
 # Specification in the form of a few gnulib-tool.m4 macro invocations:
 gl_LOCAL_DIR([gnulib-local])
@@ -55,6 +55,7 @@ gl_MODULES([
   fpieee
   frexp
   fstat
+  fsync
   full-read
   full-write
   func
@@ -80,13 +81,17 @@ gl_MODULES([
   lib-symbol-versions
   lib-symbol-visibility
   libunistring
+  link
   listen
   localcharset
   locale
   log1p
+  lstat
   maintainer-makefile
   malloc-gnu
   malloca
+  mkdir
+  mkstemp
   nl_langinfo
   nproc
   open
@@ -94,10 +99,12 @@ gl_MODULES([
   pipe2
   poll
   putenv
+  readlink
   recv
   recvfrom
   regex
   rename
+  rmdir
   select
   send
   sendto
@@ -114,12 +121,13 @@ gl_MODULES([
   time
   times
   trunc
+  unistd
   verify
   vsnprintf
   warnings
   wchar
 ])
-gl_AVOID([])
+gl_AVOID([lock])
 gl_SOURCE_BASE([lib])
 gl_M4_BASE([m4])
 gl_PO_BASE([])

m4/gnulib-common.m4

@@ -379,3 +379,59 @@ AC_DEFUN([gl_CACHE_VAL_SILENT],
 # AS_VAR_COPY was added in autoconf 2.63b
 m4_define_default([AS_VAR_COPY],
 [AS_LITERAL_IF([$1[]$2], [$1=$$2], [eval $1=\$$2])])
+
+# AC_PROG_SED was added in autoconf 2.59b
+m4_ifndef([AC_PROG_SED],
+[AC_DEFUN([AC_PROG_SED],
+[AC_CACHE_CHECK([for a sed that does not truncate output], ac_cv_path_SED,
+    [dnl ac_script should not contain more than 99 commands (for HP-UX sed),
+     dnl but more than about 7000 bytes, to catch a limit in Solaris 8 /usr/ucb/sed.
+     ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/
+     for ac_i in 1 2 3 4 5 6 7; do
+       ac_script="$ac_script$as_nl$ac_script"
+     done
+     echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed
+     AS_UNSET([ac_script])
+     if test -z "$SED"; then
+       ac_path_SED_found=false
+       _AS_PATH_WALK([], [
+         for ac_prog in sed gsed; do
+           for ac_exec_ext in '' $ac_executable_extensions; do
+             ac_path_SED="$as_dir/$ac_prog$ac_exec_ext"
+             AS_EXECUTABLE_P(["$ac_path_SED"]) || continue
+             case `"$ac_path_SED" --version 2>&1` in
+               *GNU*) ac_cv_path_SED=$ac_path_SED ac_path_SED_found=:;;
+               *)
+                 ac_count=0
+                 _AS_ECHO_N([0123456789]) >conftest.in
+                 while :
+                 do
+                   cat conftest.in conftest.in >conftest.tmp
+                   mv conftest.tmp conftest.in
+                   cp conftest.in conftest.nl
+                   echo >> conftest.nl
+                   "$ac_path_SED" -f conftest.sed <conftest.nl >conftest.out 2>/dev/null || break
+                   diff conftest.out conftest.nl >/dev/null 2>&1 || break
+                   ac_count=`expr $ac_count + 1`
+                   if test $ac_count -gt ${ac_path_SED_max-0}; then
+                     # Best so far, but keep looking for better
+                     ac_cv_path_SED=$ac_path_SED
+                     ac_path_SED_max=$ac_count
+                   fi
+                   test $ac_count -gt 10 && break
+                 done
+                 rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+             esac
+             $ac_path_SED_found && break 3
+           done
+         done])
+       if test -z "$ac_cv_path_SED"; then
+         AC_ERROR([no acceptable sed could be found in \$PATH])
+       fi
+     else
+       ac_cv_path_SED=$SED
+     fi
+ SED="$ac_cv_path_SED"
+ AC_SUBST([SED])dnl
+ rm -f conftest.sed
+])])])

m4/gnulib-comp.m4

@@ -84,6 +84,7 @@ AC_DEFUN([gl_EARLY],
   AC_REQUIRE([gl_FP_IEEE])
   # Code from module frexp:
   # Code from module fstat:
+  # Code from module fsync:
   # Code from module full-read:
   # Code from module full-write:
   # Code from module func:
@@ -127,11 +128,11 @@ AC_DEFUN([gl_EARLY],
   # Code from module lib-symbol-versions:
   # Code from module lib-symbol-visibility:
   # Code from module libunistring:
+  # Code from module link:
   # Code from module listen:
   # Code from module localcharset:
   # Code from module locale:
   # Code from module localeconv:
-  # Code from module lock:
   # Code from module log:
   # Code from module log1p:
   # Code from module lstat:
@@ -144,6 +145,8 @@ AC_DEFUN([gl_EARLY],
   # Code from module mbsinit:
   # Code from module mbtowc:
   # Code from module memchr:
+  # Code from module mkdir:
+  # Code from module mkstemp:
   # Code from module msvc-inval:
   # Code from module msvc-nothrow:
   # Code from module multiarch:
@@ -171,6 +174,7 @@ AC_DEFUN([gl_EARLY],
   # Code from module safe-read:
   # Code from module safe-write:
   # Code from module same-inode:
+  # Code from module secure_getenv:
   # Code from module select:
   # Code from module send:
   # Code from module sendto:
@@ -200,6 +204,7 @@ AC_DEFUN([gl_EARLY],
   # Code from module stdint:
   # Code from module stdio:
   # Code from module stdlib:
+  # Code from module strdup-posix:
   # Code from module streq:
   # Code from module strftime:
   # Code from module striconveh:
@@ -212,8 +217,7 @@ AC_DEFUN([gl_EARLY],
   # Code from module sys_times:
   # Code from module sys_types:
   # Code from module sys_uio:
-  # Code from module threadlib:
+  # Code from module tempname:
-  gl_THREADLIB_EARLY
   # Code from module time:
   # Code from module time_r:
   # Code from module times:
@@ -362,6 +366,12 @@ AC_SUBST([LTALLOCA])
     gl_PREREQ_FSTAT
   fi
   gl_SYS_STAT_MODULE_INDICATOR([fstat])
+  gl_FUNC_FSYNC
+  if test $HAVE_FSYNC = 0; then
+    AC_LIBOBJ([fsync])
+    gl_PREREQ_FSYNC
+  fi
+  gl_UNISTD_MODULE_INDICATOR([fsync])
   gl_FUNC
   gl_GETADDRINFO
   if test $HAVE_GETADDRINFO = 0; then
@@ -496,6 +506,11 @@ AC_SUBST([LTALLOCA])
   gl_LD_VERSION_SCRIPT
   gl_VISIBILITY
   gl_LIBUNISTRING
+  gl_FUNC_LINK
+  if test $HAVE_LINK = 0 || test $REPLACE_LINK = 1; then
+    AC_LIBOBJ([link])
+  fi
+  gl_UNISTD_MODULE_INDICATOR([link])
   AC_REQUIRE([gl_HEADER_SYS_SOCKET])
   if test "$ac_cv_header_winsock2_h" = yes; then
     AC_LIBOBJ([listen])
@@ -511,8 +526,6 @@ AC_SUBST([LTALLOCA])
     gl_PREREQ_LOCALECONV
   fi
   gl_LOCALE_MODULE_INDICATOR([localeconv])
-  gl_LOCK
-  gl_MODULE_INDICATOR([lock])
   AC_REQUIRE([gl_FUNC_LOG])
   if test $REPLACE_LOG = 1; then
     AC_LIBOBJ([log])
@@ -531,6 +544,7 @@ AC_SUBST([LTALLOCA])
   gl_SYS_STAT_MODULE_INDICATOR([lstat])
   AC_CONFIG_COMMANDS_PRE([m4_ifdef([AH_HEADER],
     [AC_SUBST([CONFIG_INCLUDE], m4_defn([AH_HEADER]))])])
+  AC_REQUIRE([AC_PROG_SED])
   gl_FUNC_MALLOC_GNU
   if test $REPLACE_MALLOC = 1; then
     AC_LIBOBJ([malloc])
@@ -567,6 +581,16 @@ AC_SUBST([LTALLOCA])
     gl_PREREQ_MEMCHR
   fi
   gl_STRING_MODULE_INDICATOR([memchr])
+  gl_FUNC_MKDIR
+  if test $REPLACE_MKDIR = 1; then
+    AC_LIBOBJ([mkdir])
+  fi
+  gl_FUNC_MKSTEMP
+  if test $HAVE_MKSTEMP = 0 || test $REPLACE_MKSTEMP = 1; then
+    AC_LIBOBJ([mkstemp])
+    gl_PREREQ_MKSTEMP
+  fi
+  gl_STDLIB_MODULE_INDICATOR([mkstemp])
   gl_MSVC_INVAL
   if test $HAVE_MSVC_INVALID_PARAMETER_HANDLER = 1; then
     AC_LIBOBJ([msvc-inval])
@@ -662,6 +686,12 @@ AC_SUBST([LTALLOCA])
   gl_MATH_MODULE_INDICATOR([round])
   gl_PREREQ_SAFE_READ
   gl_PREREQ_SAFE_WRITE
+  gl_FUNC_SECURE_GETENV
+  if test $HAVE_SECURE_GETENV = 0; then
+    AC_LIBOBJ([secure_getenv])
+    gl_PREREQ_SECURE_GETENV
+  fi
+  gl_STDLIB_MODULE_INDICATOR([secure_getenv])
   gl_FUNC_SELECT
   if test $REPLACE_SELECT = 1; then
     AC_LIBOBJ([select])
@@ -737,6 +767,12 @@ AC_SUBST([LTALLOCA])
   gl_STDINT_H
   gl_STDIO_H
   gl_STDLIB_H
+  gl_FUNC_STRDUP_POSIX
+  if test $ac_cv_func_strdup = no || test $REPLACE_STRDUP = 1; then
+    AC_LIBOBJ([strdup])
+    gl_PREREQ_STRDUP
+  fi
+  gl_STRING_MODULE_INDICATOR([strdup])
   gl_FUNC_GNU_STRFTIME
   if test $gl_cond_libtool = false; then
     gl_ltlibdeps="$gl_ltlibdeps $LTLIBICONV"
@@ -759,7 +795,7 @@ AC_SUBST([LTALLOCA])
   AC_PROG_MKDIR_P
   gl_HEADER_SYS_UIO
   AC_PROG_MKDIR_P
-  gl_THREADLIB
+  gl_FUNC_GEN_TEMPNAME
   gl_HEADER_TIME_H
   gl_TIME_R
   if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
@@ -1000,6 +1036,7 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/floor.c
   lib/frexp.c
   lib/fstat.c
+  lib/fsync.c
   lib/full-read.c
   lib/full-read.h
   lib/full-write.c
@@ -1012,9 +1049,6 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/getsockopt.c
   lib/gettext.h
   lib/gettimeofday.c
-  lib/glthread/lock.c
-  lib/glthread/lock.h
-  lib/glthread/threadlib.c
   lib/iconv.c
   lib/iconv.in.h
   lib/iconv_close.c
@@ -1039,6 +1073,7 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/itold.c
   lib/langinfo.in.h
   lib/libunistring.valgrind
+  lib/link.c
   lib/listen.c
   lib/localcharset.c
   lib/localcharset.h
@@ -1059,6 +1094,8 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/mbtowc.c
   lib/memchr.c
   lib/memchr.valgrind
+  lib/mkdir.c
+  lib/mkstemp.c
   lib/msvc-inval.c
   lib/msvc-inval.h
   lib/msvc-nothrow.c
@@ -1100,6 +1137,7 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/safe-write.c
   lib/safe-write.h
   lib/same-inode.h
+  lib/secure_getenv.c
   lib/select.c
   lib/send.c
   lib/sendto.c
@@ -1124,6 +1162,7 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/stdint.in.h
   lib/stdio.in.h
   lib/stdlib.in.h
+  lib/strdup.c
   lib/streq.h
   lib/strftime.c
   lib/strftime.h
@@ -1140,6 +1179,8 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/sys_times.in.h
   lib/sys_types.in.h
   lib/sys_uio.in.h
+  lib/tempname.c
+  lib/tempname.h
   lib/time.in.h
   lib/time_r.c
   lib/times.c
@@ -1205,6 +1246,7 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/fpieee.m4
   m4/frexp.m4
   m4/fstat.m4
+  m4/fsync.m4
   m4/func.m4
   m4/getaddrinfo.m4
   m4/getlogin.m4
@@ -1237,13 +1279,13 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/lib-prefix.m4
   m4/libunistring-base.m4
   m4/libunistring.m4
+  m4/link.m4
   m4/localcharset.m4
   m4/locale-fr.m4
   m4/locale-ja.m4
   m4/locale-zh.m4
   m4/locale_h.m4
   m4/localeconv.m4
-  m4/lock.m4
   m4/log.m4
   m4/log1p.m4
   m4/longlong.m4
@@ -1257,6 +1299,8 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/mbstate_t.m4
   m4/mbtowc.m4
   m4/memchr.m4
+  m4/mkdir.m4
+  m4/mkstemp.m4
   m4/mmap-anon.m4
   m4/mode_t.m4
   m4/msvc-inval.m4
@@ -1285,6 +1329,7 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/round.m4
   m4/safe-read.m4
   m4/safe-write.m4
+  m4/secure_getenv.m4
   m4/select.m4
   m4/servent.m4
   m4/setenv.m4
@@ -1306,6 +1351,7 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/stdint_h.m4
   m4/stdio_h.m4
   m4/stdlib_h.m4
+  m4/strdup.m4
   m4/strftime.m4
   m4/string_h.m4
   m4/sys_file_h.m4
@@ -1316,7 +1362,7 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/sys_times_h.m4
   m4/sys_types_h.m4
   m4/sys_uio_h.m4
-  m4/threadlib.m4
+  m4/tempname.m4
   m4/time_h.m4
   m4/time_r.m4
   m4/times.m4

m4/link.m4

@@ -0,0 +1,55 @@
+# link.m4 serial 8
+dnl Copyright (C) 2009-2014 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_LINK],
+[
+  AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CHECK_FUNCS_ONCE([link])
+  if test $ac_cv_func_link = no; then
+    HAVE_LINK=0
+  else
+    AC_CACHE_CHECK([whether link obeys POSIX],
+      [gl_cv_func_link_works],
+      [touch conftest.a
+       # Assume that if we have lstat, we can also check symlinks.
+       if test $ac_cv_func_lstat = yes; then
+         ln -s conftest.a conftest.lnk
+       fi
+       AC_RUN_IFELSE(
+         [AC_LANG_PROGRAM(
+           [[#include <unistd.h>
+           ]],
+           [[int result = 0;
+             if (!link ("conftest.a", "conftest.b/"))
+               result |= 1;
+#if HAVE_LSTAT
+             if (!link ("conftest.lnk/", "conftest.b"))
+               result |= 2;
+             if (rename ("conftest.a", "conftest.b"))
+               result |= 4;
+             if (!link ("conftest.b", "conftest.lnk"))
+               result |= 8;
+#endif
+             return result;
+           ]])],
+         [gl_cv_func_link_works=yes], [gl_cv_func_link_works=no],
+         [case "$host_os" in
+                    # Guess yes on glibc systems.
+            *-gnu*) gl_cv_func_link_works="guessing yes" ;;
+                    # If we don't know, assume the worst.
+            *)      gl_cv_func_link_works="guessing no" ;;
+          esac
+         ])
+       rm -f conftest.a conftest.b conftest.lnk])
+    case "$gl_cv_func_link_works" in
+      *yes) ;;
+      *)
+        REPLACE_LINK=1
+        ;;
+    esac
+  fi
+])

m4/lock.m4

@@ -1,42 +0,0 @@
-# lock.m4 serial 13 (gettext-0.18.2)
-dnl Copyright (C) 2005-2014 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-dnl From Bruno Haible.
-
-AC_DEFUN([gl_LOCK],
-[
-  AC_REQUIRE([gl_THREADLIB])
-  if test "$gl_threads_api" = posix; then
-    # OSF/1 4.0 and Mac OS X 10.1 lack the pthread_rwlock_t type and the
-    # pthread_rwlock_* functions.
-    AC_CHECK_TYPE([pthread_rwlock_t],
-      [AC_DEFINE([HAVE_PTHREAD_RWLOCK], [1],
-         [Define if the POSIX multithreading library has read/write locks.])],
-      [],
-      [#include <pthread.h>])
-    # glibc defines PTHREAD_MUTEX_RECURSIVE as enum, not as a macro.
-    AC_COMPILE_IFELSE([
-      AC_LANG_PROGRAM(
-        [[#include <pthread.h>]],
-        [[
-#if __FreeBSD__ == 4
-error "No, in FreeBSD 4.0 recursive mutexes actually don't work."
-#elif (defined __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ \
-       && __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1070)
-error "No, in Mac OS X < 10.7 recursive mutexes actually don't work."
-#else
-int x = (int)PTHREAD_MUTEX_RECURSIVE;
-return !x;
-#endif
-        ]])],
-      [AC_DEFINE([HAVE_PTHREAD_MUTEX_RECURSIVE], [1],
-         [Define if the <pthread.h> defines PTHREAD_MUTEX_RECURSIVE.])])
-  fi
-  gl_PREREQ_LOCK
-])
-
-# Prerequisites of lib/glthread/lock.c.
-AC_DEFUN([gl_PREREQ_LOCK], [:])

m4/mkdir.m4

@@ -0,0 +1,69 @@
+# serial 11
+
+# Copyright (C) 2001, 2003-2004, 2006, 2008-2014 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# On some systems, mkdir ("foo/", 0700) fails because of the trailing slash.
+# On others, mkdir ("foo/./", 0700) mistakenly succeeds.
+# On such systems, arrange to use a wrapper function.
+AC_DEFUN([gl_FUNC_MKDIR],
+[dnl
+  AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CHECK_HEADERS_ONCE([unistd.h])
+  AC_CACHE_CHECK([whether mkdir handles trailing slash],
+    [gl_cv_func_mkdir_trailing_slash_works],
+    [rm -rf conftest.dir
+      AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+#       include <sys/types.h>
+#       include <sys/stat.h>
+]], [return mkdir ("conftest.dir/", 0700);])],
+      [gl_cv_func_mkdir_trailing_slash_works=yes],
+      [gl_cv_func_mkdir_trailing_slash_works=no],
+      [case "$host_os" in
+                 # Guess yes on glibc systems.
+         *-gnu*) gl_cv_func_mkdir_trailing_slash_works="guessing yes" ;;
+                 # If we don't know, assume the worst.
+         *)      gl_cv_func_mkdir_trailing_slash_works="guessing no" ;;
+       esac
+      ])
+    rm -rf conftest.dir
+    ]
+  )
+  case "$gl_cv_func_mkdir_trailing_slash_works" in
+    *yes) ;;
+    *)
+      REPLACE_MKDIR=1
+      ;;
+  esac
+
+  AC_CACHE_CHECK([whether mkdir handles trailing dot],
+    [gl_cv_func_mkdir_trailing_dot_works],
+    [rm -rf conftest.dir
+      AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+#       include <sys/types.h>
+#       include <sys/stat.h>
+]], [return !mkdir ("conftest.dir/./", 0700);])],
+      [gl_cv_func_mkdir_trailing_dot_works=yes],
+      [gl_cv_func_mkdir_trailing_dot_works=no],
+      [case "$host_os" in
+                 # Guess yes on glibc systems.
+         *-gnu*) gl_cv_func_mkdir_trailing_dot_works="guessing yes" ;;
+                 # If we don't know, assume the worst.
+         *)      gl_cv_func_mkdir_trailing_dot_works="guessing no" ;;
+       esac
+      ])
+    rm -rf conftest.dir
+    ]
+  )
+  case "$gl_cv_func_mkdir_trailing_dot_works" in
+    *yes) ;;
+    *)
+      REPLACE_MKDIR=1
+      AC_DEFINE([FUNC_MKDIR_DOT_BUG], [1], [Define to 1 if mkdir mistakenly
+        creates a directory given with a trailing dot component.])
+      ;;
+  esac
+])

m4/mkstemp.m4

@@ -0,0 +1,82 @@
+#serial 23
+
+# Copyright (C) 2001, 2003-2007, 2009-2014 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# On some hosts (e.g., HP-UX 10.20, SunOS 4.1.4, Solaris 2.5.1), mkstemp has a
+# silly limit that it can create no more than 26 files from a given template.
+# Other systems lack mkstemp altogether.
+# On OSF1/Tru64 V4.0F, the system-provided mkstemp function can create
+# only 32 files per process.
+# On some hosts, mkstemp creates files with mode 0666, which is a security
+# problem and a violation of POSIX 2008.
+# On systems like the above, arrange to use the replacement function.
+AC_DEFUN([gl_FUNC_MKSTEMP],
+[
+  AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+  AC_CHECK_FUNCS_ONCE([mkstemp])
+  if test $ac_cv_func_mkstemp = yes; then
+    AC_CACHE_CHECK([for working mkstemp],
+      [gl_cv_func_working_mkstemp],
+      [
+        mkdir conftest.mkstemp
+        AC_RUN_IFELSE(
+          [AC_LANG_PROGRAM(
+            [AC_INCLUDES_DEFAULT],
+            [[int result = 0;
+              int i;
+              off_t large = (off_t) 4294967295u;
+              if (large < 0)
+                large = 2147483647;
+              umask (0);
+              for (i = 0; i < 70; i++)
+                {
+                  char templ[] = "conftest.mkstemp/coXXXXXX";
+                  int (*mkstemp_function) (char *) = mkstemp;
+                  int fd = mkstemp_function (templ);
+                  if (fd < 0)
+                    result |= 1;
+                  else
+                    {
+                      struct stat st;
+                      if (lseek (fd, large, SEEK_SET) != large)
+                        result |= 2;
+                      if (fstat (fd, &st) < 0)
+                        result |= 4;
+                      else if (st.st_mode & 0077)
+                        result |= 8;
+                      if (close (fd))
+                        result |= 16;
+                    }
+                }
+              return result;]])],
+          [gl_cv_func_working_mkstemp=yes],
+          [gl_cv_func_working_mkstemp=no],
+          [case "$host_os" in
+                     # Guess yes on glibc systems.
+             *-gnu*) gl_cv_func_working_mkstemp="guessing yes" ;;
+                     # If we don't know, assume the worst.
+             *)      gl_cv_func_working_mkstemp="guessing no" ;;
+           esac
+          ])
+        rm -rf conftest.mkstemp
+      ])
+    case "$gl_cv_func_working_mkstemp" in
+      *yes) ;;
+      *)
+        REPLACE_MKSTEMP=1
+        ;;
+    esac
+  else
+    HAVE_MKSTEMP=0
+  fi
+])
+
+# Prerequisites of lib/mkstemp.c.
+AC_DEFUN([gl_PREREQ_MKSTEMP],
+[
+])

m4/secure_getenv.m4

@@ -0,0 +1,25 @@
+# Look up an environment variable more securely.
+dnl Copyright 2013-2014 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_SECURE_GETENV],
+[
+  dnl Persuade glibc <stdlib.h> to declare secure_getenv().
+  AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+  AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
+  AC_CHECK_FUNCS_ONCE([secure_getenv])
+  if test $ac_cv_func_secure_getenv = no; then
+    HAVE_SECURE_GETENV=0
+  fi
+])
+
+# Prerequisites of lib/secure_getenv.c.
+AC_DEFUN([gl_PREREQ_SECURE_GETENV], [
+  AC_CHECK_FUNCS([__secure_getenv])
+  if test $ac_cv_func___secure_getenv = no; then
+    AC_CHECK_FUNCS([issetugid])
+  fi
+])

m4/strdup.m4

@@ -0,0 +1,36 @@
+# strdup.m4 serial 13
+
+dnl Copyright (C) 2002-2014 Free Software Foundation, Inc.
+
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_STRDUP],
+[
+  AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+  AC_CHECK_FUNCS_ONCE([strdup])
+  AC_CHECK_DECLS_ONCE([strdup])
+  if test $ac_cv_have_decl_strdup = no; then
+    HAVE_DECL_STRDUP=0
+  fi
+])
+
+AC_DEFUN([gl_FUNC_STRDUP_POSIX],
+[
+  AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+  AC_REQUIRE([gl_CHECK_MALLOC_POSIX])
+  AC_CHECK_FUNCS_ONCE([strdup])
+  if test $ac_cv_func_strdup = yes; then
+    if test $gl_cv_func_malloc_posix != yes; then
+      REPLACE_STRDUP=1
+    fi
+  fi
+  AC_CHECK_DECLS_ONCE([strdup])
+  if test $ac_cv_have_decl_strdup = no; then
+    HAVE_DECL_STRDUP=0
+  fi
+])
+
+# Prerequisites of lib/strdup.c.
+AC_DEFUN([gl_PREREQ_STRDUP], [:])

m4/tempname.m4

@@ -0,0 +1,19 @@
+#serial 5
+
+# Copyright (C) 2006-2007, 2009-2014 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# glibc provides __gen_tempname as a wrapper for mk[ds]temp.  Expose
+# it as a public API, and provide it on systems that are lacking.
+AC_DEFUN([gl_FUNC_GEN_TEMPNAME],
+[
+  gl_PREREQ_TEMPNAME
+])
+
+# Prerequisites of lib/tempname.c.
+AC_DEFUN([gl_PREREQ_TEMPNAME],
+[
+  :
+])

m4/threadlib.m4

@@ -1,371 +0,0 @@
-# threadlib.m4 serial 10 (gettext-0.18.2)
-dnl Copyright (C) 2005-2014 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-dnl From Bruno Haible.
-
-dnl gl_THREADLIB
-dnl ------------
-dnl Tests for a multithreading library to be used.
-dnl If the configure.ac contains a definition of the gl_THREADLIB_DEFAULT_NO
-dnl (it must be placed before the invocation of gl_THREADLIB_EARLY!), then the
-dnl default is 'no', otherwise it is system dependent. In both cases, the user
-dnl can change the choice through the options --enable-threads=choice or
-dnl --disable-threads.
-dnl Defines at most one of the macros USE_POSIX_THREADS, USE_SOLARIS_THREADS,
-dnl USE_PTH_THREADS, USE_WINDOWS_THREADS
-dnl Sets the variables LIBTHREAD and LTLIBTHREAD to the linker options for use
-dnl in a Makefile (LIBTHREAD for use without libtool, LTLIBTHREAD for use with
-dnl libtool).
-dnl Sets the variables LIBMULTITHREAD and LTLIBMULTITHREAD similarly, for
-dnl programs that really need multithread functionality. The difference
-dnl between LIBTHREAD and LIBMULTITHREAD is that on platforms supporting weak
-dnl symbols, typically LIBTHREAD="" whereas LIBMULTITHREAD="-lpthread".
-dnl Adds to CPPFLAGS the flag -D_REENTRANT or -D_THREAD_SAFE if needed for
-dnl multithread-safe programs.
-
-AC_DEFUN([gl_THREADLIB_EARLY],
-[
-  AC_REQUIRE([gl_THREADLIB_EARLY_BODY])
-])
-
-dnl The guts of gl_THREADLIB_EARLY. Needs to be expanded only once.
-
-AC_DEFUN([gl_THREADLIB_EARLY_BODY],
-[
-  dnl Ordering constraints: This macro modifies CPPFLAGS in a way that
-  dnl influences the result of the autoconf tests that test for *_unlocked
-  dnl declarations, on AIX 5 at least. Therefore it must come early.
-  AC_BEFORE([$0], [gl_FUNC_GLIBC_UNLOCKED_IO])dnl
-  AC_BEFORE([$0], [gl_ARGP])dnl
-
-  AC_REQUIRE([AC_CANONICAL_HOST])
-  dnl _GNU_SOURCE is needed for pthread_rwlock_t on glibc systems.
-  dnl AC_USE_SYSTEM_EXTENSIONS was introduced in autoconf 2.60 and obsoletes
-  dnl AC_GNU_SOURCE.
-  m4_ifdef([AC_USE_SYSTEM_EXTENSIONS],
-    [AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])],
-    [AC_REQUIRE([AC_GNU_SOURCE])])
-  dnl Check for multithreading.
-  m4_ifdef([gl_THREADLIB_DEFAULT_NO],
-    [m4_divert_text([DEFAULTS], [gl_use_threads_default=no])],
-    [m4_divert_text([DEFAULTS], [gl_use_threads_default=])])
-  AC_ARG_ENABLE([threads],
-AC_HELP_STRING([--enable-threads={posix|solaris|pth|windows}], [specify multithreading API])m4_ifdef([gl_THREADLIB_DEFAULT_NO], [], [
-AC_HELP_STRING([--disable-threads], [build without multithread safety])]),
-    [gl_use_threads=$enableval],
-    [if test -n "$gl_use_threads_default"; then
-       gl_use_threads="$gl_use_threads_default"
-     else
-changequote(,)dnl
-       case "$host_os" in
-         dnl Disable multithreading by default on OSF/1, because it interferes
-         dnl with fork()/exec(): When msgexec is linked with -lpthread, its
-         dnl child process gets an endless segmentation fault inside execvp().
-         dnl Disable multithreading by default on Cygwin 1.5.x, because it has
-         dnl bugs that lead to endless loops or crashes. See
-         dnl <http://cygwin.com/ml/cygwin/2009-08/msg00283.html>.
-         osf*) gl_use_threads=no ;;
-         cygwin*)
-               case `uname -r` in
-                 1.[0-5].*) gl_use_threads=no ;;
-                 *)         gl_use_threads=yes ;;
-               esac
-               ;;
-         *)    gl_use_threads=yes ;;
-       esac
-changequote([,])dnl
-     fi
-    ])
-  if test "$gl_use_threads" = yes || test "$gl_use_threads" = posix; then
-    # For using <pthread.h>:
-    case "$host_os" in
-      osf*)
-        # On OSF/1, the compiler needs the flag -D_REENTRANT so that it
-        # groks <pthread.h>. cc also understands the flag -pthread, but
-        # we don't use it because 1. gcc-2.95 doesn't understand -pthread,
-        # 2. putting a flag into CPPFLAGS that has an effect on the linker
-        # causes the AC_LINK_IFELSE test below to succeed unexpectedly,
-        # leading to wrong values of LIBTHREAD and LTLIBTHREAD.
-        CPPFLAGS="$CPPFLAGS -D_REENTRANT"
-        ;;
-    esac
-    # Some systems optimize for single-threaded programs by default, and
-    # need special flags to disable these optimizations. For example, the
-    # definition of 'errno' in <errno.h>.
-    case "$host_os" in
-      aix* | freebsd*) CPPFLAGS="$CPPFLAGS -D_THREAD_SAFE" ;;
-      solaris*) CPPFLAGS="$CPPFLAGS -D_REENTRANT" ;;
-    esac
-  fi
-])
-
-dnl The guts of gl_THREADLIB. Needs to be expanded only once.
-
-AC_DEFUN([gl_THREADLIB_BODY],
-[
-  AC_REQUIRE([gl_THREADLIB_EARLY_BODY])
-  gl_threads_api=none
-  LIBTHREAD=
-  LTLIBTHREAD=
-  LIBMULTITHREAD=
-  LTLIBMULTITHREAD=
-  if test "$gl_use_threads" != no; then
-    dnl Check whether the compiler and linker support weak declarations.
-    AC_CACHE_CHECK([whether imported symbols can be declared weak],
-      [gl_cv_have_weak],
-      [gl_cv_have_weak=no
-       dnl First, test whether the compiler accepts it syntactically.
-       AC_LINK_IFELSE(
-         [AC_LANG_PROGRAM(
-            [[extern void xyzzy ();
-#pragma weak xyzzy]],
-            [[xyzzy();]])],
-         [gl_cv_have_weak=maybe])
-       if test $gl_cv_have_weak = maybe; then
-         dnl Second, test whether it actually works. On Cygwin 1.7.2, with
-         dnl gcc 4.3, symbols declared weak always evaluate to the address 0.
-         AC_RUN_IFELSE(
-           [AC_LANG_SOURCE([[
-#include <stdio.h>
-#pragma weak fputs
-int main ()
-{
-  return (fputs == NULL);
-}]])],
-           [gl_cv_have_weak=yes],
-           [gl_cv_have_weak=no],
-           [dnl When cross-compiling, assume that only ELF platforms support
-            dnl weak symbols.
-            AC_EGREP_CPP([Extensible Linking Format],
-              [#ifdef __ELF__
-               Extensible Linking Format
-               #endif
-              ],
-              [gl_cv_have_weak="guessing yes"],
-              [gl_cv_have_weak="guessing no"])
-           ])
-       fi
-      ])
-    if test "$gl_use_threads" = yes || test "$gl_use_threads" = posix; then
-      # On OSF/1, the compiler needs the flag -pthread or -D_REENTRANT so that
-      # it groks <pthread.h>. It's added above, in gl_THREADLIB_EARLY_BODY.
-      AC_CHECK_HEADER([pthread.h],
-        [gl_have_pthread_h=yes], [gl_have_pthread_h=no])
-      if test "$gl_have_pthread_h" = yes; then
-        # Other possible tests:
-        #   -lpthreads (FSU threads, PCthreads)
-        #   -lgthreads
-        gl_have_pthread=
-        # Test whether both pthread_mutex_lock and pthread_mutexattr_init exist
-        # in libc. IRIX 6.5 has the first one in both libc and libpthread, but
-        # the second one only in libpthread, and lock.c needs it.
-        AC_LINK_IFELSE(
-          [AC_LANG_PROGRAM(
-             [[#include <pthread.h>]],
-             [[pthread_mutex_lock((pthread_mutex_t*)0);
-               pthread_mutexattr_init((pthread_mutexattr_t*)0);]])],
-          [gl_have_pthread=yes])
-        # Test for libpthread by looking for pthread_kill. (Not pthread_self,
-        # since it is defined as a macro on OSF/1.)
-        if test -n "$gl_have_pthread"; then
-          # The program links fine without libpthread. But it may actually
-          # need to link with libpthread in order to create multiple threads.
-          AC_CHECK_LIB([pthread], [pthread_kill],
-            [LIBMULTITHREAD=-lpthread LTLIBMULTITHREAD=-lpthread
-             # On Solaris and HP-UX, most pthread functions exist also in libc.
-             # Therefore pthread_in_use() needs to actually try to create a
-             # thread: pthread_create from libc will fail, whereas
-             # pthread_create will actually create a thread.
-             case "$host_os" in
-               solaris* | hpux*)
-                 AC_DEFINE([PTHREAD_IN_USE_DETECTION_HARD], [1],
-                   [Define if the pthread_in_use() detection is hard.])
-             esac
-            ])
-        else
-          # Some library is needed. Try libpthread and libc_r.
-          AC_CHECK_LIB([pthread], [pthread_kill],
-            [gl_have_pthread=yes
-             LIBTHREAD=-lpthread LTLIBTHREAD=-lpthread
-             LIBMULTITHREAD=-lpthread LTLIBMULTITHREAD=-lpthread])
-          if test -z "$gl_have_pthread"; then
-            # For FreeBSD 4.
-            AC_CHECK_LIB([c_r], [pthread_kill],
-              [gl_have_pthread=yes
-               LIBTHREAD=-lc_r LTLIBTHREAD=-lc_r
-               LIBMULTITHREAD=-lc_r LTLIBMULTITHREAD=-lc_r])
-          fi
-        fi
-        if test -n "$gl_have_pthread"; then
-          gl_threads_api=posix
-          AC_DEFINE([USE_POSIX_THREADS], [1],
-            [Define if the POSIX multithreading library can be used.])
-          if test -n "$LIBMULTITHREAD" || test -n "$LTLIBMULTITHREAD"; then
-            if case "$gl_cv_have_weak" in *yes) true;; *) false;; esac; then
-              AC_DEFINE([USE_POSIX_THREADS_WEAK], [1],
-                [Define if references to the POSIX multithreading library should be made weak.])
-              LIBTHREAD=
-              LTLIBTHREAD=
-            fi
-          fi
-        fi
-      fi
-    fi
-    if test -z "$gl_have_pthread"; then
-      if test "$gl_use_threads" = yes || test "$gl_use_threads" = solaris; then
-        gl_have_solaristhread=
-        gl_save_LIBS="$LIBS"
-        LIBS="$LIBS -lthread"
-        AC_LINK_IFELSE(
-          [AC_LANG_PROGRAM(
-             [[
-#include <thread.h>
-#include <synch.h>
-             ]],
-             [[thr_self();]])],
-          [gl_have_solaristhread=yes])
-        LIBS="$gl_save_LIBS"
-        if test -n "$gl_have_solaristhread"; then
-          gl_threads_api=solaris
-          LIBTHREAD=-lthread
-          LTLIBTHREAD=-lthread
-          LIBMULTITHREAD="$LIBTHREAD"
-          LTLIBMULTITHREAD="$LTLIBTHREAD"
-          AC_DEFINE([USE_SOLARIS_THREADS], [1],
-            [Define if the old Solaris multithreading library can be used.])
-          if case "$gl_cv_have_weak" in *yes) true;; *) false;; esac; then
-            AC_DEFINE([USE_SOLARIS_THREADS_WEAK], [1],
-              [Define if references to the old Solaris multithreading library should be made weak.])
-            LIBTHREAD=
-            LTLIBTHREAD=
-          fi
-        fi
-      fi
-    fi
-    if test "$gl_use_threads" = pth; then
-      gl_save_CPPFLAGS="$CPPFLAGS"
-      AC_LIB_LINKFLAGS([pth])
-      gl_have_pth=
-      gl_save_LIBS="$LIBS"
-      LIBS="$LIBS $LIBPTH"
-      AC_LINK_IFELSE(
-        [AC_LANG_PROGRAM([[#include <pth.h>]], [[pth_self();]])],
-        [gl_have_pth=yes])
-      LIBS="$gl_save_LIBS"
-      if test -n "$gl_have_pth"; then
-        gl_threads_api=pth
-        LIBTHREAD="$LIBPTH"
-        LTLIBTHREAD="$LTLIBPTH"
-        LIBMULTITHREAD="$LIBTHREAD"
-        LTLIBMULTITHREAD="$LTLIBTHREAD"
-        AC_DEFINE([USE_PTH_THREADS], [1],
-          [Define if the GNU Pth multithreading library can be used.])
-        if test -n "$LIBMULTITHREAD" || test -n "$LTLIBMULTITHREAD"; then
-          if case "$gl_cv_have_weak" in *yes) true;; *) false;; esac; then
-            AC_DEFINE([USE_PTH_THREADS_WEAK], [1],
-              [Define if references to the GNU Pth multithreading library should be made weak.])
-            LIBTHREAD=
-            LTLIBTHREAD=
-          fi
-        fi
-      else
-        CPPFLAGS="$gl_save_CPPFLAGS"
-      fi
-    fi
-    if test -z "$gl_have_pthread"; then
-      case "$gl_use_threads" in
-        yes | windows | win32) # The 'win32' is for backward compatibility.
-          if { case "$host_os" in
-                 mingw*) true;;
-                 *) false;;
-               esac
-             }; then
-            gl_threads_api=windows
-            AC_DEFINE([USE_WINDOWS_THREADS], [1],
-              [Define if the native Windows multithreading API can be used.])
-          fi
-          ;;
-      esac
-    fi
-  fi
-  AC_MSG_CHECKING([for multithread API to use])
-  AC_MSG_RESULT([$gl_threads_api])
-  AC_SUBST([LIBTHREAD])
-  AC_SUBST([LTLIBTHREAD])
-  AC_SUBST([LIBMULTITHREAD])
-  AC_SUBST([LTLIBMULTITHREAD])
-])
-
-AC_DEFUN([gl_THREADLIB],
-[
-  AC_REQUIRE([gl_THREADLIB_EARLY])
-  AC_REQUIRE([gl_THREADLIB_BODY])
-])
-
-
-dnl gl_DISABLE_THREADS
-dnl ------------------
-dnl Sets the gl_THREADLIB default so that threads are not used by default.
-dnl The user can still override it at installation time, by using the
-dnl configure option '--enable-threads'.
-
-AC_DEFUN([gl_DISABLE_THREADS], [
-  m4_divert_text([INIT_PREPARE], [gl_use_threads_default=no])
-])
-
-
-dnl Survey of platforms:
-dnl
-dnl Platform           Available  Compiler    Supports   test-lock
-dnl                    flavours   option      weak       result
-dnl ---------------    ---------  ---------   --------   ---------
-dnl Linux 2.4/glibc    posix      -lpthread       Y      OK
-dnl
-dnl GNU Hurd/glibc     posix
-dnl
-dnl FreeBSD 5.3        posix      -lc_r           Y
-dnl                    posix      -lkse ?         Y
-dnl                    posix      -lpthread ?     Y
-dnl                    posix      -lthr           Y
-dnl
-dnl FreeBSD 5.2        posix      -lc_r           Y
-dnl                    posix      -lkse           Y
-dnl                    posix      -lthr           Y
-dnl
-dnl FreeBSD 4.0,4.10   posix      -lc_r           Y      OK
-dnl
-dnl NetBSD 1.6         --
-dnl
-dnl OpenBSD 3.4        posix      -lpthread       Y      OK
-dnl
-dnl Mac OS X 10.[123]  posix      -lpthread       Y      OK
-dnl
-dnl Solaris 7,8,9      posix      -lpthread       Y      Sol 7,8: 0.0; Sol 9: OK
-dnl                    solaris    -lthread        Y      Sol 7,8: 0.0; Sol 9: OK
-dnl
-dnl HP-UX 11           posix      -lpthread       N (cc) OK
-dnl                                               Y (gcc)
-dnl
-dnl IRIX 6.5           posix      -lpthread       Y      0.5
-dnl
-dnl AIX 4.3,5.1        posix      -lpthread       N      AIX 4: 0.5; AIX 5: OK
-dnl
-dnl OSF/1 4.0,5.1      posix      -pthread (cc)   N      OK
-dnl                               -lpthread (gcc) Y
-dnl
-dnl Cygwin             posix      -lpthread       Y      OK
-dnl
-dnl Any of the above   pth        -lpth                  0.0
-dnl
-dnl Mingw              windows                    N      OK
-dnl
-dnl BeOS 5             --
-dnl
-dnl The test-lock result shows what happens if in test-lock.c EXPLICIT_YIELD is
-dnl turned off:
-dnl   OK if all three tests terminate OK,
-dnl   0.5 if the first test terminates OK but the second one loops endlessly,
-dnl   0.0 if the first test already loops endlessly.

maint.mk

@@ -76,7 +76,7 @@ _dot_escaped_srcdir = $(subst .,\.,$(srcdir))
 ifeq ($(srcdir),.)
   _prepend_srcdir_prefix =
 else
-  _prepend_srcdir_prefix = | sed 's|^|$(srcdir)/|'
+  _prepend_srcdir_prefix = | $(SED) 's|^|$(srcdir)/|'
 endif
 
 # In order to be able to consistently filter "."-relative names,
@@ -85,7 +85,7 @@ endif
 _sc_excl = \
   $(or $(exclude_file_name_regexp--$@),^$$)
 VC_LIST_EXCEPT = \
-  $(VC_LIST) | sed 's|^$(_dot_escaped_srcdir)/||' \
+  $(VC_LIST) | $(SED) 's|^$(_dot_escaped_srcdir)/||' \
 	| if test -f $(srcdir)/.x-$@; then grep -vEf $(srcdir)/.x-$@; \
 	  else grep -Ev -e "$${VC_LIST_EXCEPT_DEFAULT-ChangeLog}"; fi \
 	| grep -Ev -e '($(VC_LIST_ALWAYS_EXCLUDE_REGEX)|$(_sc_excl))' \
@@ -158,8 +158,8 @@ export LC_ALL = C
 _cfg_mk := $(wildcard $(srcdir)/cfg.mk)
 
 # Collect the names of rules starting with 'sc_'.
-syntax-check-rules := $(sort $(shell sed -n 's/^\(sc_[a-zA-Z0-9_-]*\):.*/\1/p' \
+syntax-check-rules := $(sort $(shell $(SED) -n \
-			$(srcdir)/$(ME) $(_cfg_mk)))
+   's/^\(sc_[a-zA-Z0-9_-]*\):.*/\1/p' $(srcdir)/$(ME) $(_cfg_mk)))
 .PHONY: $(syntax-check-rules)
 
 ifeq ($(shell $(VC_LIST) >/dev/null 2>&1; echo $$?),0)
@@ -448,7 +448,7 @@ sc_require_config_h_first:
 	@if $(VC_LIST_EXCEPT) | grep -l '\.c$$' > /dev/null; then	\
 	  fail=0;							\
 	  for i in $$($(VC_LIST_EXCEPT) | grep '\.c$$'); do		\
-	    grep '^# *include\>' $$i | sed 1q				\
+	    grep '^# *include\>' $$i | $(SED) 1q			\
 		| grep -E '^# *include $(config_h_header)' > /dev/null	\
 	      || { echo $$i; fail=1; };					\
 	  done;								\
@@ -468,7 +468,7 @@ sc_prohibit_HAVE_MBRTOWC:
 # re: a regular expression that matches IFF something provided by $h is used.
 define _sc_header_without_use
   dummy=; : so we do not need a semicolon before each use;		\
-  h_esc=`echo '[<"]'"$$h"'[">]'|sed 's/\./\\\\./g'`;			\
+  h_esc=`echo '[<"]'"$$h"'[">]'|$(SED) 's/\./\\\\./g'`;			\
   if $(VC_LIST_EXCEPT) | grep -l '\.c$$' > /dev/null; then		\
     files=$$(grep -l '^# *include '"$$h_esc"				\
 	     $$($(VC_LIST_EXCEPT) | grep '\.c$$')) &&			\
@@ -789,7 +789,7 @@ sc_useless_cpp_parens:
 # #if HAVE_HEADER_H that you remove, be sure that your project explicitly
 # requires the gnulib module that guarantees the usability of that header.
 gl_assured_headers_ = \
-  cd $(gnulib_dir)/lib && echo *.in.h|sed 's/\.in\.h//g'
+  cd $(gnulib_dir)/lib && echo *.in.h|$(SED) 's/\.in\.h//g'
 
 # Convert the list of names to upper case, and replace each space with "|".
 az_ = abcdefghijklmnopqrstuvwxyz
@@ -840,7 +840,7 @@ define def_sym_regex
 	      && perl -lne '$(gl_extract_significant_defines_)' $$f;	\
 	  done;								\
 	) | sort -u							\
-	  | sed 's/^/^ *# *(define|undef)  */;s/$$/\\>/'
+	  | $(SED) 's/^/^ *# *(define|undef)  */;s/$$/\\>/'
 endef
 
 # Don't define macros that we already get from gnulib header files.
@@ -1054,12 +1054,12 @@ sc_const_long_option:
 	  $(_sc_search_regexp)
 
 NEWS_hash =								\
-  $$(sed -n '/^\*.* $(PREV_VERSION_REGEXP) ([0-9-]*)/,$$p'		\
+  $$($(SED) -n '/^\*.* $(PREV_VERSION_REGEXP) ([0-9-]*)/,$$p'		\
        $(srcdir)/NEWS							\
      | perl -0777 -pe							\
 	's/^Copyright.+?Free\sSoftware\sFoundation,\sInc\.\n//ms'	\
      | md5sum -								\
-     | sed 's/ .*//')
+     | $(SED) 's/ .*//')
 
 # Ensure that we don't accidentally insert an entry into an old NEWS block.
 sc_immutable_NEWS:
@@ -1097,7 +1097,7 @@ sc_makefile_at_at_check:
 	  && { echo '$(ME): use $$(...), not @...@' 1>&2; exit 1; } || :
 
 news-check: NEWS
-	$(AM_V_GEN)if sed -n $(news-check-lines-spec)p $<		\
+	$(AM_V_GEN)if $(SED) -n $(news-check-lines-spec)p $<		\
 	    | grep -E $(news-check-regexp) >/dev/null; then		\
 	  :;								\
 	else								\
@@ -1146,7 +1146,7 @@ sc_po_check:
 	    files="$$files $$file";					\
 	  done;								\
 	  grep -E -l '$(_gl_translatable_string_re)' $$files		\
-	    | sed 's|^$(_dot_escaped_srcdir)/||' | sort -u > $@-2;	\
+	    | $(SED) 's|^$(_dot_escaped_srcdir)/||' | sort -u > $@-2;	\
 	  diff -u -L $(po_file) -L $(po_file) $@-1 $@-2			\
 	    || { printf '$(ME): '$(fix_po_file_diag) 1>&2; exit 1; };	\
 	  rm -f $@-1 $@-2;						\
@@ -1511,7 +1511,7 @@ refresh-gnulib-patches:
 	  test -n "$$t" && gl=$$t;					\
 	fi;								\
 	for diff in $$(cd $$gl; git ls-files | grep '\.diff$$'); do	\
-	  b=$$(printf %s "$$diff"|sed 's/\.diff$$//');			\
+	  b=$$(printf %s "$$diff"|$(SED) 's/\.diff$$//');		\
 	  VERSION_CONTROL=none						\
 	    patch "$(gnulib_dir)/$$b" "$$gl/$$diff" || exit 1;		\
 	  ( cd $(gnulib_dir) || exit 1;					\
@@ -1530,7 +1530,8 @@ refresh-po:
 	wget --no-verbose --directory-prefix $(PODIR) --no-directories --recursive --level 1 --accept .po --accept .po.1 $(POURL) && \
 	echo 'en@boldquot' > $(PODIR)/LINGUAS && \
 	echo 'en@quot' >> $(PODIR)/LINGUAS && \
-	ls $(PODIR)/*.po | sed 's/\.po//;s,$(PODIR)/,,' | sort >> $(PODIR)/LINGUAS
+	ls $(PODIR)/*.po | $(SED) 's/\.po//;s,$(PODIR)/,,' | \
+	  sort >> $(PODIR)/LINGUAS
 
  # Running indent once is not idempotent, but running it twice is.
 INDENT_SOURCES ?= $(C_SOURCES)
@@ -1640,18 +1641,18 @@ _gl_tight_scope: $(bin_PROGRAMS)
 	       test -f $$f && d= || d=$(srcdir)/; echo $$d$$f; done`;	\
 	( printf '^%s$$\n' '__.*' $(_gl_TS_unmarked_extern_functions);	\
 	  grep -h -A1 '^extern .*[^;]$$' $$src				\
-	    | grep -vE '^(extern |--)' | sed 's/ .*//';			\
+	    | grep -vE '^(extern |--)' | $(SED) 's/ .*//';		\
 	  perl -lne							\
 	     '$(_gl_TS_function_match) and print "^$$1\$$"' $$hdr;	\
 	) | sort -u > $$t;						\
-	nm -e $(_gl_TS_obj_files) | sed -n 's/.* T //p'|grep -Ev -f $$t	\
+	nm -e $(_gl_TS_obj_files)|$(SED) -n 's/.* T //p'|grep -Ev -f $$t \
 	  && { echo the above functions should have static scope >&2;	\
 	       exit 1; } || : ;						\
 	( printf '^%s$$\n' '__.*' $(_gl_TS_unmarked_extern_vars);	\
 	  perl -lne '$(_gl_TS_var_match) and print "^$$1\$$"'		\
 		$$hdr $(_gl_TS_other_headers)				\
 	) | sort -u > $$t;						\
-	nm -e $(_gl_TS_obj_files) | sed -n 's/.* [BCDGRS] //p'		\
+	nm -e $(_gl_TS_obj_files) | $(SED) -n 's/.* [BCDGRS] //p'	\
             | sort -u | grep -Ev -f $$t					\
 	  && { echo the above variables should have static scope >&2;	\
 	       exit 1; } || :

module/Makefile.am

@@ -202,6 +202,7 @@ SYSTEM_BASE_SOURCES =				\
   system/base/lalr.scm				\
   system/base/message.scm			\
   system/base/target.scm			\
+  system/base/types.scm				\
   system/base/ck.scm
 
 ICE_9_SOURCES = \
@@ -386,7 +387,8 @@ SYSTEM_SOURCES =				\
   system/repl/common.scm			\
   system/repl/command.scm			\
   system/repl/repl.scm				\
-  system/repl/server.scm
+  system/repl/server.scm			\
+  system/repl/coop-server.scm
 
 LIB_SOURCES =					\
   statprof.scm					\

module/ice-9/ftw.scm

@@ -1,6 +1,6 @@
 ;;;; ftw.scm --- file system tree walk
 
-;;;; 	Copyright (C) 2002, 2003, 2006, 2011, 2012 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2002, 2003, 2006, 2011, 2012, 2014 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
@@ -259,7 +259,8 @@
       (let* ((perms (stat:perms s))
              (perms-bit-set? (lambda (mask)
                                (not (= 0 (logand mask perms))))))
-        (or (and (= uid (stat:uid s))
+        (or (zero? uid)
+            (and (= uid (stat:uid s))
                  (perms-bit-set? #o400))
             (and (= gid (stat:gid s))
                  (perms-bit-set? #o040))

module/rnrs/io/simple.scm

@@ -1,6 +1,6 @@
 ;;; simple.scm --- The R6RS simple I/O library
 
-;;      Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;      Copyright (C) 2010, 2011, 2014 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
@@ -91,6 +91,7 @@
                 eof-object 
                 eof-object?
                 file-options
+                buffer-mode
                 native-transcoder
                 get-char
                 lookahead-char
@@ -131,10 +132,16 @@
       (lambda (port) (with-output-to-port port thunk))))
 
   (define (open-input-file filename)
-    (open-file-input-port filename (file-options) (native-transcoder)))
+    (open-file-input-port filename
+                          (file-options)
+                          (buffer-mode block)
+                          (native-transcoder)))
 
   (define (open-output-file filename)
-    (open-file-output-port filename (file-options) (native-transcoder)))
+    (open-file-output-port filename
+                           (file-options)
+                           (buffer-mode block)
+                           (native-transcoder)))
 
   (define close-input-port close-port)
   (define close-output-port close-port)

module/scripts/snarf-check-and-output-texi.scm

@@ -1,6 +1,6 @@
 ;;; snarf-check-and-output-texi --- called by the doc snarfer.
 
-;; 	Copyright (C) 2001, 2002, 2006, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2006, 2011, 2014 Free Software Foundation, Inc.
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public License
@@ -63,7 +63,7 @@
                                                (let loop ((s s))
                                                  (cond
                                                    ((stream-null? s) #t)
-                                                   ((eq? 'eol (stream-car s))
+                                                   ((memq (stream-car s) '(eol hash))
                                                     (loop (stream-cdr s)))
                                                    (else (cons (stream-car s) (stream-cdr s))))))
                                              (port->stream port read)))))
@@ -265,17 +265,6 @@
       (set! *file* file)
       (set! *line* line))
 
-     ;; newer gccs like to throw around more location markers into the
-     ;; preprocessed source; these (hash . hash) bits are what they translate to
-     ;; in snarfy terms.
-     (('location ('string . file) ('int . line) ('hash . 'hash))
-      (set! *file* file)
-      (set! *line* line))
-
-     (('location ('hash . 'hash) ('string . file) ('int . line) ('hash . 'hash))
-      (set! *file* file)
-      (set! *line* line))
-
      (('arglist rest ...)
       (set! *args* (do-arglist rest)))
 

module/srfi/srfi-18.scm

@@ -1,6 +1,6 @@
 ;;; srfi-18.scm --- Multithreading support
 
-;; Copyright (C) 2008, 2009, 2010, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009, 2010, 2012, 2014 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,7 +82,7 @@
  uncaught-exception?
  uncaught-exception-reason
  )
-  :re-export (thread? mutex? condition-variable?)
+  :re-export (current-thread thread? mutex? condition-variable?)
   :replace (current-time 
 	    make-thread 
 	    make-mutex 
@@ -236,7 +236,7 @@
 				   (list timeout) 
 				   '()))))
 	 (secs (inexact->exact (truncate t)))
-	 (usecs (inexact->exact (truncate (* (- t secs) 1000)))))
+	 (usecs (inexact->exact (truncate (* (- t secs) 1000000)))))
     (and (> secs 0) (sleep secs))
     (and (> usecs 0) (usleep usecs))
     *unspecified*))
@@ -380,4 +380,4 @@
 	 (cons (inexact->exact fx)
 	       (inexact->exact (truncate (* (- x fx) 1000000)))))))
 
-;; srfi-18.scm ends here
+;; srfi-18.scm ends here

module/srfi/srfi-19.scm

@@ -1,6 +1,7 @@
 ;;; srfi-19.scm --- Time/Date Library
 
-;; 	Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009, 2010,
+;;   2011, 2014 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
@@ -171,7 +172,7 @@
 ;; A table of leap seconds
 ;; See ftp://maia.usno.navy.mil/ser7/tai-utc.dat
 ;; and update as necessary.
-;; this procedures reads the file in the abover
+;; this procedures reads the file in the above
 ;; format and creates the leap second table
 ;; it also calls the almost standard, but not R5 procedures read-line
 ;; & open-input-string
@@ -202,7 +203,9 @@
 ;; each entry is (tai seconds since epoch . # seconds to subtract for utc)
 ;; note they go higher to lower, and end in 1972.
 (define leap-second-table
-  '((1136073600 . 33)
+  '((1341100800 . 35)
+    (1230768000 . 34)
+    (1136073600 . 33)
     (915148800 . 32)
     (867715200 . 31)
     (820454400 . 30)

module/system/base/types.scm

@@ -0,0 +1,529 @@
+;;; 'SCM' type tag decoding.
+;;; Copyright (C) 2014 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (system base types)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-60)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 vlist)
+  #:use-module (system foreign)
+  #:export (%word-size
+
+            memory-backend
+            memory-backend?
+            %ffi-memory-backend
+            dereference-word
+            memory-port
+            type-number->name
+
+            inferior-object?
+            inferior-object-kind
+            inferior-object-sub-kind
+            inferior-object-address
+
+            inferior-fluid?
+            inferior-fluid-number
+
+            inferior-struct?
+            inferior-struct-name
+            inferior-struct-fields
+
+            scm->object))
+
+;;; Commentary:
+;;;
+;;; 'SCM' type tag decoding, primarily to support Guile debugging in GDB.
+;;;
+;;; Code:
+
+
+;;;
+;;; Memory back-ends.
+;;;
+
+(define %word-size
+  ;; The pointer size.
+  (sizeof '*))
+
+(define-record-type <memory-backend>
+  (memory-backend peek open type-name)
+  memory-backend?
+  (peek      memory-backend-peek)
+  (open      memory-backend-open)
+  (type-name memory-backend-type-name))           ; for SMOBs and ports
+
+(define %ffi-memory-backend
+  ;; The FFI back-end to access the current process's memory.  The main
+  ;; purpose of this back-end is to allow testing.
+  (let ()
+    (define (dereference-word address)
+      (let* ((ptr (make-pointer address))
+             (bv  (pointer->bytevector ptr %word-size)))
+        (bytevector-uint-ref bv 0 (native-endianness) %word-size)))
+
+    (define (open address size)
+      (define current-address address)
+
+      (define (read-memory! bv index count)
+        (let* ((ptr   (make-pointer current-address))
+               (mem   (pointer->bytevector ptr count)))
+          (bytevector-copy! mem 0 bv index count)
+          (set! current-address (+ current-address count))
+          count))
+
+      (if size
+          (let* ((ptr (make-pointer address))
+                 (bv  (pointer->bytevector ptr size)))
+            (open-bytevector-input-port bv))
+          (let ((port (make-custom-binary-input-port "ffi-memory"
+                                                     read-memory!
+                                                     #f #f #f)))
+            (setvbuf port _IONBF)
+            port)))
+
+    (memory-backend dereference-word open #f)))
+
+(define-inlinable (dereference-word backend address)
+  "Return the word at ADDRESS, using BACKEND."
+  (let ((peek (memory-backend-peek backend)))
+    (peek address)))
+
+(define-syntax memory-port
+  (syntax-rules ()
+    "Return an input port to the SIZE bytes at ADDRESS, using BACKEND.  When
+SIZE is omitted, return an unbounded port to the memory at ADDRESS."
+    ((_ backend address)
+     (let ((open (memory-backend-open backend)))
+       (open address #f)))
+    ((_ backend address size)
+     (let ((open (memory-backend-open backend)))
+       (open address size)))))
+
+(define (get-word port)
+  "Read a word from PORT and return it as an integer."
+  (let ((bv (get-bytevector-n port %word-size)))
+    (bytevector-uint-ref bv 0 (native-endianness) %word-size)))
+
+(define-inlinable (type-number->name backend kind number)
+  "Return the name of the type NUMBER of KIND, where KIND is one of
+'smob or 'port, or #f if the information is unavailable."
+  (let ((proc (memory-backend-type-name backend)))
+    (and proc (proc kind number))))
+
+
+;;;
+;;; Matching bit patterns and cells.
+;;;
+
+(define-syntax match-cell-words
+  (syntax-rules (bytevector)
+    ((_ port ((bytevector name len) rest ...) body)
+     (let ((name      (get-bytevector-n port len))
+           (remainder (modulo len %word-size)))
+       (unless (zero? remainder)
+         (get-bytevector-n port (- %word-size remainder)))
+       (match-cell-words port (rest ...) body)))
+    ((_ port (name rest ...) body)
+     (let ((name (get-word port)))
+       (match-cell-words port (rest ...) body)))
+    ((_ port () body)
+     body)))
+
+(define-syntax match-bit-pattern
+  (syntax-rules (& || = _)
+    ((match-bit-pattern bits ((a || b) & n = c) consequent alternate)
+     (let ((tag (logand bits n)))
+       (if (= tag c)
+           (let ((b tag)
+                 (a (logand bits (bitwise-not n))))
+             consequent)
+           alternate)))
+    ((match-bit-pattern bits (x & n = c) consequent alternate)
+     (let ((tag (logand bits n)))
+       (if (= tag c)
+           (let ((x bits))
+             consequent)
+           alternate)))
+    ((match-bit-pattern bits (_ & n = c) consequent alternate)
+     (let ((tag (logand bits n)))
+       (if (= tag c)
+           consequent
+           alternate)))
+    ((match-bit-pattern bits ((a << n) || c) consequent alternate)
+     (let ((tag (bitwise-and bits (- (expt 2 n) 1))))
+       (if (= tag c)
+           (let ((a (arithmetic-shift bits (- n))))
+             consequent)
+           alternate)))))
+
+(define-syntax match-cell-clauses
+  (syntax-rules ()
+    ((_ port tag (((tag-pattern thing ...) body) rest ...))
+     (match-bit-pattern tag tag-pattern
+                        (match-cell-words port (thing ...) body)
+                        (match-cell-clauses port tag (rest ...))))
+    ((_ port tag ())
+     (inferior-object 'unmatched-tag tag))))
+
+(define-syntax match-cell
+  (syntax-rules ()
+    "Match a cell---i.e., a non-immediate value other than a pair.  The
+cell's contents are read from PORT."
+    ((_ port (pattern body ...) ...)
+     (let ((port* port)
+           (tag   (get-word port)))
+       (match-cell-clauses port* tag
+                           ((pattern (begin body ...))
+                            ...))))))
+
+(define-syntax match-scm-clauses
+  (syntax-rules ()
+    ((_ bits
+        (bit-pattern body ...)
+        rest ...)
+     (match-bit-pattern bits bit-pattern
+                        (begin body ...)
+                        (match-scm-clauses bits rest ...)))
+    ((_ bits)
+     'unmatched-scm)))
+
+(define-syntax match-scm
+  (syntax-rules ()
+    "Match BITS, an integer representation of an 'SCM' value, against
+CLAUSES.  Each clause must have the form:
+
+  (PATTERN BODY ...)
+
+PATTERN is a bit pattern that may specify bitwise operations on BITS to
+determine if it matches.  TEMPLATE specify the name of the variable to bind
+the matching bits, possibly with bitwise operations to extract it from BITS."
+    ((_ bits clauses ...)
+     (let ((bits* bits))
+       (match-scm-clauses bits* clauses ...)))))
+
+
+;;;
+;;; Tags---keep in sync with libguile/tags.h!
+;;;
+
+;; Immediate values.
+(define %tc2-int 2)
+(define %tc3-imm24 4)
+
+(define %tc3-cons 0)
+(define %tc3-int1 %tc2-int)
+(define %tc3-int2 (+ %tc2-int 4))
+
+(define %tc8-char (+ 8 %tc3-imm24))
+(define %tc8-flag (+ %tc3-imm24 0))
+
+;; Cell types.
+(define %tc3-struct 1)
+(define %tc7-symbol 5)
+(define %tc7-vector 13)
+(define %tc7-wvect 15)
+(define %tc7-string 21)
+(define %tc7-number 23)
+(define %tc7-hashtable 29)
+(define %tc7-pointer 31)
+(define %tc7-fluid 37)
+(define %tc7-stringbuf 39)
+(define %tc7-dynamic-state 45)
+(define %tc7-frame 47)
+(define %tc7-program 69)
+(define %tc7-vm-continuation 71)
+(define %tc7-bytevector 77)
+(define %tc7-weak-set 85)
+(define %tc7-weak-table 87)
+(define %tc7-array 93)
+(define %tc7-bitvector 95)
+(define %tc7-port 125)
+(define %tc7-smob 127)
+
+(define %tc16-bignum (+ %tc7-number (* 1 256)))
+(define %tc16-real (+ %tc7-number (* 2 256)))
+(define %tc16-complex (+ %tc7-number (* 3 256)))
+(define %tc16-fraction (+ %tc7-number (* 4 256)))
+
+
+;; "Stringbufs".
+(define-record-type <stringbuf>
+  (stringbuf string)
+  stringbuf?
+  (string stringbuf-contents))
+
+(set-record-type-printer! <stringbuf>
+                          (lambda (stringbuf port)
+                            (display "#<stringbuf " port)
+                            (write (stringbuf-contents stringbuf) port)
+                            (display "#>" port)))
+
+;; Structs.
+(define-record-type <inferior-struct>
+  (inferior-struct name fields)
+  inferior-struct?
+  (name   inferior-struct-name)
+  (fields inferior-struct-fields set-inferior-struct-fields!))
+
+(define print-inferior-struct
+  (let ((%printed-struct (make-parameter vlist-null)))
+    (lambda (struct port)
+      (if (vhash-assq struct (%printed-struct))
+          (format port "#-1#")
+          (begin
+            (format port "#<struct ~a"
+                    (inferior-struct-name struct))
+            (parameterize ((%printed-struct
+                            (vhash-consq struct #t (%printed-struct))))
+              (for-each (lambda (field)
+                          (if (eq? field struct)
+                              (display " #0#" port)
+                              (format port " ~s" field)))
+                        (inferior-struct-fields struct)))
+            (format port " ~x>" (object-address struct)))))))
+
+(set-record-type-printer! <inferior-struct> print-inferior-struct)
+
+;; Fluids.
+(define-record-type <inferior-fluid>
+  (inferior-fluid number value)
+  inferior-fluid?
+  (number inferior-fluid-number)
+  (value  inferior-fluid-value))
+
+(set-record-type-printer! <inferior-fluid>
+                          (lambda (fluid port)
+                            (match fluid
+                              (($ <inferior-fluid> number)
+                               (format port "#<fluid ~a ~x>"
+                                       number
+                                       (object-address fluid))))))
+
+;; Object type to represent complex objects from the inferior process that
+;; cannot be really converted to usable Scheme objects in the current
+;; process.
+(define-record-type <inferior-object>
+  (%inferior-object kind sub-kind address)
+  inferior-object?
+  (kind     inferior-object-kind)
+  (sub-kind inferior-object-sub-kind)
+  (address  inferior-object-address))
+
+(define inferior-object
+  (case-lambda
+    "Return an object representing an inferior object at ADDRESS, of type
+KIND/SUB-KIND."
+    ((kind address)
+     (%inferior-object kind #f address))
+    ((kind sub-kind address)
+     (%inferior-object kind sub-kind address))))
+
+(set-record-type-printer! <inferior-object>
+                          (lambda (io port)
+                            (match io
+                              (($ <inferior-object> kind sub-kind address)
+                               (format port "#<~a ~:[~*~;~a ~]~x>"
+                                       kind sub-kind sub-kind
+                                       address)))))
+
+(define (inferior-smob backend type-number address)
+  "Return an object representing the SMOB at ADDRESS whose type is
+TYPE-NUMBER."
+  (inferior-object 'smob
+                   (or (type-number->name backend 'smob type-number)
+                       type-number)
+                   address))
+
+(define (inferior-port backend type-number address)
+  "Return an object representing the port at ADDRESS whose type is
+TYPE-NUMBER."
+  (inferior-object 'port
+                   (or (type-number->name backend 'port type-number)
+                       type-number)
+                   address))
+
+(define %visited-cells
+  ;; Vhash of mapping addresses of already visited cells to the
+  ;; corresponding inferior object.  This is used to detect and represent
+  ;; cycles.
+  (make-parameter vlist-null))
+
+(define-syntax visited
+  (syntax-rules (->)
+    ((_ (address -> object) body ...)
+     (parameterize ((%visited-cells (vhash-consv address object
+                                                 (%visited-cells))))
+       body ...))))
+
+(define (address->inferior-struct address vtable-data-address backend)
+  "Read the struct at ADDRESS using BACKEND.  Return an 'inferior-struct'
+object representing it."
+  (define %vtable-layout-index 0)
+  (define %vtable-name-index 5)
+
+  (let* ((layout-address (+ vtable-data-address
+                            (* %vtable-layout-index %word-size)))
+         (layout-bits    (dereference-word backend layout-address))
+         (layout         (scm->object layout-bits backend))
+         (name-address   (+ vtable-data-address
+                            (* %vtable-name-index %word-size)))
+         (name-bits      (dereference-word backend name-address))
+         (name           (scm->object name-bits backend)))
+    (if (symbol? layout)
+        (let* ((layout (symbol->string layout))
+               (len    (/ (string-length layout) 2))
+               (slots  (dereference-word backend (+ address %word-size)))
+               (port   (memory-port backend slots (* len %word-size)))
+               (fields (get-bytevector-n port (* len %word-size)))
+               (result (inferior-struct name #f)))
+
+          ;; Keep track of RESULT so callees can refer to it if we are
+          ;; decoding a circular struct.
+          (visited (address -> result)
+            (let ((values (map (cut scm->object <> backend)
+                               (bytevector->uint-list fields
+                                                      (native-endianness)
+                                                      %word-size))))
+              (set-inferior-struct-fields! result values)
+              result)))
+        (inferior-object 'invalid-struct address))))
+
+(define* (cell->object address #:optional (backend %ffi-memory-backend))
+  "Return an object representing the object at ADDRESS, reading from memory
+using BACKEND."
+  (or (and=> (vhash-assv address (%visited-cells)) cdr) ; circular object
+      (let ((port (memory-port backend address)))
+        (match-cell port
+          (((vtable-data-address & 7 = %tc3-struct))
+           (address->inferior-struct address
+                                     (- vtable-data-address %tc3-struct)
+                                     backend))
+          (((_ & #x7f = %tc7-symbol) buf hash props)
+           (match (cell->object buf backend)
+             (($ <stringbuf> string)
+              (string->symbol string))))
+          (((_ & #x7f = %tc7-string) buf start len)
+           (match (cell->object buf backend)
+             (($ <stringbuf> string)
+              (substring string start (+ start len)))))
+          (((_ & #x047f = %tc7-stringbuf) len (bytevector buf len))
+           (stringbuf (bytevector->string buf "ISO-8859-1")))
+          (((_ & #x047f = (bitwise-ior #x400 %tc7-stringbuf))
+            len (bytevector buf (* 4 len)))
+           (stringbuf (bytevector->string buf (match (native-endianness)
+                                                ('little "UTF-32LE")
+                                                ('big "UTF-32BE")))))
+          (((_ & #x7f = %tc7-bytevector) len address)
+           (let ((bv-port (memory-port backend address len)))
+             (get-bytevector-all bv-port)))
+          ((((len << 8) || %tc7-vector))
+           (let ((words  (get-bytevector-n port (* len %word-size)))
+                 (vector (make-vector len)))
+             (visited (address -> vector)
+               (fold (lambda (element index)
+                       (vector-set! vector index element)
+                       (+ 1 index))
+                     0
+                     (map (cut scm->object <> backend)
+                          (bytevector->uint-list words (native-endianness)
+                                                 %word-size)))
+               vector)))
+          (((_ & #x7f = %tc7-wvect))
+           (inferior-object 'weak-vector address))   ; TODO: show elements
+          ((((n << 8) || %tc7-fluid) init-value)
+           (inferior-fluid n #f))                    ; TODO: show current value
+          (((_ & #x7f = %tc7-dynamic-state))
+           (inferior-object 'dynamic-state address))
+          ((((flags+type << 8) || %tc7-port))
+           (inferior-port backend (logand flags+type #xff) address))
+          (((_ & #x7f = %tc7-program))
+           (inferior-object 'program address))
+          (((_ & #xffff = %tc16-bignum))
+           (inferior-object 'bignum address))
+          (((_ & #xffff = %tc16-real) pad)
+           (let* ((address (+ address (* 2 %word-size)))
+                  (port    (memory-port backend address (sizeof double)))
+                  (words   (get-bytevector-n port (sizeof double))))
+             (bytevector-ieee-double-ref words 0 (native-endianness))))
+          (((_ & #x7f = %tc7-number) mpi)
+           (inferior-object 'number address))
+          (((_ & #x7f = %tc7-hashtable) buckets meta-data unused)
+           (inferior-object 'hash-table address))
+          (((_ & #x7f = %tc7-pointer) address)
+           (make-pointer address))
+          (((_ & #x7f = %tc7-vm-continuation))
+           (inferior-object 'vm-continuation address))
+          (((_ & #x7f = %tc7-weak-set))
+           (inferior-object 'weak-set address))
+          (((_ & #x7f = %tc7-weak-table))
+           (inferior-object 'weak-table address))
+          (((_ & #x7f = %tc7-array))
+           (inferior-object 'array address))
+          (((_ & #x7f = %tc7-bitvector))
+           (inferior-object 'bitvector address))
+          ((((smob-type << 8) || %tc7-smob) word1)
+           (inferior-smob backend smob-type address))))))
+
+
+(define* (scm->object bits #:optional (backend %ffi-memory-backend))
+  "Return the Scheme object corresponding to BITS, the bits of an 'SCM'
+object."
+  (match-scm bits
+    (((integer << 2) || %tc2-int)
+     integer)
+    ((address & 6 = %tc3-cons)
+     (let* ((type  (dereference-word backend address))
+            (pair? (not (bit-set? 0 type))))
+       (if pair?
+           (or (and=> (vhash-assv address (%visited-cells)) cdr)
+               (let ((car    type)
+                     (cdrloc (+ address %word-size))
+                     (pair   (cons *unspecified* *unspecified*)))
+                 (visited (address -> pair)
+                   (set-car! pair (scm->object car backend))
+                   (set-cdr! pair
+                             (scm->object (dereference-word backend cdrloc)
+                                          backend))
+                   pair)))
+           (cell->object address backend))))
+    (((char << 8) || %tc8-char)
+     (integer->char char))
+    (((flag << 8) || %tc8-flag)
+     (case flag
+       ((0)  #f)
+       ((1)  #nil)
+       ((3)  '())
+       ((4)  #t)
+       ((8)  (if #f #f))
+       ((9)  (inferior-object 'undefined bits))
+       ((10) (eof-object))
+       ((11) (inferior-object 'unbound bits))))))
+
+;;; Local Variables:
+;;; eval: (put 'match-scm 'scheme-indent-function 1)
+;;; eval: (put 'match-cell 'scheme-indent-function 1)
+;;; eval: (put 'visited 'scheme-indent-function 1)
+;;; End:
+
+;;; types.scm ends here

module/system/repl/coop-server.scm

@@ -0,0 +1,193 @@
+;;; Cooperative REPL server
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Code:
+
+(define-module (system repl coop-server)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 threads)
+  #:use-module (ice-9 q)
+  #:use-module (srfi srfi-9)
+  #:use-module ((system repl repl)
+                #:select (start-repl* prompting-meta-read))
+  #:use-module ((system repl server)
+                #:select (run-server* make-tcp-server-socket
+                                      add-open-socket! close-socket!))
+  #:export (spawn-coop-repl-server
+            poll-coop-repl-server))
+
+(define-record-type <coop-repl-server>
+  (%make-coop-repl-server mutex queue)
+  coop-repl-server?
+  (mutex coop-repl-server-mutex)
+  (queue coop-repl-server-queue))
+
+(define (make-coop-repl-server)
+  (%make-coop-repl-server (make-mutex) (make-q)))
+
+(define (coop-repl-server-eval coop-server opcode . args)
+  "Queue a new instruction with the symbolic name OPCODE and an arbitrary
+number of arguments, to be processed the next time COOP-SERVER is polled."
+  (with-mutex (coop-repl-server-mutex coop-server)
+    (enq! (coop-repl-server-queue coop-server)
+          (cons opcode args))))
+
+(define-record-type <coop-repl>
+  (%make-coop-repl mutex condvar thunk cont)
+  coop-repl?
+  (mutex coop-repl-mutex)
+  (condvar coop-repl-condvar)  ; signaled when thunk becomes non-#f
+  (thunk coop-repl-read-thunk set-coop-repl-read-thunk!)
+  (cont coop-repl-cont set-coop-repl-cont!))
+
+(define (make-coop-repl)
+  (%make-coop-repl (make-mutex) (make-condition-variable) #f #f))
+
+(define (coop-repl-read coop-repl)
+  "Read an expression via the thunk stored in COOP-REPL."
+  (let ((thunk
+         (with-mutex (coop-repl-mutex coop-repl)
+           (unless (coop-repl-read-thunk coop-repl)
+             (wait-condition-variable (coop-repl-condvar coop-repl)
+                                      (coop-repl-mutex coop-repl)))
+           (let ((thunk (coop-repl-read-thunk coop-repl)))
+             (unless thunk
+               (error "coop-repl-read: condvar signaled, but thunk is #f!"))
+             (set-coop-repl-read-thunk! coop-repl #f)
+             thunk))))
+    (thunk)))
+
+(define (store-repl-cont cont coop-repl)
+  "Save the partial continuation CONT within COOP-REPL."
+  (set-coop-repl-cont! coop-repl
+                       (lambda (exp)
+                         (coop-repl-prompt
+                          (lambda () (cont exp))))))
+
+(define (coop-repl-prompt thunk)
+  "Apply THUNK within a prompt for cooperative REPLs."
+  (call-with-prompt 'coop-repl-prompt thunk store-repl-cont))
+
+(define (make-coop-reader coop-repl)
+  "Return a new procedure for reading user input from COOP-REPL.  The
+generated procedure passes the responsibility of reading input to
+another thread and aborts the cooperative REPL prompt."
+  (lambda (repl)
+    (let ((read-thunk
+           ;; Need to preserve the REPL stack and current module across
+           ;; threads.
+           (let ((stack (fluid-ref *repl-stack*))
+                 (module (current-module)))
+             (lambda ()
+               (with-fluids ((*repl-stack* stack))
+                 (set-current-module module)
+                 (prompting-meta-read repl))))))
+      (with-mutex (coop-repl-mutex coop-repl)
+        (when (coop-repl-read-thunk coop-repl)
+          (error "coop-reader: read-thunk is not #f!"))
+        (set-coop-repl-read-thunk! coop-repl read-thunk)
+        (signal-condition-variable (coop-repl-condvar coop-repl))))
+    (abort-to-prompt 'coop-repl-prompt coop-repl)))
+
+(define (reader-loop coop-server coop-repl)
+  "Run an unbounded loop that reads an expression for COOP-REPL and
+stores the expression within COOP-SERVER for later evaluation."
+  (coop-repl-server-eval coop-server 'eval coop-repl
+                         (coop-repl-read coop-repl))
+  (reader-loop coop-server coop-repl))
+
+(define (poll-coop-repl-server coop-server)
+  "Poll the cooperative REPL server COOP-SERVER and apply a pending
+operation if there is one, such as evaluating an expression typed at the
+REPL prompt.  This procedure must be called from the same thread that
+called spawn-coop-repl-server."
+  (let ((op (with-mutex (coop-repl-server-mutex coop-server)
+              (let ((queue (coop-repl-server-queue coop-server)))
+                (and (not (q-empty? queue))
+                     (deq! queue))))))
+    (when op
+      (match op
+        (('new-repl client)
+         (start-repl-client coop-server client))
+        (('eval coop-repl exp)
+         ((coop-repl-cont coop-repl) exp))))
+    *unspecified*))
+
+(define (start-coop-repl coop-server)
+  "Start a new cooperative REPL process for COOP-SERVER."
+  ;; Calling stop-server-and-clients! from a REPL will cause an
+  ;; exception to be thrown when trying to read from the socket that has
+  ;; been closed, so we catch that here.
+  (false-if-exception
+   (let ((coop-repl (make-coop-repl)))
+     (make-thread reader-loop coop-server coop-repl)
+     (start-repl* (current-language) #f (make-coop-reader coop-repl)))))
+
+(define (run-coop-repl-server coop-server server-socket)
+  "Start the cooperative REPL server for COOP-SERVER using the socket
+SERVER-SOCKET."
+  (run-server* server-socket (make-coop-client-proc coop-server)))
+
+(define* (spawn-coop-repl-server
+          #:optional (server-socket (make-tcp-server-socket)))
+  "Create and return a new cooperative REPL server object, and spawn a
+new thread to listen for connections on SERVER-SOCKET.  Proper
+functioning of the REPL server requires that poll-coop-repl-server be
+called periodically on the returned server object."
+  (let ((coop-server (make-coop-repl-server)))
+    (make-thread run-coop-repl-server
+                 coop-server
+                 server-socket)
+    coop-server))
+
+(define (make-coop-client-proc coop-server)
+  "Return a new procedure that is used to schedule the creation of a new
+cooperative REPL for COOP-SERVER."
+  (lambda (client addr)
+    (coop-repl-server-eval coop-server 'new-repl client)))
+
+(define (start-repl-client coop-server client)
+  "Run a cooperative REPL for COOP-SERVER within a prompt.  All input
+and output is sent over the socket CLIENT."
+
+  ;; Add the client to the list of open sockets, with a 'force-close'
+  ;; procedure that closes the underlying file descriptor.  We do it
+  ;; this way because we cannot close the port itself safely from
+  ;; another thread.
+  (add-open-socket! client (lambda () (close-fdes (fileno client))))
+
+  (with-continuation-barrier
+   (lambda ()
+     (coop-repl-prompt
+      (lambda ()
+        (parameterize ((current-input-port client)
+                       (current-output-port client)
+                       (current-error-port client)
+                       (current-warning-port client))
+          (with-fluids ((*repl-stack* '()))
+            (save-module-excursion
+             (lambda ()
+               (start-coop-repl coop-server)))))
+
+        ;; This may fail if 'stop-server-and-clients!' is called,
+        ;; because the 'force-close' procedure above closes the
+        ;; underlying file descriptor instead of the port itself.
+        (false-if-exception
+         (close-socket! client)))))))

module/system/repl/repl.scm

@@ -1,6 +1,7 @@
 ;;; Read-Eval-Print Loop
 
-;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2013,
+;;   2014 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
@@ -107,6 +108,8 @@
 ;; to be able to re-use the existing readline machinery.
 ;;
 ;; Catches read errors, returning *unspecified* in that case.
+;;
+;; Note: although not exported, this is used by (system repl coop-server)
 (define (prompting-meta-read repl)
   (catch #t
     (lambda ()
@@ -129,10 +132,14 @@
 ;;;
 
 (define* (start-repl #:optional (lang (current-language)) #:key debug)
+  (start-repl* lang debug prompting-meta-read))
+
+;; Note: although not exported, this is used by (system repl coop-server)
+(define (start-repl* lang debug prompting-meta-read)
   ;; ,language at the REPL will update the current-language.  Make
   ;; sure that it does so in a new dynamic scope.
   (parameterize ((current-language lang))
-    (run-repl (make-repl lang debug))))
+    (run-repl* (make-repl lang debug) prompting-meta-read)))
 
 ;; (put 'abort-on-error 'scheme-indent-function 1)
 (define-syntax-rule (abort-on-error string exp)
@@ -144,6 +151,9 @@
       (abort))))
 
 (define (run-repl repl)
+  (run-repl* repl prompting-meta-read))
+
+(define (run-repl* repl prompting-meta-read)
   (define (with-stack-and-prompt thunk)
     (call-with-prompt (default-prompt-tag)
                       (lambda () (start-stack #t (thunk)))

module/system/repl/server.scm

@@ -22,34 +22,45 @@
 (define-module (system repl server)
   #:use-module (system repl repl)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:export (make-tcp-server-socket
             make-unix-domain-server-socket
             run-server
             spawn-server
             stop-server-and-clients!))
 
+;; List of pairs of the form (SOCKET . FORCE-CLOSE), where SOCKET is a
+;; socket port, and FORCE-CLOSE is a thunk that forcefully shuts down
+;; the socket.
 (define *open-sockets* '())
 
 (define sockets-lock (make-mutex))
 
+;; WARNING: it is unsafe to call 'close-socket!' from another thread.
+;; Note: although not exported, this is used by (system repl coop-server)
 (define (close-socket! s)
   (with-mutex sockets-lock
-    (set! *open-sockets* (delq! s *open-sockets*)))
+    (set! *open-sockets* (assq-remove! *open-sockets* s)))
   ;; Close-port could block or raise an exception flushing buffered
   ;; output.  Hmm.
   (close-port s))
 
-(define (add-open-socket! s)
+;; Note: although not exported, this is used by (system repl coop-server)
+(define (add-open-socket! s force-close)
   (with-mutex sockets-lock
-    (set! *open-sockets* (cons s *open-sockets*))))
+    (set! *open-sockets* (acons s force-close *open-sockets*))))
 
 (define (stop-server-and-clients!)
   (cond
    ((with-mutex sockets-lock
-      (and (pair? *open-sockets*)
+      (match *open-sockets*
-           (car *open-sockets*)))
+        (() #f)
-    => (lambda (s)
+        (((s . force-close) . rest)
-         (close-socket! s)
+         (set! *open-sockets* rest)
+         force-close)))
+    => (lambda (force-close)
+         (force-close)
          (stop-server-and-clients!)))))
 
 (define* (make-tcp-server-socket #:key
@@ -67,37 +78,82 @@
     (bind sock AF_UNIX path)
     sock))
 
+;; List of errno values from 'select' or 'accept' that should lead to a
+;; retry in 'run-server'.
+(define errs-to-retry
+  (delete-duplicates
+   (filter-map (lambda (name)
+                 (and=> (module-variable the-root-module name)
+                        variable-ref))
+               '(EINTR EAGAIN EWOULDBLOCK))))
+
 (define* (run-server #:optional (server-socket (make-tcp-server-socket)))
+  (run-server* server-socket serve-client))
+
+;; Note: although not exported, this is used by (system repl coop-server)
+(define (run-server* server-socket serve-client)
+  ;; We use a pipe to notify the server when it should shut down.
+  (define shutdown-pipes      (pipe))
+  (define shutdown-read-pipe  (car shutdown-pipes))
+  (define shutdown-write-pipe (cdr shutdown-pipes))
+
+  ;; 'shutdown-server' is called by 'stop-server-and-clients!'.
+  (define (shutdown-server)
+    (display #\!  shutdown-write-pipe)
+    (force-output shutdown-write-pipe))
+
+  (define monitored-ports
+    (list server-socket
+          shutdown-read-pipe))
+
   (define (accept-new-client)
     (catch #t
-      (lambda () (accept server-socket))
+      (lambda ()
-      (lambda (k . args)
+        (let ((ready-ports (car (select monitored-ports '() '()))))
-        (cond
+          ;; If we've been asked to shut down, return #f.
-         ((port-closed? server-socket)
+          (and (not (memq shutdown-read-pipe ready-ports))
-          ;; Shutting down.
+               (accept server-socket))))
-          #f)
+      (lambda k-args
-         (else
+        (let ((err (system-error-errno k-args)))
-          (warn "Error accepting client" k args)
+          (cond
-          ;; Retry after a timeout.
+           ((memv err errs-to-retry)
-          (sleep 1)
+            (accept-new-client))
-          (accept-new-client))))))
+           (else
-  
+            (warn "Error accepting client" k-args)
+            ;; Retry after a timeout.
+            (sleep 1)
+            (accept-new-client)))))))
+
+  ;; Put the socket into non-blocking mode.
+  (fcntl server-socket F_SETFL
+         (logior O_NONBLOCK
+                 (fcntl server-socket F_GETFL)))
+
   (sigaction SIGPIPE SIG_IGN)
-  (add-open-socket! server-socket)
+  (add-open-socket! server-socket shutdown-server)
   (listen server-socket 5)
   (let lp ((client (accept-new-client)))
     ;; If client is false, we are shutting down.
     (if client
         (let ((client-socket (car client))
               (client-addr (cdr client)))
-          (add-open-socket! client-socket)
           (make-thread serve-client client-socket client-addr)
-          (lp (accept-new-client))))))
+          (lp (accept-new-client)))
+        (begin (close shutdown-write-pipe)
+               (close shutdown-read-pipe)
+               (close server-socket)))))
 
 (define* (spawn-server #:optional (server-socket (make-tcp-server-socket)))
   (make-thread run-server server-socket))
 
 (define (serve-client client addr)
+
+  (let ((thread (current-thread)))
+    ;; Close the socket when this thread exits, even if canceled.
+    (set-thread-cleanup! thread (lambda () (close-socket! client)))
+    ;; Arrange to cancel this thread to forcefully shut down the socket.
+    (add-open-socket! client (lambda () (cancel-thread thread))))
+
   (with-continuation-barrier
    (lambda ()
      (parameterize ((current-input-port client)
@@ -105,5 +161,4 @@
                     (current-error-port client)
                     (current-warning-port client))
        (with-fluids ((*repl-stack* '()))
-         (start-repl)))))
+         (start-repl))))))
-  (close-socket! client))

test-suite/Makefile.am

@@ -36,12 +36,17 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/chars.test			\
 	    tests/coding.test			\
 	    tests/common-list.test		\
+	    tests/compiler.test			\
 	    tests/control.test			\
 	    tests/continuations.test		\
 	    tests/coverage.test			\
 	    tests/cross-compilation.test	\
 	    tests/curried-definitions.test	\
 	    tests/dwarf.test			\
+	    tests/encoding-escapes.test		\
+	    tests/encoding-iso88591.test	\
+	    tests/encoding-iso88597.test	\
+	    tests/encoding-utf8.test		\
 	    tests/ecmascript.test		\
 	    tests/elisp.test			\
 	    tests/elisp-compiler.test		\
@@ -77,6 +82,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/numbers.test			\
 	    tests/optargs.test			\
 	    tests/options.test			\
+	    tests/pairs.test			\
 	    tests/parameters.test		\
 	    tests/peg.test			\
 	    tests/peval.test			\
@@ -113,12 +119,14 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/random.test			\
 	    tests/rdelim.test			\
 	    tests/reader.test			\
+	    tests/records.test			\
 	    tests/receive.test			\
 	    tests/regexp.test			\
 	    tests/rtl.test			\
 	    tests/rtl-compilation.test		\
 	    tests/session.test			\
 	    tests/signals.test			\
+	    tests/sort.test			\
 	    tests/srcprop.test			\
 	    tests/srfi-1.test			\
 	    tests/srfi-6.test			\
@@ -126,6 +134,8 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/srfi-11.test			\
 	    tests/srfi-13.test			\
 	    tests/srfi-14.test			\
+	    tests/srfi-17.test			\
+	    tests/srfi-18.test			\
 	    tests/srfi-19.test			\
 	    tests/srfi-26.test			\
 	    tests/srfi-27.test			\
@@ -144,11 +154,13 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/srfi-67.test			\
 	    tests/srfi-69.test			\
 	    tests/srfi-88.test			\
+	    tests/srfi-98.test			\
 	    tests/srfi-105.test			\
 	    tests/srfi-111.test			\
 	    tests/srfi-4.test			\
 	    tests/srfi-9.test			\
 	    tests/statprof.test			\
+	    tests/streams.test			\
 	    tests/strings.test			\
 	    tests/structs.test			\
 	    tests/sxml.fold.test		\
@@ -167,9 +179,12 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/threads.test			\
 	    tests/time.test			\
 	    tests/tree-il.test			\
+	    tests/types.test			\
 	    tests/version.test			\
+	    tests/vectors.test			\
 	    tests/vlist.test			\
 	    tests/weaks.test			\
+	    tests/web-client.test		\
 	    tests/web-http.test			\
 	    tests/web-request.test		\
 	    tests/web-response.test		\

test-suite/guile-test

@@ -239,9 +239,10 @@
                  (lambda ()
                    (for-each (lambda (test)
                                (display (string-append "Running " test "\n"))
-                               (with-locale "C"
+                               (when (defined? 'setlocale)
-                                 (with-test-prefix test
+                                 (setlocale LC_ALL "C"))
-                                   (load (test-file-name test)))))
+                               (with-test-prefix test
+                                 (load (test-file-name test))))
                              tests))))
             (if (opt 'coverage #f)
                 (let-values (((coverage-data _)
@@ -263,5 +264,4 @@
 
 ;;; Local Variables:
 ;;; mode: scheme
-;;; eval: (put 'with-locale 'scheme-indent-function 1)
 ;;; End:

test-suite/standalone/Makefile.am

@@ -139,7 +139,7 @@ TESTS += test-list
 # test-unwind
 test_unwind_SOURCES = test-unwind.c
 test_unwind_CFLAGS = ${test_cflags}
-test_unwind_LDADD = $(LIBGUILE_LDADD)
+test_unwind_LDADD = $(LIBGUILE_LDADD) $(top_builddir)/lib/libgnu.la
 check_PROGRAMS += test-unwind
 TESTS += test-unwind
 
@@ -211,6 +211,13 @@ test_scm_c_bind_keyword_arguments_LDADD = $(LIBGUILE_LDADD)
 check_PROGRAMS += test-scm-c-bind-keyword-arguments
 TESTS += test-scm-c-bind-keyword-arguments
 
+# test-srfi-4
+test_srfi_4_SOURCES = test-srfi-4.c
+test_srfi_4_CFLAGS = ${test_cflags}
+test_srfi_4_LDADD = $(LIBGUILE_LDADD)
+check_PROGRAMS += test-srfi-4
+TESTS += test-srfi-4
+
 if HAVE_SHARED_LIBRARIES
 
 # test-extensions

test-suite/standalone/test-loose-ends.c

@@ -3,7 +3,7 @@
  * Test items of the Guile C API that aren't covered by any other tests.
  */
 
-/* Copyright (C) 2009, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2012, 2014 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
@@ -25,6 +25,8 @@
 # include <config.h>
 #endif
 
+#undef NDEBUG
+
 #include <libguile.h>
 
 #include <stdio.h>

test-suite/standalone/test-num2integral.c

@@ -1,5 +1,5 @@
 /* Copyright (C) 1999, 2000, 2001, 2003, 2004, 2006, 2008, 2010, 2011
- *   2012 Free Software Foundation, Inc.
+ *   2012, 2014 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
@@ -21,6 +21,8 @@
 # include <config.h>
 #endif
 
+#undef NDEBUG
+
 #include <libguile.h>
 
 #include <stdio.h>

test-suite/standalone/test-round.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2004, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2004, 2006, 2008, 2009, 2011, 2014 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
@@ -20,6 +20,8 @@
 # include <config.h>
 #endif
 
+#undef NDEBUG
+
 #include <assert.h>
 #include <math.h>
 #include <stdio.h>

test-suite/standalone/test-scm-c-bind-keyword-arguments.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2013, 2014 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
@@ -20,6 +20,8 @@
 # include <config.h>
 #endif
 
+#undef NDEBUG
+
 #include <libguile.h>
 
 #include <assert.h>

test-suite/standalone/test-scm-c-read.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2008, 2014 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
@@ -23,6 +23,8 @@
 # include <config.h>
 #endif
 
+#undef NDEBUG
+
 #include <libguile.h>
 #include <assert.h>
 

test-suite/standalone/test-scm-values.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2012, 2014 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
@@ -20,6 +20,8 @@
 # include <config.h>
 #endif
 
+#undef NDEBUG
+
 #include <assert.h>
 #include <libguile.h>
 #include <stdlib.h>

test-suite/standalone/test-smob-mark.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2013, 2014 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
@@ -20,6 +20,8 @@
 #include <config.h>
 #endif
 
+#undef NDEBUG
+
 #include <assert.h>
 #include <libguile.h>
 #include <stdio.h>

test-suite/standalone/test-srfi-4.c

@@ -0,0 +1,90 @@
+/* Copyright (C) 2014 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+/* Make sure the assertions are tested.  */
+#undef NDEBUG
+
+#include <libguile.h>
+
+#include <stdio.h>
+#include <assert.h>
+
+static void
+test_writable_elements ()
+{
+  SCM elts = scm_list_4 (scm_from_int (1), scm_from_int (2),
+                         scm_from_int (3), scm_from_int (4));
+
+  {
+    SCM v = scm_u32vector (elts);
+    size_t len;
+    ssize_t inc;
+    scm_t_array_handle h;
+    scm_t_uint32 *elts = scm_u32vector_writable_elements (v, &h, &len, &inc);
+    assert (len == 4);
+    assert (inc == 1);
+    assert (elts[0] == 1);
+    assert (elts[3] == 4);
+    scm_array_handle_release (&h);
+  }
+
+  {
+    SCM v = scm_f32vector (elts);
+    size_t len;
+    ssize_t inc;
+    scm_t_array_handle h;
+    float *elts = scm_f32vector_writable_elements (v, &h, &len, &inc);
+    assert (len == 4);
+    assert (inc == 1);
+    assert (elts[0] == 1.0);
+    assert (elts[3] == 4.0);
+    scm_array_handle_release (&h);
+  }
+
+  {
+    SCM v = scm_c32vector (elts);
+    size_t len;
+    ssize_t inc;
+    scm_t_array_handle h;
+    float *elts = scm_c32vector_writable_elements (v, &h, &len, &inc);
+    assert (len == 4);
+    assert (inc == 1);
+    assert (elts[0] == 1.0);
+    assert (elts[1] == 0.0);
+    assert (elts[6] == 4.0);
+    assert (elts[7] == 0.0);
+    scm_array_handle_release (&h);
+  }
+}
+
+static void
+tests (void *data, int argc, char **argv)
+{
+  test_writable_elements ();
+}
+
+int
+main (int argc, char *argv[])
+{
+  scm_boot_guile (argc, argv, tests, NULL);
+  return 0;
+}

test-suite/tests/format.test

@@ -24,6 +24,22 @@
   #:use-module (ice-9 format))
 
 
+(with-test-prefix "simple-format"
+  (pass-if-exception "current-output-port is closed"
+      exception:wrong-type-arg
+    ;; This used to segfault in Guile <= 2.0.10.
+    (let ((old (current-output-port))
+          (new (%make-void-port "w")))
+      (dynamic-wind
+        (lambda ()
+          (set-current-output-port new)
+          (close-port new))
+        (lambda ()
+          (simple-format #t "hello, closed port!")
+          #t)
+        (lambda ()
+          (set-current-output-port old))))))
+
 ;;; FORMAT Basic Output
 
 (with-test-prefix "format basic output"