summaryrefslogtreecommitdiff
path: root/recipes/guile
diff options
context:
space:
mode:
authorKoen Kooi <koen@openembedded.org>2010-08-16 20:23:18 +0200
committerKoen Kooi <koen@openembedded.org>2010-08-16 20:24:02 +0200
commita28f286e2ec88292af40a55a25a4157722a3c898 (patch)
treed69f05d25edf32eadb2a05c1628455ab352ae396 /recipes/guile
parenta55666696bc695b8221bf3e4079c7497fcb636d0 (diff)
guile 1.8.7: sync up with the 1.8 release branch
Diffstat (limited to 'recipes/guile')
-rw-r--r--recipes/guile/guile-1.8.7/18.diff1743
-rw-r--r--recipes/guile/guile_1.8.7.bb3
2 files changed, 1746 insertions, 0 deletions
diff --git a/recipes/guile/guile-1.8.7/18.diff b/recipes/guile/guile-1.8.7/18.diff
new file mode 100644
index 0000000000..9c9eefb09b
--- /dev/null
+++ b/recipes/guile/guile-1.8.7/18.diff
@@ -0,0 +1,1743 @@
+diff --git a/LICENSE b/LICENSE
+index 213e34a..dda451e 100644
+--- a/LICENSE
++++ b/LICENSE
+@@ -1,2 +1,2 @@
+ Guile is covered under the terms of the GNU Lesser General Public
+-License, version 2.1. See COPYING.LESSER.
++License, version 2.1 or later. See COPYING.LESSER.
+diff --git a/NEWS b/NEWS
+index 0dcc411..564484f 100644
+--- a/NEWS
++++ b/NEWS
+@@ -5,6 +5,19 @@ See the end for copying conditions.
+ Please send Guile bug reports to bug-guile@gnu.org.
+
+
++Changes in 1.8.8 (since 1.8.7)
++
++* Bugs fixed
++
++** Fix possible buffer overruns when parsing numbers
++** Avoid clash with system setjmp/longjmp on IA64
++** Don't dynamically link an extension that is already registered
++** Fix `wrong type arg' exceptions with IPv6 addresses
++** Fix typos in `(srfi srfi-19)'
++** Have `(srfi srfi-35)' provide named struct vtables
++** Fix some Interix build problems
++
++
+ Changes in 1.8.7 (since 1.8.6)
+
+ * Bugs fixed
+diff --git a/THANKS b/THANKS
+index 47d3cfa..48a105a 100644
+--- a/THANKS
++++ b/THANKS
+@@ -50,6 +50,7 @@ For fixes or providing information which led to a fix:
+ Roland Haeder
+ Sven Hartrumpf
+ Eric Hanchrow
++ Judy Hawkins
+ Sam Hocevar
+ Patrick Horgan
+ Ales Hvezda
+@@ -64,12 +65,15 @@ For fixes or providing information which led to a fix:
+ Matthias Köppe
+ Matt Kraai
+ Daniel Kraft
++ Jay Krell
+ Jeff Long
+ Marco Maggi
+ Gregory Marton
++ Kjetil S. Matheussen
+ Antoine Mathys
+ Dan McMahill
+ Roger Mc Murtrie
++ Scott McPeak
+ Tim Mooney
+ Han-Wen Nienhuys
+ Jan Nieuwenhuizen
+diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
+index 9aeb08a..f6393db 100644
+--- a/doc/ref/api-modules.texi
++++ b/doc/ref/api-modules.texi
+@@ -758,7 +758,7 @@ Record definition with @code{define-record-type} (@pxref{SRFI-9}).
+ Read hash extension @code{#,()} (@pxref{SRFI-10}).
+
+ @item (srfi srfi-11)
+-Multiple-value handling with @code{let-values} and @code{let-values*}
++Multiple-value handling with @code{let-values} and @code{let*-values}
+ (@pxref{SRFI-11}).
+
+ @item (srfi srfi-13)
+diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
+index 7c17b36..3d9cde4 100644
+--- a/doc/ref/guile.texi
++++ b/doc/ref/guile.texi
+@@ -13,8 +13,8 @@ This reference manual documents Guile, GNU's Ubiquitous Intelligent
+ Language for Extensions. This is edition @value{MANUAL-EDITION}
+ corresponding to Guile @value{VERSION}.
+
+-Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005 Free
+-Software Foundation.
++Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
++2007, 2008, 2009, 2010 Free Software Foundation.
+
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.2 or
+diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
+index 1cb273a..0a7e342 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -2310,8 +2310,8 @@ Convert a network address from an integer to a printable string.
+
+ @lisp
+ (inet-ntop AF_INET 2130706433) @result{} "127.0.0.1"
+-(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}
+-ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff
++(inet-ntop AF_INET6 (- (expt 2 128) 1))
++ @result{} "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"
+ @end lisp
+ @end deffn
+
+@@ -2882,8 +2882,8 @@ same as @code{make-socket-address} would take to make such an object
+ (@pxref{Network Socket Address}). The return value is unspecified.
+
+ @example
+-(connect sock AF_INET INADDR_LOCALHOST 23)
+-(connect sock (make-socket-address AF_INET INADDR_LOCALHOST 23))
++(connect sock AF_INET INADDR_LOOPBACK 23)
++(connect sock (make-socket-address AF_INET INADDR_LOOPBACK 23))
+ @end example
+ @end deffn
+
+diff --git a/ice-9/debugging/ice-9-debugger-extensions.scm b/ice-9/debugging/ice-9-debugger-extensions.scm
+index a8b8c97..fe04fc0 100644
+--- a/ice-9/debugging/ice-9-debugger-extensions.scm
++++ b/ice-9/debugging/ice-9-debugger-extensions.scm
+@@ -39,7 +39,8 @@
+ (else
+ (define-module (ice-9 debugger))))
+
+-(use-modules (ice-9 debugging steps))
++(use-modules (ice-9 debugging steps)
++ (ice-9 debugging trace))
+
+ (define (assert-continuable state)
+ ;; Check that debugger is in a state where `continuing' makes sense.
+diff --git a/libguile/__scm.h b/libguile/__scm.h
+index b198f9d..e75f1a9 100644
+--- a/libguile/__scm.h
++++ b/libguile/__scm.h
+@@ -3,7 +3,7 @@
+ #ifndef SCM___SCM_H
+ #define SCM___SCM_H
+
+-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008 Free Software Foundation, Inc.
++/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008, 2010 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
+@@ -359,11 +359,9 @@
+ #define SCM_T_INT32_MIN SCM_I_TYPE_MIN(scm_t_int32,SCM_T_UINT32_MAX)
+ #define SCM_T_INT32_MAX SCM_I_TYPE_MAX(scm_t_int32,SCM_T_UINT32_MAX)
+
+-#if SCM_HAVE_T_INT64
+ #define SCM_T_UINT64_MAX SCM_I_UTYPE_MAX(scm_t_uint64)
+ #define SCM_T_INT64_MIN SCM_I_TYPE_MIN(scm_t_int64,SCM_T_UINT64_MAX)
+ #define SCM_T_INT64_MAX SCM_I_TYPE_MAX(scm_t_int64,SCM_T_UINT64_MAX)
+-#endif
+
+ #if SCM_SIZEOF_LONG_LONG
+ #define SCM_I_ULLONG_MAX SCM_I_UTYPE_MAX(unsigned long long)
+@@ -409,19 +407,28 @@
+ typedef struct {
+ ucontext_t ctx;
+ int fresh;
+- } jmp_buf;
+-# define setjmp(JB) \
++ } scm_i_jmp_buf;
++# define SCM_I_SETJMP(JB) \
+ ( (JB).fresh = 1, \
+ getcontext (&((JB).ctx)), \
+ ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
+-# define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
+- void scm_ia64_longjmp (jmp_buf *, int);
++# define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
++ void scm_ia64_longjmp (scm_i_jmp_buf *, int);
+ # else /* ndef __ia64__ */
+ # include <setjmp.h>
+ # endif /* ndef __ia64__ */
+ # endif /* ndef _CRAY1 */
+ #endif /* ndef vms */
+
++/* For any platform where SCM_I_SETJMP hasn't been defined in some
++ special way above, map SCM_I_SETJMP, SCM_I_LONGJMP and
++ scm_i_jmp_buf to setjmp, longjmp and jmp_buf. */
++#ifndef SCM_I_SETJMP
++#define scm_i_jmp_buf jmp_buf
++#define SCM_I_SETJMP setjmp
++#define SCM_I_LONGJMP longjmp
++#endif
++
+ /* James Clark came up with this neat one instruction fix for
+ * continuations on the SPARC. It flushes the register windows so
+ * that all the state of the process is contained in the stack.
+diff --git a/libguile/continuations.c b/libguile/continuations.c
+index 69d2569..84a7fed 100644
+--- a/libguile/continuations.c
++++ b/libguile/continuations.c
+@@ -127,7 +127,7 @@ scm_make_continuation (int *first)
+ continuation->offset = continuation->stack - src;
+ memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
+
+- *first = !setjmp (continuation->jmpbuf);
++ *first = !SCM_I_SETJMP (continuation->jmpbuf);
+ if (*first)
+ {
+ #ifdef __ia64__
+@@ -224,12 +224,12 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
+ scm_i_set_last_debug_frame (continuation->dframe);
+
+ continuation->throw_value = val;
+- longjmp (continuation->jmpbuf, 1);
++ SCM_I_LONGJMP (continuation->jmpbuf, 1);
+ }
+
+ #ifdef __ia64__
+ void
+-scm_ia64_longjmp (jmp_buf *JB, int VAL)
++scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
+ {
+ scm_i_thread *t = SCM_I_CURRENT_THREAD;
+
+diff --git a/libguile/continuations.h b/libguile/continuations.h
+index f6fb96a..c61ab2d 100644
+--- a/libguile/continuations.h
++++ b/libguile/continuations.h
+@@ -43,7 +43,7 @@ SCM_API scm_t_bits scm_tc16_continuation;
+ typedef struct
+ {
+ SCM throw_value;
+- jmp_buf jmpbuf;
++ scm_i_jmp_buf jmpbuf;
+ SCM dynenv;
+ #ifdef __ia64__
+ void *backing_store;
+diff --git a/libguile/extensions.c b/libguile/extensions.c
+index 1090b8b..29cb58c 100644
+--- a/libguile/extensions.c
++++ b/libguile/extensions.c
+@@ -76,6 +76,7 @@ load_extension (SCM lib, SCM init)
+ {
+ extension_t *ext;
+ char *clib, *cinit;
++ int found = 0;
+
+ scm_dynwind_begin (0);
+
+@@ -89,10 +90,14 @@ load_extension (SCM lib, SCM init)
+ && !strcmp (ext->init, cinit))
+ {
+ ext->func (ext->data);
++ found = 1;
+ break;
+ }
+
+ scm_dynwind_end ();
++
++ if (found)
++ return;
+ }
+
+ /* Dynamically link the library. */
+diff --git a/libguile/filesys.c b/libguile/filesys.c
+index 70dfe15..c8acb13 100644
+--- a/libguile/filesys.c
++++ b/libguile/filesys.c
+@@ -23,6 +23,9 @@
+ #ifdef __hpux
+ #define _POSIX_C_SOURCE 199506L /* for readdir_r */
+ #endif
++#if defined(__INTERIX) && !defined(_REENTRANT)
++# define _REENTRANT /* ask Interix for readdir_r prototype */
++#endif
+
+ #ifdef HAVE_CONFIG_H
+ # include <config.h>
+diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
+index 85ebfae..e5de31d 100644
+--- a/libguile/gen-scmconfig.c
++++ b/libguile/gen-scmconfig.c
+@@ -315,28 +315,10 @@ main (int argc, char *argv[])
+ return 1;
+
+ pf ("\n");
+- pf ("/* 64-bit integer -- if available SCM_HAVE_T_INT64 will be 1 and\n"
+- " scm_t_int64 will be a suitable type, otherwise SCM_HAVE_T_INT64\n"
+- " will be 0. */\n");
+- if (SCM_I_GSC_T_INT64)
+- {
+- pf ("#define SCM_HAVE_T_INT64 1 /* 0 or 1 */\n");
+- pf ("typedef %s scm_t_int64;\n", SCM_I_GSC_T_INT64);
+- }
+- else
+- pf ("#define SCM_HAVE_T_INT64 0 /* 0 or 1 */\n");
+-
+- pf ("\n");
+- pf ("/* 64-bit unsigned integer -- if available SCM_HAVE_T_UINT64 will\n"
+- " be 1 and scm_t_uint64 will be a suitable type, otherwise\n"
+- " SCM_HAVE_T_UINT64 will be 0. */\n");
+- if (SCM_I_GSC_T_UINT64)
+- {
+- pf ("#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */\n");
+- pf ("typedef %s scm_t_uint64;\n", SCM_I_GSC_T_UINT64);
+- }
+- else
+- pf ("#define SCM_HAVE_T_UINT64 0 /* 0 or 1 */\n");
++ pf ("#define SCM_HAVE_T_INT64 1 /* 0 or 1 */\n");
++ pf ("typedef %s scm_t_int64;\n", SCM_I_GSC_T_INT64);
++ pf ("#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */\n");
++ pf ("typedef %s scm_t_uint64;\n", SCM_I_GSC_T_UINT64);
+
+ pf ("\n");
+ pf ("/* scm_t_ptrdiff_t and size, always defined -- defined to long if\n"
+diff --git a/libguile/hashtab.c b/libguile/hashtab.c
+index ea7fc69..1f1569c 100644
+--- a/libguile/hashtab.c
++++ b/libguile/hashtab.c
+@@ -1,4 +1,4 @@
+-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
++/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2010 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
+@@ -911,74 +911,6 @@ SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0,
+
+ /* Hash table iterators */
+
+-static const char s_scm_hash_fold[];
+-
+-SCM
+-scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
+-{
+- long i, n;
+- SCM buckets, result = init;
+-
+- if (SCM_HASHTABLE_P (table))
+- buckets = SCM_HASHTABLE_VECTOR (table);
+- else
+- buckets = table;
+-
+- n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
+- for (i = 0; i < n; ++i)
+- {
+- SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
+- while (!scm_is_null (ls))
+- {
+- if (!scm_is_pair (ls))
+- scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
+- handle = SCM_CAR (ls);
+- if (!scm_is_pair (handle))
+- scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
+- result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
+- ls = SCM_CDR (ls);
+- }
+- }
+-
+- return result;
+-}
+-
+-/* The following redundant code is here in order to be able to support
+- hash-for-each-handle. An alternative would have been to replace
+- this code and scm_internal_hash_fold above with a single
+- scm_internal_hash_fold_handles, but we don't want to promote such
+- an API. */
+-
+-static const char s_scm_hash_for_each[];
+-
+-void
+-scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table)
+-{
+- long i, n;
+- SCM buckets;
+-
+- if (SCM_HASHTABLE_P (table))
+- buckets = SCM_HASHTABLE_VECTOR (table);
+- else
+- buckets = table;
+-
+- n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
+- for (i = 0; i < n; ++i)
+- {
+- SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
+- while (!scm_is_null (ls))
+- {
+- if (!scm_is_pair (ls))
+- scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
+- handle = SCM_CAR (ls);
+- if (!scm_is_pair (handle))
+- scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
+- fn (closure, handle);
+- ls = SCM_CDR (ls);
+- }
+- }
+-}
+-
+ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
+ (SCM proc, SCM init, SCM table),
+ "An iterator over hash-table elements.\n"
+@@ -1067,6 +999,72 @@ SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 0, 0,
+
+
+
++SCM
++scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
++{
++ long i, n;
++ SCM buckets, result = init;
++
++ if (SCM_HASHTABLE_P (table))
++ buckets = SCM_HASHTABLE_VECTOR (table);
++ else
++ buckets = table;
++
++ n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
++ for (i = 0; i < n; ++i)
++ {
++ SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
++ while (!scm_is_null (ls))
++ {
++ if (!scm_is_pair (ls))
++ scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
++ handle = SCM_CAR (ls);
++ if (!scm_is_pair (handle))
++ scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
++ result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
++ ls = SCM_CDR (ls);
++ }
++ }
++
++ return result;
++}
++
++/* The following redundant code is here in order to be able to support
++ hash-for-each-handle. An alternative would have been to replace
++ this code and scm_internal_hash_fold above with a single
++ scm_internal_hash_fold_handles, but we don't want to promote such
++ an API. */
++
++void
++scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table)
++{
++ long i, n;
++ SCM buckets;
++
++ if (SCM_HASHTABLE_P (table))
++ buckets = SCM_HASHTABLE_VECTOR (table);
++ else
++ buckets = table;
++
++ n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
++ for (i = 0; i < n; ++i)
++ {
++ SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
++ while (!scm_is_null (ls))
++ {
++ if (!scm_is_pair (ls))
++ scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
++ handle = SCM_CAR (ls);
++ if (!scm_is_pair (handle))
++ scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
++ fn (closure, handle);
++ ls = SCM_CDR (ls);
++ }
++ }
++}
++
++
++
+
+ void
+ scm_hashtab_prehistory ()
+diff --git a/libguile/iselect.h b/libguile/iselect.h
+index 5a4b30d..b23a641 100644
+--- a/libguile/iselect.h
++++ b/libguile/iselect.h
+@@ -38,7 +38,12 @@
+ #ifdef FD_SET
+
+ #define SELECT_TYPE fd_set
++#if defined(__INTERIX) && FD_SETSIZE == 4096
++/* Interix defines FD_SETSIZE 4096 but select rejects that. */
++#define SELECT_SET_SIZE 1024
++#else
+ #define SELECT_SET_SIZE FD_SETSIZE
++#endif
+
+ #else /* no FD_SET */
+
+diff --git a/libguile/numbers.c b/libguile/numbers.c
+index 2e1635f..4f5ab31 100644
+--- a/libguile/numbers.c
++++ b/libguile/numbers.c
+@@ -1,4 +1,4 @@
+-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
++/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+ *
+ * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
+ * and Bellcore. See scm_divide.
+@@ -620,7 +620,14 @@ guile_ieee_init (void)
+ #elif HAVE_DINFINITY
+ /* OSF */
+ extern unsigned int DINFINITY[2];
+- guile_Inf = (*((double *) (DINFINITY)));
++ union
++ {
++ double d;
++ int i[2];
++ } alias;
++ alias.i[0] = DINFINITY[0];
++ alias.i[1] = DINFINITY[1];
++ guile_Inf = alias.d;
+ #else
+ double tmp = 1e+10;
+ guile_Inf = tmp;
+@@ -651,7 +658,14 @@ guile_ieee_init (void)
+ {
+ /* OSF */
+ extern unsigned int DQNAN[2];
+- guile_NaN = (*((double *)(DQNAN)));
++ union
++ {
++ double d;
++ int i[2];
++ } alias;
++ alias.i[0] = DQNAN[0];
++ alias.i[1] = DQNAN[1];
++ guile_NaN = alias.d;
+ }
+ #else
+ guile_NaN = guile_Inf / guile_Inf;
+@@ -2663,17 +2677,26 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
+ case 'l': case 'L':
+ case 's': case 'S':
+ idx++;
++ if (idx == len)
++ return SCM_BOOL_F;
++
+ start = idx;
+ c = mem[idx];
+ if (c == '-')
+ {
+ idx++;
++ if (idx == len)
++ return SCM_BOOL_F;
++
+ sign = -1;
+ c = mem[idx];
+ }
+ else if (c == '+')
+ {
+ idx++;
++ if (idx == len)
++ return SCM_BOOL_F;
++
+ sign = 1;
+ c = mem[idx];
+ }
+@@ -2789,8 +2812,10 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
+ SCM divisor;
+
+ idx++;
++ if (idx == len)
++ return SCM_BOOL_F;
+
+- divisor = mem2uinteger (mem, len, &idx, radix, &x);
++ divisor = mem2uinteger (mem, len, &idx, radix, &x);
+ if (scm_is_false (divisor))
+ return SCM_BOOL_F;
+
+@@ -2911,11 +2936,15 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
+ if (c == '+')
+ {
+ idx++;
++ if (idx == len)
++ return SCM_BOOL_F;
+ sign = 1;
+ }
+ else if (c == '-')
+ {
+ idx++;
++ if (idx == len)
++ return SCM_BOOL_F;
+ sign = -1;
+ }
+ else
+@@ -5869,8 +5898,6 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
+ #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint32 (arg)
+ #include "libguile/conv-uinteger.i.c"
+
+-#if SCM_HAVE_T_INT64
+-
+ #define TYPE scm_t_int64
+ #define TYPE_MIN SCM_T_INT64_MIN
+ #define TYPE_MAX SCM_T_INT64_MAX
+@@ -5887,8 +5914,6 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
+ #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint64 (arg)
+ #include "libguile/conv-uinteger.i.c"
+
+-#endif
+-
+ void
+ scm_to_mpz (SCM val, mpz_t rop)
+ {
+diff --git a/libguile/numbers.h b/libguile/numbers.h
+index 2c2fdcf..35263a4 100644
+--- a/libguile/numbers.h
++++ b/libguile/numbers.h
+@@ -3,7 +3,7 @@
+ #ifndef SCM_NUMBERS_H
+ #define SCM_NUMBERS_H
+
+-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006 Free Software Foundation, Inc.
++/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2010 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
+@@ -321,16 +321,12 @@ SCM_API SCM scm_from_int32 (scm_t_int32 x);
+ SCM_API scm_t_uint32 scm_to_uint32 (SCM x);
+ SCM_API SCM scm_from_uint32 (scm_t_uint32 x);
+
+-#if SCM_HAVE_T_INT64
+-
+ SCM_API scm_t_int64 scm_to_int64 (SCM x);
+ SCM_API SCM scm_from_int64 (scm_t_int64 x);
+
+ SCM_API scm_t_uint64 scm_to_uint64 (SCM x);
+ SCM_API SCM scm_from_uint64 (scm_t_uint64 x);
+
+-#endif
+-
+ SCM_API void scm_to_mpz (SCM x, mpz_t rop);
+ SCM_API SCM scm_from_mpz (mpz_t rop);
+
+diff --git a/libguile/random.c b/libguile/random.c
+index 8d2ff03..693ed4a 100644
+--- a/libguile/random.c
++++ b/libguile/random.c
+@@ -1,4 +1,4 @@
+-/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006 Free Software Foundation, Inc.
++/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 2010 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
+@@ -75,8 +75,6 @@ scm_t_rng scm_the_rng;
+ #define M_PI 3.14159265359
+ #endif
+
+-#if SCM_HAVE_T_UINT64
+-
+ unsigned long
+ scm_i_uniform32 (scm_t_i_rstate *state)
+ {
+@@ -87,38 +85,6 @@ scm_i_uniform32 (scm_t_i_rstate *state)
+ return w;
+ }
+
+-#else
+-
+-/* ww This is a portable version of the same RNG without 64 bit
+- * * aa arithmetic.
+- * ----
+- * xx It is only intended to provide identical behaviour on
+- * xx platforms without 8 byte longs or long longs until
+- * xx someone has implemented the routine in assembler code.
+- * xxcc
+- * ----
+- * ccww
+- */
+-
+-#define L(x) ((x) & 0xffff)
+-#define H(x) ((x) >> 16)
+-
+-unsigned long
+-scm_i_uniform32 (scm_t_i_rstate *state)
+-{
+- scm_t_uint32 x1 = L (A) * L (state->w);
+- scm_t_uint32 x2 = L (A) * H (state->w);
+- scm_t_uint32 x3 = H (A) * L (state->w);
+- scm_t_uint32 w = L (x1) + L (state->c);
+- scm_t_uint32 m = H (x1) + L (x2) + L (x3) + H (state->c) + H (w);
+- scm_t_uint32 x4 = H (A) * H (state->w);
+- state->w = w = (L (m) << 16) + L (w);
+- state->c = H (x2) + H (x3) + x4 + H (m);
+- return w;
+-}
+-
+-#endif
+-
+ void
+ scm_i_init_rstate (scm_t_i_rstate *state, const char *seed, int n)
+ {
+@@ -212,21 +178,49 @@ scm_c_exp1 (scm_t_rstate *state)
+
+ unsigned char scm_masktab[256];
+
+-unsigned long
+-scm_c_random (scm_t_rstate *state, unsigned long m)
++static inline scm_t_uint32
++scm_i_mask32 (scm_t_uint32 m)
+ {
+- unsigned int r, mask;
+- mask = (m < 0x100
++ return (m < 0x100
+ ? scm_masktab[m]
+ : (m < 0x10000
+ ? scm_masktab[m >> 8] << 8 | 0xff
+ : (m < 0x1000000
+ ? scm_masktab[m >> 16] << 16 | 0xffff
+ : scm_masktab[m >> 24] << 24 | 0xffffff)));
++}
++
++static scm_t_uint32
++scm_c_random32 (scm_t_rstate *state, scm_t_uint32 m)
++{
++ scm_t_uint32 r, mask = scm_i_mask32 (m);
+ while ((r = scm_the_rng.random_bits (state) & mask) >= m);
+ return r;
+ }
+
++/* Returns 32 random bits. */
++unsigned long
++scm_c_random (scm_t_rstate *state, unsigned long m)
++{
++ return scm_c_random32 (state, (scm_t_uint32)m);
++}
++
++scm_t_uint64
++scm_c_random64 (scm_t_rstate *state, scm_t_uint64 m)
++{
++ scm_t_uint64 r;
++ scm_t_uint32 mask;
++
++ if (m <= SCM_T_UINT32_MAX)
++ return scm_c_random32 (state, (scm_t_uint32) m);
++
++ mask = scm_i_mask32 (m >> 32);
++ while ((r = ((scm_t_uint64) (scm_the_rng.random_bits (state) & mask) << 32)
++ | scm_the_rng.random_bits (state)) >= m)
++ ;
++ return r;
++}
++
+ /*
+ SCM scm_c_random_bignum (scm_t_rstate *state, SCM m)
+
+@@ -247,24 +241,24 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
+ {
+ SCM result = scm_i_mkbig ();
+ const size_t m_bits = mpz_sizeinbase (SCM_I_BIG_MPZ (m), 2);
+- /* how many bits would only partially fill the last unsigned long? */
+- const size_t end_bits = m_bits % (sizeof (unsigned long) * SCM_CHAR_BIT);
+- unsigned long *random_chunks = NULL;
+- const unsigned long num_full_chunks =
+- m_bits / (sizeof (unsigned long) * SCM_CHAR_BIT);
+- const unsigned long num_chunks = num_full_chunks + ((end_bits) ? 1 : 0);
++ /* how many bits would only partially fill the last u32? */
++ const size_t end_bits = m_bits % (sizeof (scm_t_uint32) * SCM_CHAR_BIT);
++ scm_t_uint32 *random_chunks = NULL;
++ const scm_t_uint32 num_full_chunks =
++ m_bits / (sizeof (scm_t_uint32) * SCM_CHAR_BIT);
++ const scm_t_uint32 num_chunks = num_full_chunks + ((end_bits) ? 1 : 0);
+
+ /* we know the result will be this big */
+ mpz_realloc2 (SCM_I_BIG_MPZ (result), m_bits);
+
+ random_chunks =
+- (unsigned long *) scm_gc_calloc (num_chunks * sizeof (unsigned long),
++ (scm_t_uint32 *) scm_gc_calloc (num_chunks * sizeof (scm_t_uint32),
+ "random bignum chunks");
+
+ do
+ {
+- unsigned long *current_chunk = random_chunks + (num_chunks - 1);
+- unsigned long chunks_left = num_chunks;
++ scm_t_uint32 *current_chunk = random_chunks + (num_chunks - 1);
++ scm_t_uint32 chunks_left = num_chunks;
+
+ mpz_set_ui (SCM_I_BIG_MPZ (result), 0);
+
+@@ -273,23 +267,23 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
+ /* generate a mask with ones in the end_bits position, i.e. if
+ end_bits is 3, then we'd have a mask of ...0000000111 */
+ const unsigned long rndbits = scm_the_rng.random_bits (state);
+- int rshift = (sizeof (unsigned long) * SCM_CHAR_BIT) - end_bits;
+- unsigned long mask = ((unsigned long) ULONG_MAX) >> rshift;
+- unsigned long highest_bits = rndbits & mask;
++ int rshift = (sizeof (scm_t_uint32) * SCM_CHAR_BIT) - end_bits;
++ scm_t_uint32 mask = 0xffffffff >> rshift;
++ scm_t_uint32 highest_bits = ((scm_t_uint32) rndbits) & mask;
+ *current_chunk-- = highest_bits;
+ chunks_left--;
+ }
+
+ while (chunks_left)
+ {
+- /* now fill in the remaining unsigned long sized chunks */
++ /* now fill in the remaining scm_t_uint32 sized chunks */
+ *current_chunk-- = scm_the_rng.random_bits (state);
+ chunks_left--;
+ }
+ mpz_import (SCM_I_BIG_MPZ (result),
+ num_chunks,
+ -1,
+- sizeof (unsigned long),
++ sizeof (scm_t_uint32),
+ 0,
+ 0,
+ random_chunks);
+@@ -297,7 +291,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
+ all bits in order not to get a distorted distribution) */
+ } while (mpz_cmp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (m)) >= 0);
+ scm_gc_free (random_chunks,
+- num_chunks * sizeof (unsigned long),
++ num_chunks * sizeof (scm_t_uint32),
+ "random bignum chunks");
+ return scm_i_normbig (result);
+ }
+@@ -348,9 +342,17 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
+ SCM_VALIDATE_RSTATE (2, state);
+ if (SCM_I_INUMP (n))
+ {
+- unsigned long m = SCM_I_INUM (n);
+- SCM_ASSERT_RANGE (1, n, m > 0);
+- return scm_from_ulong (scm_c_random (SCM_RSTATE (state), m));
++ unsigned long m = (unsigned long) SCM_I_INUM (n);
++ SCM_ASSERT_RANGE (1, n, SCM_I_INUM (n) > 0);
++#if SCM_SIZEOF_UNSIGNED_LONG <= 4
++ return scm_from_uint32 (scm_c_random (SCM_RSTATE (state),
++ (scm_t_uint32) m));
++#elif SCM_SIZEOF_UNSIGNED_LONG <= 8
++ return scm_from_uint64 (scm_c_random64 (SCM_RSTATE (state),
++ (scm_t_uint64) m));
++#else
++#error "Cannot deal with this platform's unsigned long size"
++#endif
+ }
+ SCM_VALIDATE_NIM (1, n);
+ if (SCM_REALP (n))
+diff --git a/libguile/random.h b/libguile/random.h
+index 6ec43ff..0690b59 100644
+--- a/libguile/random.h
++++ b/libguile/random.h
+@@ -3,7 +3,7 @@
+ #ifndef SCM_RANDOM_H
+ #define SCM_RANDOM_H
+
+-/* Copyright (C) 1999,2000,2001, 2006 Free Software Foundation, Inc.
++/* Copyright (C) 1999,2000,2001, 2006, 2010 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
+@@ -45,6 +45,7 @@ typedef struct scm_t_rstate {
+
+ typedef struct scm_t_rng {
+ size_t rstate_size; /* size of random state */
++ /* Though this returns an unsigned long, it's only 32 bits of randomness. */
+ unsigned long (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */
+ void (*init_rstate) (scm_t_rstate *state, const char *seed, int n);
+ scm_t_rstate *(*copy_rstate) (scm_t_rstate *state);
+@@ -62,6 +63,7 @@ typedef struct scm_t_i_rstate {
+ unsigned long c;
+ } scm_t_i_rstate;
+
++/* Though this returns an unsigned long, it's only 32 bits of randomness. */
+ SCM_API unsigned long scm_i_uniform32 (scm_t_i_rstate *);
+ SCM_API void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n);
+ SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
+@@ -76,7 +78,10 @@ SCM_API scm_t_rstate *scm_c_default_rstate (void);
+ SCM_API double scm_c_uniform01 (scm_t_rstate *);
+ SCM_API double scm_c_normal01 (scm_t_rstate *);
+ SCM_API double scm_c_exp1 (scm_t_rstate *);
++/* Though this returns an unsigned long, it's only 32 bits of randomness. */
+ SCM_API unsigned long scm_c_random (scm_t_rstate *, unsigned long m);
++/* This one returns 64 bits of randomness. */
++SCM_API scm_t_uint64 scm_c_random64 (scm_t_rstate *state, scm_t_uint64 m);
+ SCM_API SCM scm_c_random_bignum (scm_t_rstate *, SCM m);
+
+
+diff --git a/libguile/socket.c b/libguile/socket.c
+index f34b6d4..cb954f4 100644
+--- a/libguile/socket.c
++++ b/libguile/socket.c
+@@ -347,7 +347,7 @@ scm_to_ipv6 (scm_t_uint8 dst[16], SCM src)
+ scm_remember_upto_here_1 (src);
+ }
+ else
+- scm_wrong_type_arg (NULL, 0, src);
++ scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src, "integer");
+ }
+
+ #ifdef HAVE_INET_PTON
+@@ -397,8 +397,8 @@ SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
+ "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
+ "@lisp\n"
+ "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
+- "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
+- "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
++ "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
++ " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
+ "@end lisp")
+ #define FUNC_NAME s_scm_inet_ntop
+ {
+@@ -1167,7 +1167,8 @@ scm_to_sockaddr (SCM address, size_t *address_size)
+ {
+ struct sockaddr_in6 c_inet6;
+
+- scm_to_ipv6 (c_inet6.sin6_addr.s6_addr, address);
++ scm_to_ipv6 (c_inet6.sin6_addr.s6_addr,
++ SCM_SIMPLE_VECTOR_REF (address, 1));
+ c_inet6.sin6_port =
+ htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
+ c_inet6.sin6_flowinfo =
+diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
+index b0e052a..f2a9d7f 100644
+--- a/libguile/srfi-4.c
++++ b/libguile/srfi-4.c
+@@ -1,6 +1,6 @@
+ /* srfi-4.c --- Uniform numeric vector datatypes.
+ *
+- * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
++ * Copyright (C) 2001, 2004, 2006, 2010 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
+@@ -84,11 +84,7 @@ static const int uvec_sizes[12] = {
+ 1, 1,
+ 2, 2,
+ 4, 4,
+-#if SCM_HAVE_T_INT64
+ 8, 8,
+-#else
+- sizeof (SCM), sizeof (SCM),
+-#endif
+ sizeof(float), sizeof(double),
+ 2*sizeof(float), 2*sizeof(double)
+ };
+@@ -127,10 +123,8 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
+ scm_t_int16 *s16;
+ scm_t_uint32 *u32;
+ scm_t_int32 *s32;
+-#if SCM_HAVE_T_INT64
+ scm_t_uint64 *u64;
+ scm_t_int64 *s64;
+-#endif
+ float *f32;
+ double *f64;
+ SCM *fake_64;
+@@ -148,13 +142,8 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
+ case SCM_UVEC_S16: np.s16 = (scm_t_int16 *) uptr; break;
+ case SCM_UVEC_U32: np.u32 = (scm_t_uint32 *) uptr; break;
+ case SCM_UVEC_S32: np.s32 = (scm_t_int32 *) uptr; break;
+-#if SCM_HAVE_T_INT64
+ case SCM_UVEC_U64: np.u64 = (scm_t_uint64 *) uptr; break;
+ case SCM_UVEC_S64: np.s64 = (scm_t_int64 *) uptr; break;
+-#else
+- case SCM_UVEC_U64:
+- case SCM_UVEC_S64: np.fake_64 = (SCM *) uptr; break;
+-#endif
+ case SCM_UVEC_F32: np.f32 = (float *) uptr; break;
+ case SCM_UVEC_F64: np.f64 = (double *) uptr; break;
+ case SCM_UVEC_C32: np.f32 = (float *) uptr; break;
+@@ -179,14 +168,8 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
+ case SCM_UVEC_S16: scm_intprint (*np.s16, 10, port); np.s16++; break;
+ case SCM_UVEC_U32: scm_uintprint (*np.u32, 10, port); np.u32++; break;
+ case SCM_UVEC_S32: scm_intprint (*np.s32, 10, port); np.s32++; break;
+-#if SCM_HAVE_T_INT64
+ case SCM_UVEC_U64: scm_uintprint (*np.u64, 10, port); np.u64++; break;
+ case SCM_UVEC_S64: scm_intprint (*np.s64, 10, port); np.s64++; break;
+-#else
+- case SCM_UVEC_U64:
+- case SCM_UVEC_S64: scm_iprin1 (*np.fake_64, port, pstate);
+- np.fake_64++; break;
+-#endif
+ case SCM_UVEC_F32: scm_i_print_double (*np.f32, port); np.f32++; break;
+ case SCM_UVEC_F64: scm_i_print_double (*np.f64, port); np.f64++; break;
+ case SCM_UVEC_C32:
+@@ -222,20 +205,6 @@ uvec_equalp (SCM a, SCM b)
+ result = SCM_BOOL_F;
+ else if (SCM_UVEC_LENGTH (a) != SCM_UVEC_LENGTH (b))
+ result = SCM_BOOL_F;
+-#if SCM_HAVE_T_INT64 == 0
+- else if (SCM_UVEC_TYPE (a) == SCM_UVEC_U64
+- || SCM_UVEC_TYPE (a) == SCM_UVEC_S64)
+- {
+- SCM *aptr = (SCM *)SCM_UVEC_BASE (a), *bptr = (SCM *)SCM_UVEC_BASE (b);
+- size_t len = SCM_UVEC_LENGTH (a), i;
+- for (i = 0; i < len; i++)
+- if (scm_is_false (scm_num_eq_p (*aptr++, *bptr++)))
+- {
+- result = SCM_BOOL_F;
+- break;
+- }
+- }
+-#endif
+ else if (memcmp (SCM_UVEC_BASE (a), SCM_UVEC_BASE (b),
+ SCM_UVEC_LENGTH (a) * uvec_sizes[SCM_UVEC_TYPE(a)]) != 0)
+ result = SCM_BOOL_F;
+@@ -244,24 +213,6 @@ uvec_equalp (SCM a, SCM b)
+ return result;
+ }
+
+-/* Mark hook. Only used when U64 and S64 are implemented as SCMs. */
+-
+-#if SCM_HAVE_T_INT64 == 0
+-static SCM
+-uvec_mark (SCM uvec)
+-{
+- if (SCM_UVEC_TYPE (uvec) == SCM_UVEC_U64
+- || SCM_UVEC_TYPE (uvec) == SCM_UVEC_S64)
+- {
+- SCM *ptr = (SCM *)SCM_UVEC_BASE (uvec);
+- size_t len = SCM_UVEC_LENGTH (uvec), i;
+- for (i = 0; i < len; i++)
+- scm_gc_mark (*ptr++);
+- }
+- return SCM_BOOL_F;
+-}
+-#endif
+-
+ /* Smob free hook for uniform numeric vectors. */
+ static size_t
+ uvec_free (SCM uvec)
+@@ -318,15 +269,6 @@ alloc_uvec (int type, size_t len)
+ if (len > SCM_I_SIZE_MAX / uvec_sizes[type])
+ scm_out_of_range (NULL, scm_from_size_t (len));
+ base = scm_gc_malloc (len * uvec_sizes[type], uvec_names[type]);
+-#if SCM_HAVE_T_INT64 == 0
+- if (type == SCM_UVEC_U64 || type == SCM_UVEC_S64)
+- {
+- SCM *ptr = (SCM *)base;
+- size_t i;
+- for (i = 0; i < len; i++)
+- *ptr++ = SCM_UNSPECIFIED;
+- }
+-#endif
+ return take_uvec (type, base, len);
+ }
+
+@@ -349,17 +291,10 @@ uvec_fast_ref (int type, const void *base, size_t c_idx)
+ return scm_from_uint32 (((scm_t_uint32*)base)[c_idx]);
+ else if (type == SCM_UVEC_S32)
+ return scm_from_int32 (((scm_t_int32*)base)[c_idx]);
+-#if SCM_HAVE_T_INT64
+ else if (type == SCM_UVEC_U64)
+ return scm_from_uint64 (((scm_t_uint64*)base)[c_idx]);
+ else if (type == SCM_UVEC_S64)
+ return scm_from_int64 (((scm_t_int64*)base)[c_idx]);
+-#else
+- else if (type == SCM_UVEC_U64)
+- return ((SCM *)base)[c_idx];
+- else if (type == SCM_UVEC_S64)
+- return ((SCM *)base)[c_idx];
+-#endif
+ else if (type == SCM_UVEC_F32)
+ return scm_from_double (((float*)base)[c_idx]);
+ else if (type == SCM_UVEC_F64)
+@@ -374,22 +309,6 @@ uvec_fast_ref (int type, const void *base, size_t c_idx)
+ return SCM_BOOL_F;
+ }
+
+-#if SCM_HAVE_T_INT64 == 0
+-static SCM scm_uint64_min, scm_uint64_max;
+-static SCM scm_int64_min, scm_int64_max;
+-
+-static void
+-assert_exact_integer_range (SCM val, SCM min, SCM max)
+-{
+- if (!scm_is_integer (val)
+- || scm_is_false (scm_exact_p (val)))
+- scm_wrong_type_arg_msg (NULL, 0, val, "exact integer");
+- if (scm_is_true (scm_less_p (val, min))
+- || scm_is_true (scm_gr_p (val, max)))
+- scm_out_of_range (NULL, val);
+-}
+-#endif
+-
+ static SCM_C_INLINE_KEYWORD void
+ uvec_fast_set_x (int type, void *base, size_t c_idx, SCM val)
+ {
+@@ -405,23 +324,10 @@ uvec_fast_set_x (int type, void *base, size_t c_idx, SCM val)
+ (((scm_t_uint32*)base)[c_idx]) = scm_to_uint32 (val);
+ else if (type == SCM_UVEC_S32)
+ (((scm_t_int32*)base)[c_idx]) = scm_to_int32 (val);
+-#if SCM_HAVE_T_INT64
+ else if (type == SCM_UVEC_U64)
+ (((scm_t_uint64*)base)[c_idx]) = scm_to_uint64 (val);
+ else if (type == SCM_UVEC_S64)
+ (((scm_t_int64*)base)[c_idx]) = scm_to_int64 (val);
+-#else
+- else if (type == SCM_UVEC_U64)
+- {
+- assert_exact_integer_range (val, scm_uint64_min, scm_uint64_max);
+- ((SCM *)base)[c_idx] = val;
+- }
+- else if (type == SCM_UVEC_S64)
+- {
+- assert_exact_integer_range (val, scm_int64_min, scm_int64_max);
+- ((SCM *)base)[c_idx] = val;
+- }
+-#endif
+ else if (type == SCM_UVEC_F32)
+ (((float*)base)[c_idx]) = scm_to_double (val);
+ else if (type == SCM_UVEC_F64)
+@@ -1027,16 +933,12 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0,
+
+ #define TYPE SCM_UVEC_U64
+ #define TAG u64
+-#if SCM_HAVE_T_UINT64
+ #define CTYPE scm_t_uint64
+-#endif
+ #include "libguile/srfi-4.i.c"
+
+ #define TYPE SCM_UVEC_S64
+ #define TAG s64
+-#if SCM_HAVE_T_INT64
+ #define CTYPE scm_t_int64
+-#endif
+ #include "libguile/srfi-4.i.c"
+
+ #define TYPE SCM_UVEC_F32
+@@ -1094,23 +996,9 @@ scm_init_srfi_4 (void)
+ {
+ scm_tc16_uvec = scm_make_smob_type ("uvec", 0);
+ scm_set_smob_equalp (scm_tc16_uvec, uvec_equalp);
+-#if SCM_HAVE_T_INT64 == 0
+- scm_set_smob_mark (scm_tc16_uvec, uvec_mark);
+-#endif
+ scm_set_smob_free (scm_tc16_uvec, uvec_free);
+ scm_set_smob_print (scm_tc16_uvec, uvec_print);
+
+-#if SCM_HAVE_T_INT64 == 0
+- scm_uint64_min =
+- scm_permanent_object (scm_from_int (0));
+- scm_uint64_max =
+- scm_permanent_object (scm_c_read_string ("18446744073709551615"));
+- scm_int64_min =
+- scm_permanent_object (scm_c_read_string ("-9223372036854775808"));
+- scm_int64_max =
+- scm_permanent_object (scm_c_read_string ("9223372036854775807"));
+-#endif
+-
+ #include "libguile/srfi-4.x"
+
+ }
+diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
+index 7abbac8..2348c5a 100644
+--- a/libguile/srfi-4.h
++++ b/libguile/srfi-4.h
+@@ -2,7 +2,7 @@
+ #define SCM_SRFI_4_H
+ /* srfi-4.c --- Homogeneous numeric vector datatypes.
+ *
+- * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
++ * Copyright (C) 2001, 2004, 2006, 2010 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
+@@ -186,7 +186,6 @@ SCM_API SCM scm_u64vector_to_list (SCM uvec);
+ SCM_API SCM scm_list_to_u64vector (SCM l);
+ SCM_API SCM scm_any_to_u64vector (SCM obj);
+
+-#if SCM_HAVE_T_UINT64
+ SCM_API SCM scm_take_u64vector (scm_t_uint64 *data, size_t n);
+ SCM_API const scm_t_uint64 *scm_array_handle_u64_elements (scm_t_array_handle *h);
+ SCM_API scm_t_uint64 *scm_array_handle_u64_writable_elements (scm_t_array_handle *h);
+@@ -198,7 +197,6 @@ SCM_API scm_t_uint64 *scm_u64vector_writable_elements (SCM uvec,
+ scm_t_array_handle *h,
+ size_t *lenp,
+ ssize_t *incp);
+-#endif
+
+ SCM_API SCM scm_s64vector_p (SCM obj);
+ SCM_API SCM scm_make_s64vector (SCM n, SCM fill);
+@@ -210,7 +208,6 @@ SCM_API SCM scm_s64vector_to_list (SCM uvec);
+ SCM_API SCM scm_list_to_s64vector (SCM l);
+ SCM_API SCM scm_any_to_s64vector (SCM obj);
+
+-#if SCM_HAVE_T_INT64
+ SCM_API SCM scm_take_s64vector (scm_t_int64 *data, size_t n);
+ SCM_API const scm_t_int64 *scm_array_handle_s64_elements (scm_t_array_handle *h);
+ SCM_API scm_t_int64 *scm_array_handle_s64_writable_elements (scm_t_array_handle *h);
+@@ -221,7 +218,6 @@ SCM_API scm_t_int64 *scm_s64vector_writable_elements (SCM uvec,
+ scm_t_array_handle *h,
+ size_t *lenp,
+ ssize_t *incp);
+-#endif
+
+ SCM_API SCM scm_f32vector_p (SCM obj);
+ SCM_API SCM scm_make_f32vector (SCM n, SCM fill);
+diff --git a/libguile/threads.c b/libguile/threads.c
+index 95a905c..f2bb556 100644
+--- a/libguile/threads.c
++++ b/libguile/threads.c
+@@ -276,7 +276,7 @@ unblock_from_queue (SCM queue)
+ var 't'
+ // save registers.
+ SCM_FLUSH_REGISTER_WINDOWS; // sparc only
+- setjmp (t->regs); // here's most of the magic
++ SCM_I_SETJMP (t->regs); // here's most of the magic
+
+ ... and returns.
+
+@@ -330,7 +330,7 @@ unblock_from_queue (SCM queue)
+ t->top = SCM_STACK_PTR (&t);
+ // save registers.
+ SCM_FLUSH_REGISTER_WINDOWS;
+- setjmp (t->regs);
++ SCM_I_SETJMP (t->regs);
+ res = func(data);
+ scm_enter_guile (t);
+
+@@ -388,7 +388,7 @@ suspend (void)
+ t->top = SCM_STACK_PTR (&t);
+ /* save registers. */
+ SCM_FLUSH_REGISTER_WINDOWS;
+- setjmp (t->regs);
++ SCM_I_SETJMP (t->regs);
+ return t;
+ }
+
+diff --git a/libguile/threads.h b/libguile/threads.h
+index 2b0e067..e22d9bd 100644
+--- a/libguile/threads.h
++++ b/libguile/threads.h
+@@ -107,7 +107,7 @@ typedef struct scm_i_thread {
+ /* For keeping track of the stack and registers. */
+ SCM_STACKITEM *base;
+ SCM_STACKITEM *top;
+- jmp_buf regs;
++ scm_i_jmp_buf regs;
+ #ifdef __ia64__
+ void *register_backing_store_base;
+ scm_t_contregs *pending_rbs_continuation;
+diff --git a/libguile/throw.c b/libguile/throw.c
+index 92c5a1a..fcfde47 100644
+--- a/libguile/throw.c
++++ b/libguile/throw.c
+@@ -53,7 +53,7 @@ static scm_t_bits tc16_jmpbuffer;
+ #define DEACTIVATEJB(x) \
+ (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L))))
+
+-#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
++#define JBJMPBUF(OBJ) ((scm_i_jmp_buf *) SCM_CELL_WORD_1 (OBJ))
+ #define SETJBJMPBUF(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v)))
+ #define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x))
+ #define SCM_SETJBDFRAME(x, v) (SCM_SET_CELL_WORD_2 ((x), (scm_t_bits) (v)))
+@@ -75,7 +75,7 @@ make_jmpbuf (void)
+ {
+ SCM answer;
+ SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0);
+- SETJBJMPBUF(answer, (jmp_buf *)0);
++ SETJBJMPBUF(answer, (scm_i_jmp_buf *)0);
+ DEACTIVATEJB(answer);
+ return answer;
+ }
+@@ -85,7 +85,7 @@ make_jmpbuf (void)
+
+ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
+ {
+- jmp_buf buf; /* must be first */
++ scm_i_jmp_buf buf; /* must be first */
+ SCM throw_tag;
+ SCM retval;
+ };
+@@ -179,7 +179,7 @@ scm_c_catch (SCM tag,
+ pre_unwind.lazy_catch_p = 0;
+ SCM_SETJBPREUNWIND(jmpbuf, &pre_unwind);
+
+- if (setjmp (jbr.buf))
++ if (SCM_I_SETJMP (jbr.buf))
+ {
+ SCM throw_tag;
+ SCM throw_args;
+@@ -821,7 +821,7 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
+ jbr->throw_tag = key;
+ jbr->retval = args;
+ scm_i_set_last_debug_frame (SCM_JBDFRAME (jmpbuf));
+- longjmp (*JBJMPBUF (jmpbuf), 1);
++ SCM_I_LONGJMP (*JBJMPBUF (jmpbuf), 1);
+ }
+
+ /* Otherwise, it's some random piece of junk. */
+diff --git a/libguile/vectors.c b/libguile/vectors.c
+index eeb8569..074655c 100644
+--- a/libguile/vectors.c
++++ b/libguile/vectors.c
+@@ -1,4 +1,4 @@
+-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
++/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2010 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
+@@ -465,7 +465,9 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
+
+ i = scm_to_unsigned_integer (start1, 0, len1);
+ e = scm_to_unsigned_integer (end1, i, len1);
+- j = scm_to_unsigned_integer (start2, 0, len2 - (i-e));
++ SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) < len2);
++ j = scm_to_unsigned_integer (start2, 0, len2);
++ SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
+
+ i *= inc1;
+ e *= inc1;
+@@ -503,7 +505,11 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
+
+ i = scm_to_unsigned_integer (start1, 0, len1);
+ e = scm_to_unsigned_integer (end1, i, len1);
+- j = scm_to_unsigned_integer (start2, 0, len2 - (i-e));
++ SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) < len2);
++ j = scm_to_unsigned_integer (start2, 0, len2);
++ SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
++
++ j += (e - i);
+
+ i *= inc1;
+ e *= inc1;
+diff --git a/scripts/snarf-check-and-output-texi b/scripts/snarf-check-and-output-texi
+index ea33e17..8cd42e8 100755
+--- a/scripts/snarf-check-and-output-texi
++++ b/scripts/snarf-check-and-output-texi
+@@ -267,6 +267,17 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
+ (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)))
+
+diff --git a/srfi/srfi-19.scm b/srfi/srfi-19.scm
+index ffce990..482ec4e 100644
+--- a/srfi/srfi-19.scm
++++ b/srfi/srfi-19.scm
+@@ -1,6 +1,6 @@
+ ;;; srfi-19.scm --- Time/Date Library
+
+-;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
++;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+ ;;
+ ;; This library is free software; you can redistribute it and/or
+ ;; modify it under the terms of the GNU Lesser General Public
+@@ -41,7 +41,8 @@
+ (define-module (srfi srfi-19)
+ :use-module (srfi srfi-6)
+ :use-module (srfi srfi-8)
+- :use-module (srfi srfi-9))
++ :use-module (srfi srfi-9)
++ :autoload (ice-9 rdelim) (read-line))
+
+ (begin-deprecated
+ ;; Prevent `export' from re-exporting core bindings. This behaviour
+@@ -339,7 +340,7 @@
+ (set-tm:hour result (date-hour date))
+ ;; FIXME: SRFI day ranges from 0-31. (not compatible with set-tm:mday).
+ (set-tm:mday result (date-day date))
+- (set-tm:month result (- (date-month date) 1))
++ (set-tm:mon result (- (date-month date) 1))
+ ;; FIXME: need to signal error on range violation.
+ (set-tm:year result (+ 1900 (date-year date)))
+ (set-tm:isdst result -1)
+@@ -528,33 +529,38 @@
+ ;; -- these depend on time-monotonic having the same definition as time-tai!
+ (define (time-monotonic->time-utc time-in)
+ (if (not (eq? (time-type time-in) time-monotonic))
+- (priv:time-error caller 'incompatible-time-types time-in))
++ (priv:time-error 'time-monotonic->time-utc
++ 'incompatible-time-types time-in))
+ (let ((ntime (copy-time time-in)))
+ (set-time-type! ntime time-tai)
+ (priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc)))
+
+ (define (time-monotonic->time-utc! time-in)
+ (if (not (eq? (time-type time-in) time-monotonic))
+- (priv:time-error caller 'incompatible-time-types time-in))
++ (priv:time-error 'time-monotonic->time-utc!
++ 'incompatible-time-types time-in))
+ (set-time-type! time-in time-tai)
+- (priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc))
++ (priv:time-tai->time-utc! time-in time-in 'time-monotonic->time-utc))
+
+ (define (time-monotonic->time-tai time-in)
+ (if (not (eq? (time-type time-in) time-monotonic))
+- (priv:time-error caller 'incompatible-time-types time-in))
++ (priv:time-error 'time-monotonic->time-tai
++ 'incompatible-time-types time-in))
+ (let ((ntime (copy-time time-in)))
+ (set-time-type! ntime time-tai)
+ ntime))
+
+ (define (time-monotonic->time-tai! time-in)
+ (if (not (eq? (time-type time-in) time-monotonic))
+- (priv:time-error caller 'incompatible-time-types time-in))
++ (priv:time-error 'time-monotonic->time-tai!
++ 'incompatible-time-types time-in))
+ (set-time-type! time-in time-tai)
+ time-in)
+
+ (define (time-utc->time-monotonic time-in)
+ (if (not (eq? (time-type time-in) time-utc))
+- (priv:time-error caller 'incompatible-time-types time-in))
++ (priv:time-error 'time-utc->time-monotonic
++ 'incompatible-time-types time-in))
+ (let ((ntime (priv:time-utc->time-tai! time-in (make-time-unnormalized #f #f #f)
+ 'time-utc->time-monotonic)))
+ (set-time-type! ntime time-monotonic)
+@@ -562,7 +568,8 @@
+
+ (define (time-utc->time-monotonic! time-in)
+ (if (not (eq? (time-type time-in) time-utc))
+- (priv:time-error caller 'incompatible-time-types time-in))
++ (priv:time-error 'time-utc->time-monotonic!
++ 'incompatible-time-types time-in))
+ (let ((ntime (priv:time-utc->time-tai! time-in time-in
+ 'time-utc->time-monotonic!)))
+ (set-time-type! ntime time-monotonic)
+@@ -570,14 +577,16 @@
+
+ (define (time-tai->time-monotonic time-in)
+ (if (not (eq? (time-type time-in) time-tai))
+- (priv:time-error caller 'incompatible-time-types time-in))
++ (priv:time-error 'time-tai->time-monotonic
++ 'incompatible-time-types time-in))
+ (let ((ntime (copy-time time-in)))
+ (set-time-type! ntime time-monotonic)
+ ntime))
+
+ (define (time-tai->time-monotonic! time-in)
+ (if (not (eq? (time-type time-in) time-tai))
+- (priv:time-error caller 'incompatible-time-types time-in))
++ (priv:time-error 'time-tai->time-monotonic!
++ 'incompatible-time-types time-in))
+ (set-time-type! time-in time-monotonic)
+ time-in)
+
+@@ -780,7 +789,7 @@
+ (define (priv:year-day day month year)
+ (let ((days-pr (assoc month priv:month-assoc)))
+ (if (not days-pr)
+- (priv:error 'date-year-day 'invalid-month-specification month))
++ (priv:time-error 'date-year-day 'invalid-month-specification month))
+ (if (and (priv:leap-year? year) (> month 2))
+ (+ day (cdr days-pr) 1)
+ (+ day (cdr days-pr)))))
+@@ -1263,7 +1272,7 @@
+ ((#\8) 8)
+ ((#\9) 9)
+ (else (priv:time-error 'bad-date-template-string
+- (list "Non-integer character" ch i)))))
++ (list "Non-integer character" ch)))))
+
+ ;; read an integer upto n characters long on port; upto -> #f is any length
+ (define (priv:integer-reader upto port)
+diff --git a/srfi/srfi-35.scm b/srfi/srfi-35.scm
+index 2035466..ee20a10 100644
+--- a/srfi/srfi-35.scm
++++ b/srfi/srfi-35.scm
+@@ -57,6 +57,19 @@
+ (number->string (object-address ct)
+ 16))))))
+
++(define (%make-condition-type layout id parent all-fields)
++ (let ((struct (make-struct %condition-type-vtable 0
++ (make-struct-layout layout) ;; layout
++ print-condition ;; printer
++ id parent all-fields)))
++
++ ;; Hack to associate STRUCT with a name, providing a better name for
++ ;; GOOPS classes as returned by `class-of' et al.
++ (set-struct-vtable-name! struct (cond ((symbol? id) id)
++ ((string? id) (string->symbol id))
++ (else (string->symbol ""))))
++ struct))
++
+ (define (condition-type? obj)
+ "Return true if OBJ is a condition type."
+ (and (struct? obj)
+@@ -104,10 +117,8 @@ supertypes."
+ field-names parent-fields)))
+ (let* ((all-fields (append parent-fields field-names))
+ (layout (struct-layout-for-condition all-fields)))
+- (make-struct %condition-type-vtable 0
+- (make-struct-layout layout) ;; layout
+- print-condition ;; printer
+- id parent all-fields))
++ (%make-condition-type layout
++ id parent all-fields))
+ (error "invalid condition type field names"
+ field-names)))
+ (error "parent is not a condition type" parent))
+@@ -126,13 +137,10 @@ supertypes."
+ (let* ((all-fields (append-map condition-type-all-fields
+ parents))
+ (layout (struct-layout-for-condition all-fields)))
+- (make-struct %condition-type-vtable 0
+- (make-struct-layout layout) ;; layout
+- print-condition ;; printer
+- id
+- parents ;; list of parents!
+- all-fields
+- all-fields)))))
++ (%make-condition-type layout
++ id
++ parents ;; list of parents!
++ all-fields)))))
+
+
+ ;;;
+diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am
+index e7cfd82..058ce93 100644
+--- a/test-suite/standalone/Makefile.am
++++ b/test-suite/standalone/Makefile.am
+@@ -28,7 +28,9 @@ check_SCRIPTS =
+ BUILT_SOURCES =
+ EXTRA_DIST =
+
+-TESTS_ENVIRONMENT = "${top_builddir}/pre-inst-guile-env"
++TESTS_ENVIRONMENT = \
++ builddir="$(builddir)" \
++ "${top_builddir}/pre-inst-guile-env"
+
+ test_cflags = \
+ -I$(top_srcdir)/test-suite/standalone \
+diff --git a/test-suite/standalone/test-asmobs b/test-suite/standalone/test-asmobs
+index 2ea75d9..9689ab9 100755
+--- a/test-suite/standalone/test-asmobs
++++ b/test-suite/standalone/test-asmobs
+@@ -2,7 +2,8 @@
+ exec guile -q -s "$0" "$@"
+ !#
+
+-(load-extension "libtest-asmobs" "libtest_asmobs_init")
++(load-extension (string-append (getenv "builddir") "/libtest-asmobs")
++ "libtest_asmobs_init")
+
+ (define (test x v)
+ (if v
+diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c
+index 41f99d3..caa835d 100644
+--- a/test-suite/standalone/test-conversion.c
++++ b/test-suite/standalone/test-conversion.c
+@@ -1,4 +1,4 @@
+-/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
++/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009, 2010 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
+@@ -702,10 +702,8 @@ DEFSTST (scm_to_int16)
+ DEFUTST (scm_to_uint16)
+ DEFSTST (scm_to_int32)
+ DEFUTST (scm_to_uint32)
+-#ifdef SCM_HAVE_T_INT64
+ DEFSTST (scm_to_int64)
+ DEFUTST (scm_to_uint64)
+-#endif
+
+ #define TEST_8S(v,f,r,re,te) test_8s (v, tst_##f, #f, r, re, te)
+ #define TEST_8U(v,f,r,re,te) test_8u (v, tst_##f, #f, r, re, te)
+@@ -745,11 +743,9 @@ test_int_sizes ()
+ TEST_7S (scm_from_int32, SCM_T_INT32_MAX+1LL, "-2147483648");
+ TEST_7U (scm_from_uint32, SCM_T_UINT32_MAX, "4294967295");
+
+-#if SCM_HAVE_T_INT64
+ TEST_7S (scm_from_int64, SCM_T_INT64_MIN, "-9223372036854775808");
+ TEST_7S (scm_from_int64, SCM_T_INT64_MAX, "9223372036854775807");
+ TEST_7U (scm_from_uint64, SCM_T_UINT64_MAX, "18446744073709551615");
+-#endif
+
+ TEST_8S ("91", scm_to_schar, 91, 0, 0);
+ TEST_8U ("91", scm_to_uchar, 91, 0, 0);
+@@ -794,7 +790,6 @@ test_int_sizes ()
+ TEST_8U ("-1", scm_to_uint32, 0, 1, 0);
+ TEST_8U ("#f", scm_to_uint32, 0, 0, 1);
+
+-#if SCM_HAVE_T_INT64
+ TEST_8S ("-9223372036854775808", scm_to_int64, SCM_T_INT64_MIN, 0, 0);
+ TEST_8S ("9223372036854775807", scm_to_int64, SCM_T_INT64_MAX, 0, 0);
+ TEST_8S ("9223372036854775808", scm_to_int64, 0, 1, 0);
+@@ -803,7 +798,6 @@ test_int_sizes ()
+ TEST_8U ("18446744073709551616", scm_to_uint64, 0, 1, 0);
+ TEST_8U ("-1", scm_to_uint64, 0, 1, 0);
+ TEST_8U ("#f", scm_to_uint64, 0, 0, 1);
+-#endif
+
+ }
+
+diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
+index fa53fd2..fb2535a 100644
+--- a/test-suite/tests/goops.test
++++ b/test-suite/tests/goops.test
+@@ -140,7 +140,12 @@
+ (eq? (class-of "foo") <string>))
+
+ (pass-if "port"
+- (is-a? (%make-void-port "w") <port>)))
++ (is-a? (%make-void-port "w") <port>))
++
++ (pass-if "struct vtable"
++ ;; Previously, `class-of' would fail for nameless structs, i.e., structs
++ ;; for which `struct-vtable-name' is #f.
++ (is-a? (class-of (make-vtable-vtable "prprpr" 0)) <class>)))
+
+
+ (with-test-prefix "defining classes"
+diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test
+index 4bfc415..e73f585 100644
+--- a/test-suite/tests/socket.test
++++ b/test-suite/tests/socket.test
+@@ -1,6 +1,6 @@
+ ;;;; socket.test --- test socket functions -*- scheme -*-
+ ;;;;
+-;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
++;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 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
+@@ -174,13 +174,28 @@
+ ;;; AF_UNIX sockets and `make-socket-address'
+ ;;;
+
++(define %tmpdir
++ ;; Honor `$TMPDIR', which tmpnam(3) doesn't do.
++ (or (getenv "TMPDIR") "/tmp"))
++
++(define %curdir
++ ;; Remember the current working directory.
++ (getcwd))
++
++;; Temporarily cd to %TMPDIR. The goal is to work around path name
++;; limitations, which can lead to exceptions like:
++;;
++;; (misc-error "scm_to_sockaddr"
++;; "unix address path too long: ~A"
++;; ("/tmp/nix-build-fb7bph4ifh0vr3ihigm702dzffdnapfj-guile-coverage-1.9.5.drv-0/guile-test-socket-1258553296-77619")
++;; #f)
++(chdir %tmpdir)
++
+ (define (temp-file-path)
+- ;; Return a temporary file path that honors `$TMPDIR', which `tmpnam'
+- ;; doesn't do.
+- (let ((dir (or (getenv "TMPDIR") "/tmp")))
+- (string-append dir "/guile-test-socket-"
+- (number->string (current-time)) "-"
+- (number->string (random 100000)))))
++ ;; Return a temporary file name, assuming the current directory is %TMPDIR.
++ (string-append "guile-test-socket-"
++ (number->string (current-time)) "-"
++ (number->string (random 100000))))
+
+
+ (if (defined? 'AF_UNIX)
+@@ -320,3 +335,91 @@
+
+ #t)))
+
++
++(if (defined? 'AF_INET6)
++ (with-test-prefix "AF_INET6/SOCK_STREAM"
++
++ ;; testing `bind', `listen' and `connect' on stream-oriented sockets
++
++ (let ((server-socket (socket AF_INET6 SOCK_STREAM 0))
++ (server-bound? #f)
++ (server-listening? #f)
++ (server-pid #f)
++ (ipv6-addr 1) ; ::1
++ (server-port 8889)
++ (client-port 9998))
++
++ (pass-if "bind"
++ (catch 'system-error
++ (lambda ()
++ (bind server-socket AF_INET6 ipv6-addr server-port)
++ (set! server-bound? #t)
++ #t)
++ (lambda args
++ (let ((errno (system-error-errno args)))
++ (cond ((= errno EADDRINUSE) (throw 'unresolved))
++ (else (apply throw args)))))))
++
++ (pass-if "bind/sockaddr"
++ (let* ((sock (socket AF_INET6 SOCK_STREAM 0))
++ (sockaddr (make-socket-address AF_INET6 ipv6-addr client-port)))
++ (catch 'system-error
++ (lambda ()
++ (bind sock sockaddr)
++ #t)
++ (lambda args
++ (let ((errno (system-error-errno args)))
++ (cond ((= errno EADDRINUSE) (throw 'unresolved))
++ (else (apply throw args))))))))
++
++ (pass-if "listen"
++ (if (not server-bound?)
++ (throw 'unresolved)
++ (begin
++ (listen server-socket 123)
++ (set! server-listening? #t)
++ #t)))
++
++ (if server-listening?
++ (let ((pid (primitive-fork)))
++ ;; Spawn a server process.
++ (case pid
++ ((-1) (throw 'unresolved))
++ ((0) ;; the kid: serve two connections and exit
++ (let serve ((conn
++ (false-if-exception (accept server-socket)))
++ (count 1))
++ (if (not conn)
++ (exit 1)
++ (if (> count 0)
++ (serve (false-if-exception (accept server-socket))
++ (- count 1)))))
++ (exit 0))
++ (else ;; the parent
++ (set! server-pid pid)
++ #t))))
++
++ (pass-if "connect"
++ (if (not server-pid)
++ (throw 'unresolved)
++ (let ((s (socket AF_INET6 SOCK_STREAM 0)))
++ (connect s AF_INET6 ipv6-addr server-port)
++ #t)))
++
++ (pass-if "connect/sockaddr"
++ (if (not server-pid)
++ (throw 'unresolved)
++ (let ((s (socket AF_INET6 SOCK_STREAM 0)))
++ (connect s (make-socket-address AF_INET6 ipv6-addr server-port))
++ #t)))
++
++ (pass-if "accept"
++ (if (not server-pid)
++ (throw 'unresolved)
++ (let ((status (cdr (waitpid server-pid))))
++ (eq? 0 (status:exit-val status)))))
++
++ #t)))
++
++;; Switch back to the previous directory.
++(false-if-exception (chdir %curdir))
diff --git a/recipes/guile/guile_1.8.7.bb b/recipes/guile/guile_1.8.7.bb
index b5d49fc2f1..8b3a80d91d 100644
--- a/recipes/guile/guile_1.8.7.bb
+++ b/recipes/guile/guile_1.8.7.bb
@@ -1,7 +1,10 @@
require guile.inc
+PR = "r1"
+
SRC_URI = "http://ftp.gnu.org/pub/gnu/guile/guile-${PV}.tar.gz \
file://configure-fix.patch \
+ file://18.diff \
"