summaryrefslogtreecommitdiffstats
path: root/meta-oe
diff options
context:
space:
mode:
Diffstat (limited to 'meta-oe')
-rw-r--r--meta-oe/recipes-support/guile/guile-1.8.7/18.diff1743
-rw-r--r--meta-oe/recipes-support/guile/guile-1.8.7/configure-fix.patch10
-rw-r--r--meta-oe/recipes-support/guile/guile-native-1.8.7/cpp-linemarkers.patch8
-rw-r--r--meta-oe/recipes-support/guile/guile-native-1.8.7/reloc.patch22
-rw-r--r--meta-oe/recipes-support/guile/guile-native.inc13
-rw-r--r--meta-oe/recipes-support/guile/guile-native_1.8.7.bb13
-rw-r--r--meta-oe/recipes-support/guile/guile.inc47
-rw-r--r--meta-oe/recipes-support/guile/guile_1.8.7.bb14
8 files changed, 0 insertions, 1870 deletions
diff --git a/meta-oe/recipes-support/guile/guile-1.8.7/18.diff b/meta-oe/recipes-support/guile/guile-1.8.7/18.diff
deleted file mode 100644
index 9c9eefb09..000000000
--- a/meta-oe/recipes-support/guile/guile-1.8.7/18.diff
+++ /dev/null
@@ -1,1743 +0,0 @@
1diff --git a/LICENSE b/LICENSE
2index 213e34a..dda451e 100644
3--- a/LICENSE
4+++ b/LICENSE
5@@ -1,2 +1,2 @@
6 Guile is covered under the terms of the GNU Lesser General Public
7-License, version 2.1. See COPYING.LESSER.
8+License, version 2.1 or later. See COPYING.LESSER.
9diff --git a/NEWS b/NEWS
10index 0dcc411..564484f 100644
11--- a/NEWS
12+++ b/NEWS
13@@ -5,6 +5,19 @@ See the end for copying conditions.
14 Please send Guile bug reports to bug-guile@gnu.org.
15
16
17+Changes in 1.8.8 (since 1.8.7)
18+
19+* Bugs fixed
20+
21+** Fix possible buffer overruns when parsing numbers
22+** Avoid clash with system setjmp/longjmp on IA64
23+** Don't dynamically link an extension that is already registered
24+** Fix `wrong type arg' exceptions with IPv6 addresses
25+** Fix typos in `(srfi srfi-19)'
26+** Have `(srfi srfi-35)' provide named struct vtables
27+** Fix some Interix build problems
28+
29+
30 Changes in 1.8.7 (since 1.8.6)
31
32 * Bugs fixed
33diff --git a/THANKS b/THANKS
34index 47d3cfa..48a105a 100644
35--- a/THANKS
36+++ b/THANKS
37@@ -50,6 +50,7 @@ For fixes or providing information which led to a fix:
38 Roland Haeder
39 Sven Hartrumpf
40 Eric Hanchrow
41+ Judy Hawkins
42 Sam Hocevar
43 Patrick Horgan
44 Ales Hvezda
45@@ -64,12 +65,15 @@ For fixes or providing information which led to a fix:
46 Matthias Köppe
47 Matt Kraai
48 Daniel Kraft
49+ Jay Krell
50 Jeff Long
51 Marco Maggi
52 Gregory Marton
53+ Kjetil S. Matheussen
54 Antoine Mathys
55 Dan McMahill
56 Roger Mc Murtrie
57+ Scott McPeak
58 Tim Mooney
59 Han-Wen Nienhuys
60 Jan Nieuwenhuizen
61diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
62index 9aeb08a..f6393db 100644
63--- a/doc/ref/api-modules.texi
64+++ b/doc/ref/api-modules.texi
65@@ -758,7 +758,7 @@ Record definition with @code{define-record-type} (@pxref{SRFI-9}).
66 Read hash extension @code{#,()} (@pxref{SRFI-10}).
67
68 @item (srfi srfi-11)
69-Multiple-value handling with @code{let-values} and @code{let-values*}
70+Multiple-value handling with @code{let-values} and @code{let*-values}
71 (@pxref{SRFI-11}).
72
73 @item (srfi srfi-13)
74diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
75index 7c17b36..3d9cde4 100644
76--- a/doc/ref/guile.texi
77+++ b/doc/ref/guile.texi
78@@ -13,8 +13,8 @@ This reference manual documents Guile, GNU's Ubiquitous Intelligent
79 Language for Extensions. This is edition @value{MANUAL-EDITION}
80 corresponding to Guile @value{VERSION}.
81
82-Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005 Free
83-Software Foundation.
84+Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
85+2007, 2008, 2009, 2010 Free Software Foundation.
86
87 Permission is granted to copy, distribute and/or modify this document
88 under the terms of the GNU Free Documentation License, Version 1.2 or
89diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
90index 1cb273a..0a7e342 100644
91--- a/doc/ref/posix.texi
92+++ b/doc/ref/posix.texi
93@@ -2310,8 +2310,8 @@ Convert a network address from an integer to a printable string.
94
95 @lisp
96 (inet-ntop AF_INET 2130706433) @result{} "127.0.0.1"
97-(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}
98-ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff
99+(inet-ntop AF_INET6 (- (expt 2 128) 1))
100+ @result{} "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"
101 @end lisp
102 @end deffn
103
104@@ -2882,8 +2882,8 @@ same as @code{make-socket-address} would take to make such an object
105 (@pxref{Network Socket Address}). The return value is unspecified.
106
107 @example
108-(connect sock AF_INET INADDR_LOCALHOST 23)
109-(connect sock (make-socket-address AF_INET INADDR_LOCALHOST 23))
110+(connect sock AF_INET INADDR_LOOPBACK 23)
111+(connect sock (make-socket-address AF_INET INADDR_LOOPBACK 23))
112 @end example
113 @end deffn
114
115diff --git a/ice-9/debugging/ice-9-debugger-extensions.scm b/ice-9/debugging/ice-9-debugger-extensions.scm
116index a8b8c97..fe04fc0 100644
117--- a/ice-9/debugging/ice-9-debugger-extensions.scm
118+++ b/ice-9/debugging/ice-9-debugger-extensions.scm
119@@ -39,7 +39,8 @@
120 (else
121 (define-module (ice-9 debugger))))
122
123-(use-modules (ice-9 debugging steps))
124+(use-modules (ice-9 debugging steps)
125+ (ice-9 debugging trace))
126
127 (define (assert-continuable state)
128 ;; Check that debugger is in a state where `continuing' makes sense.
129diff --git a/libguile/__scm.h b/libguile/__scm.h
130index b198f9d..e75f1a9 100644
131--- a/libguile/__scm.h
132+++ b/libguile/__scm.h
133@@ -3,7 +3,7 @@
134 #ifndef SCM___SCM_H
135 #define SCM___SCM_H
136
137-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008 Free Software Foundation, Inc.
138+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008, 2010 Free Software Foundation, Inc.
139 *
140 * This library is free software; you can redistribute it and/or
141 * modify it under the terms of the GNU Lesser General Public
142@@ -359,11 +359,9 @@
143 #define SCM_T_INT32_MIN SCM_I_TYPE_MIN(scm_t_int32,SCM_T_UINT32_MAX)
144 #define SCM_T_INT32_MAX SCM_I_TYPE_MAX(scm_t_int32,SCM_T_UINT32_MAX)
145
146-#if SCM_HAVE_T_INT64
147 #define SCM_T_UINT64_MAX SCM_I_UTYPE_MAX(scm_t_uint64)
148 #define SCM_T_INT64_MIN SCM_I_TYPE_MIN(scm_t_int64,SCM_T_UINT64_MAX)
149 #define SCM_T_INT64_MAX SCM_I_TYPE_MAX(scm_t_int64,SCM_T_UINT64_MAX)
150-#endif
151
152 #if SCM_SIZEOF_LONG_LONG
153 #define SCM_I_ULLONG_MAX SCM_I_UTYPE_MAX(unsigned long long)
154@@ -409,19 +407,28 @@
155 typedef struct {
156 ucontext_t ctx;
157 int fresh;
158- } jmp_buf;
159-# define setjmp(JB) \
160+ } scm_i_jmp_buf;
161+# define SCM_I_SETJMP(JB) \
162 ( (JB).fresh = 1, \
163 getcontext (&((JB).ctx)), \
164 ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
165-# define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
166- void scm_ia64_longjmp (jmp_buf *, int);
167+# define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
168+ void scm_ia64_longjmp (scm_i_jmp_buf *, int);
169 # else /* ndef __ia64__ */
170 # include <setjmp.h>
171 # endif /* ndef __ia64__ */
172 # endif /* ndef _CRAY1 */
173 #endif /* ndef vms */
174
175+/* For any platform where SCM_I_SETJMP hasn't been defined in some
176+ special way above, map SCM_I_SETJMP, SCM_I_LONGJMP and
177+ scm_i_jmp_buf to setjmp, longjmp and jmp_buf. */
178+#ifndef SCM_I_SETJMP
179+#define scm_i_jmp_buf jmp_buf
180+#define SCM_I_SETJMP setjmp
181+#define SCM_I_LONGJMP longjmp
182+#endif
183+
184 /* James Clark came up with this neat one instruction fix for
185 * continuations on the SPARC. It flushes the register windows so
186 * that all the state of the process is contained in the stack.
187diff --git a/libguile/continuations.c b/libguile/continuations.c
188index 69d2569..84a7fed 100644
189--- a/libguile/continuations.c
190+++ b/libguile/continuations.c
191@@ -127,7 +127,7 @@ scm_make_continuation (int *first)
192 continuation->offset = continuation->stack - src;
193 memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
194
195- *first = !setjmp (continuation->jmpbuf);
196+ *first = !SCM_I_SETJMP (continuation->jmpbuf);
197 if (*first)
198 {
199 #ifdef __ia64__
200@@ -224,12 +224,12 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
201 scm_i_set_last_debug_frame (continuation->dframe);
202
203 continuation->throw_value = val;
204- longjmp (continuation->jmpbuf, 1);
205+ SCM_I_LONGJMP (continuation->jmpbuf, 1);
206 }
207
208 #ifdef __ia64__
209 void
210-scm_ia64_longjmp (jmp_buf *JB, int VAL)
211+scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
212 {
213 scm_i_thread *t = SCM_I_CURRENT_THREAD;
214
215diff --git a/libguile/continuations.h b/libguile/continuations.h
216index f6fb96a..c61ab2d 100644
217--- a/libguile/continuations.h
218+++ b/libguile/continuations.h
219@@ -43,7 +43,7 @@ SCM_API scm_t_bits scm_tc16_continuation;
220 typedef struct
221 {
222 SCM throw_value;
223- jmp_buf jmpbuf;
224+ scm_i_jmp_buf jmpbuf;
225 SCM dynenv;
226 #ifdef __ia64__
227 void *backing_store;
228diff --git a/libguile/extensions.c b/libguile/extensions.c
229index 1090b8b..29cb58c 100644
230--- a/libguile/extensions.c
231+++ b/libguile/extensions.c
232@@ -76,6 +76,7 @@ load_extension (SCM lib, SCM init)
233 {
234 extension_t *ext;
235 char *clib, *cinit;
236+ int found = 0;
237
238 scm_dynwind_begin (0);
239
240@@ -89,10 +90,14 @@ load_extension (SCM lib, SCM init)
241 && !strcmp (ext->init, cinit))
242 {
243 ext->func (ext->data);
244+ found = 1;
245 break;
246 }
247
248 scm_dynwind_end ();
249+
250+ if (found)
251+ return;
252 }
253
254 /* Dynamically link the library. */
255diff --git a/libguile/filesys.c b/libguile/filesys.c
256index 70dfe15..c8acb13 100644
257--- a/libguile/filesys.c
258+++ b/libguile/filesys.c
259@@ -23,6 +23,9 @@
260 #ifdef __hpux
261 #define _POSIX_C_SOURCE 199506L /* for readdir_r */
262 #endif
263+#if defined(__INTERIX) && !defined(_REENTRANT)
264+# define _REENTRANT /* ask Interix for readdir_r prototype */
265+#endif
266
267 #ifdef HAVE_CONFIG_H
268 # include <config.h>
269diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
270index 85ebfae..e5de31d 100644
271--- a/libguile/gen-scmconfig.c
272+++ b/libguile/gen-scmconfig.c
273@@ -315,28 +315,10 @@ main (int argc, char *argv[])
274 return 1;
275
276 pf ("\n");
277- pf ("/* 64-bit integer -- if available SCM_HAVE_T_INT64 will be 1 and\n"
278- " scm_t_int64 will be a suitable type, otherwise SCM_HAVE_T_INT64\n"
279- " will be 0. */\n");
280- if (SCM_I_GSC_T_INT64)
281- {
282- pf ("#define SCM_HAVE_T_INT64 1 /* 0 or 1 */\n");
283- pf ("typedef %s scm_t_int64;\n", SCM_I_GSC_T_INT64);
284- }
285- else
286- pf ("#define SCM_HAVE_T_INT64 0 /* 0 or 1 */\n");
287-
288- pf ("\n");
289- pf ("/* 64-bit unsigned integer -- if available SCM_HAVE_T_UINT64 will\n"
290- " be 1 and scm_t_uint64 will be a suitable type, otherwise\n"
291- " SCM_HAVE_T_UINT64 will be 0. */\n");
292- if (SCM_I_GSC_T_UINT64)
293- {
294- pf ("#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */\n");
295- pf ("typedef %s scm_t_uint64;\n", SCM_I_GSC_T_UINT64);
296- }
297- else
298- pf ("#define SCM_HAVE_T_UINT64 0 /* 0 or 1 */\n");
299+ pf ("#define SCM_HAVE_T_INT64 1 /* 0 or 1 */\n");
300+ pf ("typedef %s scm_t_int64;\n", SCM_I_GSC_T_INT64);
301+ pf ("#define SCM_HAVE_T_UINT64 1 /* 0 or 1 */\n");
302+ pf ("typedef %s scm_t_uint64;\n", SCM_I_GSC_T_UINT64);
303
304 pf ("\n");
305 pf ("/* scm_t_ptrdiff_t and size, always defined -- defined to long if\n"
306diff --git a/libguile/hashtab.c b/libguile/hashtab.c
307index ea7fc69..1f1569c 100644
308--- a/libguile/hashtab.c
309+++ b/libguile/hashtab.c
310@@ -1,4 +1,4 @@
311-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
312+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2010 Free Software Foundation, Inc.
313 *
314 * This library is free software; you can redistribute it and/or
315 * modify it under the terms of the GNU Lesser General Public
316@@ -911,74 +911,6 @@ SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0,
317
318 /* Hash table iterators */
319
320-static const char s_scm_hash_fold[];
321-
322-SCM
323-scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
324-{
325- long i, n;
326- SCM buckets, result = init;
327-
328- if (SCM_HASHTABLE_P (table))
329- buckets = SCM_HASHTABLE_VECTOR (table);
330- else
331- buckets = table;
332-
333- n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
334- for (i = 0; i < n; ++i)
335- {
336- SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
337- while (!scm_is_null (ls))
338- {
339- if (!scm_is_pair (ls))
340- scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
341- handle = SCM_CAR (ls);
342- if (!scm_is_pair (handle))
343- scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
344- result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
345- ls = SCM_CDR (ls);
346- }
347- }
348-
349- return result;
350-}
351-
352-/* The following redundant code is here in order to be able to support
353- hash-for-each-handle. An alternative would have been to replace
354- this code and scm_internal_hash_fold above with a single
355- scm_internal_hash_fold_handles, but we don't want to promote such
356- an API. */
357-
358-static const char s_scm_hash_for_each[];
359-
360-void
361-scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table)
362-{
363- long i, n;
364- SCM buckets;
365-
366- if (SCM_HASHTABLE_P (table))
367- buckets = SCM_HASHTABLE_VECTOR (table);
368- else
369- buckets = table;
370-
371- n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
372- for (i = 0; i < n; ++i)
373- {
374- SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
375- while (!scm_is_null (ls))
376- {
377- if (!scm_is_pair (ls))
378- scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
379- handle = SCM_CAR (ls);
380- if (!scm_is_pair (handle))
381- scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
382- fn (closure, handle);
383- ls = SCM_CDR (ls);
384- }
385- }
386-}
387-
388 SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
389 (SCM proc, SCM init, SCM table),
390 "An iterator over hash-table elements.\n"
391@@ -1067,6 +999,72 @@ SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 0, 0,
392
393
394
395+SCM
396+scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
397+{
398+ long i, n;
399+ SCM buckets, result = init;
400+
401+ if (SCM_HASHTABLE_P (table))
402+ buckets = SCM_HASHTABLE_VECTOR (table);
403+ else
404+ buckets = table;
405+
406+ n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
407+ for (i = 0; i < n; ++i)
408+ {
409+ SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
410+ while (!scm_is_null (ls))
411+ {
412+ if (!scm_is_pair (ls))
413+ scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
414+ handle = SCM_CAR (ls);
415+ if (!scm_is_pair (handle))
416+ scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
417+ result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
418+ ls = SCM_CDR (ls);
419+ }
420+ }
421+
422+ return result;
423+}
424+
425+/* The following redundant code is here in order to be able to support
426+ hash-for-each-handle. An alternative would have been to replace
427+ this code and scm_internal_hash_fold above with a single
428+ scm_internal_hash_fold_handles, but we don't want to promote such
429+ an API. */
430+
431+void
432+scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table)
433+{
434+ long i, n;
435+ SCM buckets;
436+
437+ if (SCM_HASHTABLE_P (table))
438+ buckets = SCM_HASHTABLE_VECTOR (table);
439+ else
440+ buckets = table;
441+
442+ n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
443+ for (i = 0; i < n; ++i)
444+ {
445+ SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
446+ while (!scm_is_null (ls))
447+ {
448+ if (!scm_is_pair (ls))
449+ scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
450+ handle = SCM_CAR (ls);
451+ if (!scm_is_pair (handle))
452+ scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
453+ fn (closure, handle);
454+ ls = SCM_CDR (ls);
455+ }
456+ }
457+}
458+
459+
460+
461
462 void
463 scm_hashtab_prehistory ()
464diff --git a/libguile/iselect.h b/libguile/iselect.h
465index 5a4b30d..b23a641 100644
466--- a/libguile/iselect.h
467+++ b/libguile/iselect.h
468@@ -38,7 +38,12 @@
469 #ifdef FD_SET
470
471 #define SELECT_TYPE fd_set
472+#if defined(__INTERIX) && FD_SETSIZE == 4096
473+/* Interix defines FD_SETSIZE 4096 but select rejects that. */
474+#define SELECT_SET_SIZE 1024
475+#else
476 #define SELECT_SET_SIZE FD_SETSIZE
477+#endif
478
479 #else /* no FD_SET */
480
481diff --git a/libguile/numbers.c b/libguile/numbers.c
482index 2e1635f..4f5ab31 100644
483--- a/libguile/numbers.c
484+++ b/libguile/numbers.c
485@@ -1,4 +1,4 @@
486-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
487+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
488 *
489 * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
490 * and Bellcore. See scm_divide.
491@@ -620,7 +620,14 @@ guile_ieee_init (void)
492 #elif HAVE_DINFINITY
493 /* OSF */
494 extern unsigned int DINFINITY[2];
495- guile_Inf = (*((double *) (DINFINITY)));
496+ union
497+ {
498+ double d;
499+ int i[2];
500+ } alias;
501+ alias.i[0] = DINFINITY[0];
502+ alias.i[1] = DINFINITY[1];
503+ guile_Inf = alias.d;
504 #else
505 double tmp = 1e+10;
506 guile_Inf = tmp;
507@@ -651,7 +658,14 @@ guile_ieee_init (void)
508 {
509 /* OSF */
510 extern unsigned int DQNAN[2];
511- guile_NaN = (*((double *)(DQNAN)));
512+ union
513+ {
514+ double d;
515+ int i[2];
516+ } alias;
517+ alias.i[0] = DQNAN[0];
518+ alias.i[1] = DQNAN[1];
519+ guile_NaN = alias.d;
520 }
521 #else
522 guile_NaN = guile_Inf / guile_Inf;
523@@ -2663,17 +2677,26 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
524 case 'l': case 'L':
525 case 's': case 'S':
526 idx++;
527+ if (idx == len)
528+ return SCM_BOOL_F;
529+
530 start = idx;
531 c = mem[idx];
532 if (c == '-')
533 {
534 idx++;
535+ if (idx == len)
536+ return SCM_BOOL_F;
537+
538 sign = -1;
539 c = mem[idx];
540 }
541 else if (c == '+')
542 {
543 idx++;
544+ if (idx == len)
545+ return SCM_BOOL_F;
546+
547 sign = 1;
548 c = mem[idx];
549 }
550@@ -2789,8 +2812,10 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
551 SCM divisor;
552
553 idx++;
554+ if (idx == len)
555+ return SCM_BOOL_F;
556
557- divisor = mem2uinteger (mem, len, &idx, radix, &x);
558+ divisor = mem2uinteger (mem, len, &idx, radix, &x);
559 if (scm_is_false (divisor))
560 return SCM_BOOL_F;
561
562@@ -2911,11 +2936,15 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
563 if (c == '+')
564 {
565 idx++;
566+ if (idx == len)
567+ return SCM_BOOL_F;
568 sign = 1;
569 }
570 else if (c == '-')
571 {
572 idx++;
573+ if (idx == len)
574+ return SCM_BOOL_F;
575 sign = -1;
576 }
577 else
578@@ -5869,8 +5898,6 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
579 #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint32 (arg)
580 #include "libguile/conv-uinteger.i.c"
581
582-#if SCM_HAVE_T_INT64
583-
584 #define TYPE scm_t_int64
585 #define TYPE_MIN SCM_T_INT64_MIN
586 #define TYPE_MAX SCM_T_INT64_MAX
587@@ -5887,8 +5914,6 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
588 #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint64 (arg)
589 #include "libguile/conv-uinteger.i.c"
590
591-#endif
592-
593 void
594 scm_to_mpz (SCM val, mpz_t rop)
595 {
596diff --git a/libguile/numbers.h b/libguile/numbers.h
597index 2c2fdcf..35263a4 100644
598--- a/libguile/numbers.h
599+++ b/libguile/numbers.h
600@@ -3,7 +3,7 @@
601 #ifndef SCM_NUMBERS_H
602 #define SCM_NUMBERS_H
603
604-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006 Free Software Foundation, Inc.
605+/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2010 Free Software Foundation, Inc.
606 *
607 * This library is free software; you can redistribute it and/or
608 * modify it under the terms of the GNU Lesser General Public
609@@ -321,16 +321,12 @@ SCM_API SCM scm_from_int32 (scm_t_int32 x);
610 SCM_API scm_t_uint32 scm_to_uint32 (SCM x);
611 SCM_API SCM scm_from_uint32 (scm_t_uint32 x);
612
613-#if SCM_HAVE_T_INT64
614-
615 SCM_API scm_t_int64 scm_to_int64 (SCM x);
616 SCM_API SCM scm_from_int64 (scm_t_int64 x);
617
618 SCM_API scm_t_uint64 scm_to_uint64 (SCM x);
619 SCM_API SCM scm_from_uint64 (scm_t_uint64 x);
620
621-#endif
622-
623 SCM_API void scm_to_mpz (SCM x, mpz_t rop);
624 SCM_API SCM scm_from_mpz (mpz_t rop);
625
626diff --git a/libguile/random.c b/libguile/random.c
627index 8d2ff03..693ed4a 100644
628--- a/libguile/random.c
629+++ b/libguile/random.c
630@@ -1,4 +1,4 @@
631-/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006 Free Software Foundation, Inc.
632+/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 2010 Free Software Foundation, Inc.
633 * This library is free software; you can redistribute it and/or
634 * modify it under the terms of the GNU Lesser General Public
635 * License as published by the Free Software Foundation; either
636@@ -75,8 +75,6 @@ scm_t_rng scm_the_rng;
637 #define M_PI 3.14159265359
638 #endif
639
640-#if SCM_HAVE_T_UINT64
641-
642 unsigned long
643 scm_i_uniform32 (scm_t_i_rstate *state)
644 {
645@@ -87,38 +85,6 @@ scm_i_uniform32 (scm_t_i_rstate *state)
646 return w;
647 }
648
649-#else
650-
651-/* ww This is a portable version of the same RNG without 64 bit
652- * * aa arithmetic.
653- * ----
654- * xx It is only intended to provide identical behaviour on
655- * xx platforms without 8 byte longs or long longs until
656- * xx someone has implemented the routine in assembler code.
657- * xxcc
658- * ----
659- * ccww
660- */
661-
662-#define L(x) ((x) & 0xffff)
663-#define H(x) ((x) >> 16)
664-
665-unsigned long
666-scm_i_uniform32 (scm_t_i_rstate *state)
667-{
668- scm_t_uint32 x1 = L (A) * L (state->w);
669- scm_t_uint32 x2 = L (A) * H (state->w);
670- scm_t_uint32 x3 = H (A) * L (state->w);
671- scm_t_uint32 w = L (x1) + L (state->c);
672- scm_t_uint32 m = H (x1) + L (x2) + L (x3) + H (state->c) + H (w);
673- scm_t_uint32 x4 = H (A) * H (state->w);
674- state->w = w = (L (m) << 16) + L (w);
675- state->c = H (x2) + H (x3) + x4 + H (m);
676- return w;
677-}
678-
679-#endif
680-
681 void
682 scm_i_init_rstate (scm_t_i_rstate *state, const char *seed, int n)
683 {
684@@ -212,21 +178,49 @@ scm_c_exp1 (scm_t_rstate *state)
685
686 unsigned char scm_masktab[256];
687
688-unsigned long
689-scm_c_random (scm_t_rstate *state, unsigned long m)
690+static inline scm_t_uint32
691+scm_i_mask32 (scm_t_uint32 m)
692 {
693- unsigned int r, mask;
694- mask = (m < 0x100
695+ return (m < 0x100
696 ? scm_masktab[m]
697 : (m < 0x10000
698 ? scm_masktab[m >> 8] << 8 | 0xff
699 : (m < 0x1000000
700 ? scm_masktab[m >> 16] << 16 | 0xffff
701 : scm_masktab[m >> 24] << 24 | 0xffffff)));
702+}
703+
704+static scm_t_uint32
705+scm_c_random32 (scm_t_rstate *state, scm_t_uint32 m)
706+{
707+ scm_t_uint32 r, mask = scm_i_mask32 (m);
708 while ((r = scm_the_rng.random_bits (state) & mask) >= m);
709 return r;
710 }
711
712+/* Returns 32 random bits. */
713+unsigned long
714+scm_c_random (scm_t_rstate *state, unsigned long m)
715+{
716+ return scm_c_random32 (state, (scm_t_uint32)m);
717+}
718+
719+scm_t_uint64
720+scm_c_random64 (scm_t_rstate *state, scm_t_uint64 m)
721+{
722+ scm_t_uint64 r;
723+ scm_t_uint32 mask;
724+
725+ if (m <= SCM_T_UINT32_MAX)
726+ return scm_c_random32 (state, (scm_t_uint32) m);
727+
728+ mask = scm_i_mask32 (m >> 32);
729+ while ((r = ((scm_t_uint64) (scm_the_rng.random_bits (state) & mask) << 32)
730+ | scm_the_rng.random_bits (state)) >= m)
731+ ;
732+ return r;
733+}
734+
735 /*
736 SCM scm_c_random_bignum (scm_t_rstate *state, SCM m)
737
738@@ -247,24 +241,24 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
739 {
740 SCM result = scm_i_mkbig ();
741 const size_t m_bits = mpz_sizeinbase (SCM_I_BIG_MPZ (m), 2);
742- /* how many bits would only partially fill the last unsigned long? */
743- const size_t end_bits = m_bits % (sizeof (unsigned long) * SCM_CHAR_BIT);
744- unsigned long *random_chunks = NULL;
745- const unsigned long num_full_chunks =
746- m_bits / (sizeof (unsigned long) * SCM_CHAR_BIT);
747- const unsigned long num_chunks = num_full_chunks + ((end_bits) ? 1 : 0);
748+ /* how many bits would only partially fill the last u32? */
749+ const size_t end_bits = m_bits % (sizeof (scm_t_uint32) * SCM_CHAR_BIT);
750+ scm_t_uint32 *random_chunks = NULL;
751+ const scm_t_uint32 num_full_chunks =
752+ m_bits / (sizeof (scm_t_uint32) * SCM_CHAR_BIT);
753+ const scm_t_uint32 num_chunks = num_full_chunks + ((end_bits) ? 1 : 0);
754
755 /* we know the result will be this big */
756 mpz_realloc2 (SCM_I_BIG_MPZ (result), m_bits);
757
758 random_chunks =
759- (unsigned long *) scm_gc_calloc (num_chunks * sizeof (unsigned long),
760+ (scm_t_uint32 *) scm_gc_calloc (num_chunks * sizeof (scm_t_uint32),
761 "random bignum chunks");
762
763 do
764 {
765- unsigned long *current_chunk = random_chunks + (num_chunks - 1);
766- unsigned long chunks_left = num_chunks;
767+ scm_t_uint32 *current_chunk = random_chunks + (num_chunks - 1);
768+ scm_t_uint32 chunks_left = num_chunks;
769
770 mpz_set_ui (SCM_I_BIG_MPZ (result), 0);
771
772@@ -273,23 +267,23 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
773 /* generate a mask with ones in the end_bits position, i.e. if
774 end_bits is 3, then we'd have a mask of ...0000000111 */
775 const unsigned long rndbits = scm_the_rng.random_bits (state);
776- int rshift = (sizeof (unsigned long) * SCM_CHAR_BIT) - end_bits;
777- unsigned long mask = ((unsigned long) ULONG_MAX) >> rshift;
778- unsigned long highest_bits = rndbits & mask;
779+ int rshift = (sizeof (scm_t_uint32) * SCM_CHAR_BIT) - end_bits;
780+ scm_t_uint32 mask = 0xffffffff >> rshift;
781+ scm_t_uint32 highest_bits = ((scm_t_uint32) rndbits) & mask;
782 *current_chunk-- = highest_bits;
783 chunks_left--;
784 }
785
786 while (chunks_left)
787 {
788- /* now fill in the remaining unsigned long sized chunks */
789+ /* now fill in the remaining scm_t_uint32 sized chunks */
790 *current_chunk-- = scm_the_rng.random_bits (state);
791 chunks_left--;
792 }
793 mpz_import (SCM_I_BIG_MPZ (result),
794 num_chunks,
795 -1,
796- sizeof (unsigned long),
797+ sizeof (scm_t_uint32),
798 0,
799 0,
800 random_chunks);
801@@ -297,7 +291,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
802 all bits in order not to get a distorted distribution) */
803 } while (mpz_cmp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (m)) >= 0);
804 scm_gc_free (random_chunks,
805- num_chunks * sizeof (unsigned long),
806+ num_chunks * sizeof (scm_t_uint32),
807 "random bignum chunks");
808 return scm_i_normbig (result);
809 }
810@@ -348,9 +342,17 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
811 SCM_VALIDATE_RSTATE (2, state);
812 if (SCM_I_INUMP (n))
813 {
814- unsigned long m = SCM_I_INUM (n);
815- SCM_ASSERT_RANGE (1, n, m > 0);
816- return scm_from_ulong (scm_c_random (SCM_RSTATE (state), m));
817+ unsigned long m = (unsigned long) SCM_I_INUM (n);
818+ SCM_ASSERT_RANGE (1, n, SCM_I_INUM (n) > 0);
819+#if SCM_SIZEOF_UNSIGNED_LONG <= 4
820+ return scm_from_uint32 (scm_c_random (SCM_RSTATE (state),
821+ (scm_t_uint32) m));
822+#elif SCM_SIZEOF_UNSIGNED_LONG <= 8
823+ return scm_from_uint64 (scm_c_random64 (SCM_RSTATE (state),
824+ (scm_t_uint64) m));
825+#else
826+#error "Cannot deal with this platform's unsigned long size"
827+#endif
828 }
829 SCM_VALIDATE_NIM (1, n);
830 if (SCM_REALP (n))
831diff --git a/libguile/random.h b/libguile/random.h
832index 6ec43ff..0690b59 100644
833--- a/libguile/random.h
834+++ b/libguile/random.h
835@@ -3,7 +3,7 @@
836 #ifndef SCM_RANDOM_H
837 #define SCM_RANDOM_H
838
839-/* Copyright (C) 1999,2000,2001, 2006 Free Software Foundation, Inc.
840+/* Copyright (C) 1999,2000,2001, 2006, 2010 Free Software Foundation, Inc.
841 *
842 * This library is free software; you can redistribute it and/or
843 * modify it under the terms of the GNU Lesser General Public
844@@ -45,6 +45,7 @@ typedef struct scm_t_rstate {
845
846 typedef struct scm_t_rng {
847 size_t rstate_size; /* size of random state */
848+ /* Though this returns an unsigned long, it's only 32 bits of randomness. */
849 unsigned long (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */
850 void (*init_rstate) (scm_t_rstate *state, const char *seed, int n);
851 scm_t_rstate *(*copy_rstate) (scm_t_rstate *state);
852@@ -62,6 +63,7 @@ typedef struct scm_t_i_rstate {
853 unsigned long c;
854 } scm_t_i_rstate;
855
856+/* Though this returns an unsigned long, it's only 32 bits of randomness. */
857 SCM_API unsigned long scm_i_uniform32 (scm_t_i_rstate *);
858 SCM_API void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n);
859 SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
860@@ -76,7 +78,10 @@ SCM_API scm_t_rstate *scm_c_default_rstate (void);
861 SCM_API double scm_c_uniform01 (scm_t_rstate *);
862 SCM_API double scm_c_normal01 (scm_t_rstate *);
863 SCM_API double scm_c_exp1 (scm_t_rstate *);
864+/* Though this returns an unsigned long, it's only 32 bits of randomness. */
865 SCM_API unsigned long scm_c_random (scm_t_rstate *, unsigned long m);
866+/* This one returns 64 bits of randomness. */
867+SCM_API scm_t_uint64 scm_c_random64 (scm_t_rstate *state, scm_t_uint64 m);
868 SCM_API SCM scm_c_random_bignum (scm_t_rstate *, SCM m);
869
870
871diff --git a/libguile/socket.c b/libguile/socket.c
872index f34b6d4..cb954f4 100644
873--- a/libguile/socket.c
874+++ b/libguile/socket.c
875@@ -347,7 +347,7 @@ scm_to_ipv6 (scm_t_uint8 dst[16], SCM src)
876 scm_remember_upto_here_1 (src);
877 }
878 else
879- scm_wrong_type_arg (NULL, 0, src);
880+ scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src, "integer");
881 }
882
883 #ifdef HAVE_INET_PTON
884@@ -397,8 +397,8 @@ SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
885 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
886 "@lisp\n"
887 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
888- "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
889- "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
890+ "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
891+ " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
892 "@end lisp")
893 #define FUNC_NAME s_scm_inet_ntop
894 {
895@@ -1167,7 +1167,8 @@ scm_to_sockaddr (SCM address, size_t *address_size)
896 {
897 struct sockaddr_in6 c_inet6;
898
899- scm_to_ipv6 (c_inet6.sin6_addr.s6_addr, address);
900+ scm_to_ipv6 (c_inet6.sin6_addr.s6_addr,
901+ SCM_SIMPLE_VECTOR_REF (address, 1));
902 c_inet6.sin6_port =
903 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
904 c_inet6.sin6_flowinfo =
905diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
906index b0e052a..f2a9d7f 100644
907--- a/libguile/srfi-4.c
908+++ b/libguile/srfi-4.c
909@@ -1,6 +1,6 @@
910 /* srfi-4.c --- Uniform numeric vector datatypes.
911 *
912- * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
913+ * Copyright (C) 2001, 2004, 2006, 2010 Free Software Foundation, Inc.
914 *
915 * This library is free software; you can redistribute it and/or
916 * modify it under the terms of the GNU Lesser General Public
917@@ -84,11 +84,7 @@ static const int uvec_sizes[12] = {
918 1, 1,
919 2, 2,
920 4, 4,
921-#if SCM_HAVE_T_INT64
922 8, 8,
923-#else
924- sizeof (SCM), sizeof (SCM),
925-#endif
926 sizeof(float), sizeof(double),
927 2*sizeof(float), 2*sizeof(double)
928 };
929@@ -127,10 +123,8 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
930 scm_t_int16 *s16;
931 scm_t_uint32 *u32;
932 scm_t_int32 *s32;
933-#if SCM_HAVE_T_INT64
934 scm_t_uint64 *u64;
935 scm_t_int64 *s64;
936-#endif
937 float *f32;
938 double *f64;
939 SCM *fake_64;
940@@ -148,13 +142,8 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
941 case SCM_UVEC_S16: np.s16 = (scm_t_int16 *) uptr; break;
942 case SCM_UVEC_U32: np.u32 = (scm_t_uint32 *) uptr; break;
943 case SCM_UVEC_S32: np.s32 = (scm_t_int32 *) uptr; break;
944-#if SCM_HAVE_T_INT64
945 case SCM_UVEC_U64: np.u64 = (scm_t_uint64 *) uptr; break;
946 case SCM_UVEC_S64: np.s64 = (scm_t_int64 *) uptr; break;
947-#else
948- case SCM_UVEC_U64:
949- case SCM_UVEC_S64: np.fake_64 = (SCM *) uptr; break;
950-#endif
951 case SCM_UVEC_F32: np.f32 = (float *) uptr; break;
952 case SCM_UVEC_F64: np.f64 = (double *) uptr; break;
953 case SCM_UVEC_C32: np.f32 = (float *) uptr; break;
954@@ -179,14 +168,8 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
955 case SCM_UVEC_S16: scm_intprint (*np.s16, 10, port); np.s16++; break;
956 case SCM_UVEC_U32: scm_uintprint (*np.u32, 10, port); np.u32++; break;
957 case SCM_UVEC_S32: scm_intprint (*np.s32, 10, port); np.s32++; break;
958-#if SCM_HAVE_T_INT64
959 case SCM_UVEC_U64: scm_uintprint (*np.u64, 10, port); np.u64++; break;
960 case SCM_UVEC_S64: scm_intprint (*np.s64, 10, port); np.s64++; break;
961-#else
962- case SCM_UVEC_U64:
963- case SCM_UVEC_S64: scm_iprin1 (*np.fake_64, port, pstate);
964- np.fake_64++; break;
965-#endif
966 case SCM_UVEC_F32: scm_i_print_double (*np.f32, port); np.f32++; break;
967 case SCM_UVEC_F64: scm_i_print_double (*np.f64, port); np.f64++; break;
968 case SCM_UVEC_C32:
969@@ -222,20 +205,6 @@ uvec_equalp (SCM a, SCM b)
970 result = SCM_BOOL_F;
971 else if (SCM_UVEC_LENGTH (a) != SCM_UVEC_LENGTH (b))
972 result = SCM_BOOL_F;
973-#if SCM_HAVE_T_INT64 == 0
974- else if (SCM_UVEC_TYPE (a) == SCM_UVEC_U64
975- || SCM_UVEC_TYPE (a) == SCM_UVEC_S64)
976- {
977- SCM *aptr = (SCM *)SCM_UVEC_BASE (a), *bptr = (SCM *)SCM_UVEC_BASE (b);
978- size_t len = SCM_UVEC_LENGTH (a), i;
979- for (i = 0; i < len; i++)
980- if (scm_is_false (scm_num_eq_p (*aptr++, *bptr++)))
981- {
982- result = SCM_BOOL_F;
983- break;
984- }
985- }
986-#endif
987 else if (memcmp (SCM_UVEC_BASE (a), SCM_UVEC_BASE (b),
988 SCM_UVEC_LENGTH (a) * uvec_sizes[SCM_UVEC_TYPE(a)]) != 0)
989 result = SCM_BOOL_F;
990@@ -244,24 +213,6 @@ uvec_equalp (SCM a, SCM b)
991 return result;
992 }
993
994-/* Mark hook. Only used when U64 and S64 are implemented as SCMs. */
995-
996-#if SCM_HAVE_T_INT64 == 0
997-static SCM
998-uvec_mark (SCM uvec)
999-{
1000- if (SCM_UVEC_TYPE (uvec) == SCM_UVEC_U64
1001- || SCM_UVEC_TYPE (uvec) == SCM_UVEC_S64)
1002- {
1003- SCM *ptr = (SCM *)SCM_UVEC_BASE (uvec);
1004- size_t len = SCM_UVEC_LENGTH (uvec), i;
1005- for (i = 0; i < len; i++)
1006- scm_gc_mark (*ptr++);
1007- }
1008- return SCM_BOOL_F;
1009-}
1010-#endif
1011-
1012 /* Smob free hook for uniform numeric vectors. */
1013 static size_t
1014 uvec_free (SCM uvec)
1015@@ -318,15 +269,6 @@ alloc_uvec (int type, size_t len)
1016 if (len > SCM_I_SIZE_MAX / uvec_sizes[type])
1017 scm_out_of_range (NULL, scm_from_size_t (len));
1018 base = scm_gc_malloc (len * uvec_sizes[type], uvec_names[type]);
1019-#if SCM_HAVE_T_INT64 == 0
1020- if (type == SCM_UVEC_U64 || type == SCM_UVEC_S64)
1021- {
1022- SCM *ptr = (SCM *)base;
1023- size_t i;
1024- for (i = 0; i < len; i++)
1025- *ptr++ = SCM_UNSPECIFIED;
1026- }
1027-#endif
1028 return take_uvec (type, base, len);
1029 }
1030
1031@@ -349,17 +291,10 @@ uvec_fast_ref (int type, const void *base, size_t c_idx)
1032 return scm_from_uint32 (((scm_t_uint32*)base)[c_idx]);
1033 else if (type == SCM_UVEC_S32)
1034 return scm_from_int32 (((scm_t_int32*)base)[c_idx]);
1035-#if SCM_HAVE_T_INT64
1036 else if (type == SCM_UVEC_U64)
1037 return scm_from_uint64 (((scm_t_uint64*)base)[c_idx]);
1038 else if (type == SCM_UVEC_S64)
1039 return scm_from_int64 (((scm_t_int64*)base)[c_idx]);
1040-#else
1041- else if (type == SCM_UVEC_U64)
1042- return ((SCM *)base)[c_idx];
1043- else if (type == SCM_UVEC_S64)
1044- return ((SCM *)base)[c_idx];
1045-#endif
1046 else if (type == SCM_UVEC_F32)
1047 return scm_from_double (((float*)base)[c_idx]);
1048 else if (type == SCM_UVEC_F64)
1049@@ -374,22 +309,6 @@ uvec_fast_ref (int type, const void *base, size_t c_idx)
1050 return SCM_BOOL_F;
1051 }
1052
1053-#if SCM_HAVE_T_INT64 == 0
1054-static SCM scm_uint64_min, scm_uint64_max;
1055-static SCM scm_int64_min, scm_int64_max;
1056-
1057-static void
1058-assert_exact_integer_range (SCM val, SCM min, SCM max)
1059-{
1060- if (!scm_is_integer (val)
1061- || scm_is_false (scm_exact_p (val)))
1062- scm_wrong_type_arg_msg (NULL, 0, val, "exact integer");
1063- if (scm_is_true (scm_less_p (val, min))
1064- || scm_is_true (scm_gr_p (val, max)))
1065- scm_out_of_range (NULL, val);
1066-}
1067-#endif
1068-
1069 static SCM_C_INLINE_KEYWORD void
1070 uvec_fast_set_x (int type, void *base, size_t c_idx, SCM val)
1071 {
1072@@ -405,23 +324,10 @@ uvec_fast_set_x (int type, void *base, size_t c_idx, SCM val)
1073 (((scm_t_uint32*)base)[c_idx]) = scm_to_uint32 (val);
1074 else if (type == SCM_UVEC_S32)
1075 (((scm_t_int32*)base)[c_idx]) = scm_to_int32 (val);
1076-#if SCM_HAVE_T_INT64
1077 else if (type == SCM_UVEC_U64)
1078 (((scm_t_uint64*)base)[c_idx]) = scm_to_uint64 (val);
1079 else if (type == SCM_UVEC_S64)
1080 (((scm_t_int64*)base)[c_idx]) = scm_to_int64 (val);
1081-#else
1082- else if (type == SCM_UVEC_U64)
1083- {
1084- assert_exact_integer_range (val, scm_uint64_min, scm_uint64_max);
1085- ((SCM *)base)[c_idx] = val;
1086- }
1087- else if (type == SCM_UVEC_S64)
1088- {
1089- assert_exact_integer_range (val, scm_int64_min, scm_int64_max);
1090- ((SCM *)base)[c_idx] = val;
1091- }
1092-#endif
1093 else if (type == SCM_UVEC_F32)
1094 (((float*)base)[c_idx]) = scm_to_double (val);
1095 else if (type == SCM_UVEC_F64)
1096@@ -1027,16 +933,12 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0,
1097
1098 #define TYPE SCM_UVEC_U64
1099 #define TAG u64
1100-#if SCM_HAVE_T_UINT64
1101 #define CTYPE scm_t_uint64
1102-#endif
1103 #include "libguile/srfi-4.i.c"
1104
1105 #define TYPE SCM_UVEC_S64
1106 #define TAG s64
1107-#if SCM_HAVE_T_INT64
1108 #define CTYPE scm_t_int64
1109-#endif
1110 #include "libguile/srfi-4.i.c"
1111
1112 #define TYPE SCM_UVEC_F32
1113@@ -1094,23 +996,9 @@ scm_init_srfi_4 (void)
1114 {
1115 scm_tc16_uvec = scm_make_smob_type ("uvec", 0);
1116 scm_set_smob_equalp (scm_tc16_uvec, uvec_equalp);
1117-#if SCM_HAVE_T_INT64 == 0
1118- scm_set_smob_mark (scm_tc16_uvec, uvec_mark);
1119-#endif
1120 scm_set_smob_free (scm_tc16_uvec, uvec_free);
1121 scm_set_smob_print (scm_tc16_uvec, uvec_print);
1122
1123-#if SCM_HAVE_T_INT64 == 0
1124- scm_uint64_min =
1125- scm_permanent_object (scm_from_int (0));
1126- scm_uint64_max =
1127- scm_permanent_object (scm_c_read_string ("18446744073709551615"));
1128- scm_int64_min =
1129- scm_permanent_object (scm_c_read_string ("-9223372036854775808"));
1130- scm_int64_max =
1131- scm_permanent_object (scm_c_read_string ("9223372036854775807"));
1132-#endif
1133-
1134 #include "libguile/srfi-4.x"
1135
1136 }
1137diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
1138index 7abbac8..2348c5a 100644
1139--- a/libguile/srfi-4.h
1140+++ b/libguile/srfi-4.h
1141@@ -2,7 +2,7 @@
1142 #define SCM_SRFI_4_H
1143 /* srfi-4.c --- Homogeneous numeric vector datatypes.
1144 *
1145- * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
1146+ * Copyright (C) 2001, 2004, 2006, 2010 Free Software Foundation, Inc.
1147 *
1148 * This library is free software; you can redistribute it and/or
1149 * modify it under the terms of the GNU Lesser General Public
1150@@ -186,7 +186,6 @@ SCM_API SCM scm_u64vector_to_list (SCM uvec);
1151 SCM_API SCM scm_list_to_u64vector (SCM l);
1152 SCM_API SCM scm_any_to_u64vector (SCM obj);
1153
1154-#if SCM_HAVE_T_UINT64
1155 SCM_API SCM scm_take_u64vector (scm_t_uint64 *data, size_t n);
1156 SCM_API const scm_t_uint64 *scm_array_handle_u64_elements (scm_t_array_handle *h);
1157 SCM_API scm_t_uint64 *scm_array_handle_u64_writable_elements (scm_t_array_handle *h);
1158@@ -198,7 +197,6 @@ SCM_API scm_t_uint64 *scm_u64vector_writable_elements (SCM uvec,
1159 scm_t_array_handle *h,
1160 size_t *lenp,
1161 ssize_t *incp);
1162-#endif
1163
1164 SCM_API SCM scm_s64vector_p (SCM obj);
1165 SCM_API SCM scm_make_s64vector (SCM n, SCM fill);
1166@@ -210,7 +208,6 @@ SCM_API SCM scm_s64vector_to_list (SCM uvec);
1167 SCM_API SCM scm_list_to_s64vector (SCM l);
1168 SCM_API SCM scm_any_to_s64vector (SCM obj);
1169
1170-#if SCM_HAVE_T_INT64
1171 SCM_API SCM scm_take_s64vector (scm_t_int64 *data, size_t n);
1172 SCM_API const scm_t_int64 *scm_array_handle_s64_elements (scm_t_array_handle *h);
1173 SCM_API scm_t_int64 *scm_array_handle_s64_writable_elements (scm_t_array_handle *h);
1174@@ -221,7 +218,6 @@ SCM_API scm_t_int64 *scm_s64vector_writable_elements (SCM uvec,
1175 scm_t_array_handle *h,
1176 size_t *lenp,
1177 ssize_t *incp);
1178-#endif
1179
1180 SCM_API SCM scm_f32vector_p (SCM obj);
1181 SCM_API SCM scm_make_f32vector (SCM n, SCM fill);
1182diff --git a/libguile/threads.c b/libguile/threads.c
1183index 95a905c..f2bb556 100644
1184--- a/libguile/threads.c
1185+++ b/libguile/threads.c
1186@@ -276,7 +276,7 @@ unblock_from_queue (SCM queue)
1187 var 't'
1188 // save registers.
1189 SCM_FLUSH_REGISTER_WINDOWS; // sparc only
1190- setjmp (t->regs); // here's most of the magic
1191+ SCM_I_SETJMP (t->regs); // here's most of the magic
1192
1193 ... and returns.
1194
1195@@ -330,7 +330,7 @@ unblock_from_queue (SCM queue)
1196 t->top = SCM_STACK_PTR (&t);
1197 // save registers.
1198 SCM_FLUSH_REGISTER_WINDOWS;
1199- setjmp (t->regs);
1200+ SCM_I_SETJMP (t->regs);
1201 res = func(data);
1202 scm_enter_guile (t);
1203
1204@@ -388,7 +388,7 @@ suspend (void)
1205 t->top = SCM_STACK_PTR (&t);
1206 /* save registers. */
1207 SCM_FLUSH_REGISTER_WINDOWS;
1208- setjmp (t->regs);
1209+ SCM_I_SETJMP (t->regs);
1210 return t;
1211 }
1212
1213diff --git a/libguile/threads.h b/libguile/threads.h
1214index 2b0e067..e22d9bd 100644
1215--- a/libguile/threads.h
1216+++ b/libguile/threads.h
1217@@ -107,7 +107,7 @@ typedef struct scm_i_thread {
1218 /* For keeping track of the stack and registers. */
1219 SCM_STACKITEM *base;
1220 SCM_STACKITEM *top;
1221- jmp_buf regs;
1222+ scm_i_jmp_buf regs;
1223 #ifdef __ia64__
1224 void *register_backing_store_base;
1225 scm_t_contregs *pending_rbs_continuation;
1226diff --git a/libguile/throw.c b/libguile/throw.c
1227index 92c5a1a..fcfde47 100644
1228--- a/libguile/throw.c
1229+++ b/libguile/throw.c
1230@@ -53,7 +53,7 @@ static scm_t_bits tc16_jmpbuffer;
1231 #define DEACTIVATEJB(x) \
1232 (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L))))
1233
1234-#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
1235+#define JBJMPBUF(OBJ) ((scm_i_jmp_buf *) SCM_CELL_WORD_1 (OBJ))
1236 #define SETJBJMPBUF(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v)))
1237 #define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x))
1238 #define SCM_SETJBDFRAME(x, v) (SCM_SET_CELL_WORD_2 ((x), (scm_t_bits) (v)))
1239@@ -75,7 +75,7 @@ make_jmpbuf (void)
1240 {
1241 SCM answer;
1242 SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0);
1243- SETJBJMPBUF(answer, (jmp_buf *)0);
1244+ SETJBJMPBUF(answer, (scm_i_jmp_buf *)0);
1245 DEACTIVATEJB(answer);
1246 return answer;
1247 }
1248@@ -85,7 +85,7 @@ make_jmpbuf (void)
1249
1250 struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
1251 {
1252- jmp_buf buf; /* must be first */
1253+ scm_i_jmp_buf buf; /* must be first */
1254 SCM throw_tag;
1255 SCM retval;
1256 };
1257@@ -179,7 +179,7 @@ scm_c_catch (SCM tag,
1258 pre_unwind.lazy_catch_p = 0;
1259 SCM_SETJBPREUNWIND(jmpbuf, &pre_unwind);
1260
1261- if (setjmp (jbr.buf))
1262+ if (SCM_I_SETJMP (jbr.buf))
1263 {
1264 SCM throw_tag;
1265 SCM throw_args;
1266@@ -821,7 +821,7 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
1267 jbr->throw_tag = key;
1268 jbr->retval = args;
1269 scm_i_set_last_debug_frame (SCM_JBDFRAME (jmpbuf));
1270- longjmp (*JBJMPBUF (jmpbuf), 1);
1271+ SCM_I_LONGJMP (*JBJMPBUF (jmpbuf), 1);
1272 }
1273
1274 /* Otherwise, it's some random piece of junk. */
1275diff --git a/libguile/vectors.c b/libguile/vectors.c
1276index eeb8569..074655c 100644
1277--- a/libguile/vectors.c
1278+++ b/libguile/vectors.c
1279@@ -1,4 +1,4 @@
1280-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
1281+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2010 Free Software Foundation, Inc.
1282 *
1283 * This library is free software; you can redistribute it and/or
1284 * modify it under the terms of the GNU Lesser General Public
1285@@ -465,7 +465,9 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
1286
1287 i = scm_to_unsigned_integer (start1, 0, len1);
1288 e = scm_to_unsigned_integer (end1, i, len1);
1289- j = scm_to_unsigned_integer (start2, 0, len2 - (i-e));
1290+ SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) < len2);
1291+ j = scm_to_unsigned_integer (start2, 0, len2);
1292+ SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
1293
1294 i *= inc1;
1295 e *= inc1;
1296@@ -503,7 +505,11 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
1297
1298 i = scm_to_unsigned_integer (start1, 0, len1);
1299 e = scm_to_unsigned_integer (end1, i, len1);
1300- j = scm_to_unsigned_integer (start2, 0, len2 - (i-e));
1301+ SCM_ASSERT_RANGE (SCM_ARG3, end1, (e-i) < len2);
1302+ j = scm_to_unsigned_integer (start2, 0, len2);
1303+ SCM_ASSERT_RANGE (SCM_ARG5, start2, j <= len2 - (e - i));
1304+
1305+ j += (e - i);
1306
1307 i *= inc1;
1308 e *= inc1;
1309diff --git a/scripts/snarf-check-and-output-texi b/scripts/snarf-check-and-output-texi
1310index ea33e17..8cd42e8 100755
1311--- a/scripts/snarf-check-and-output-texi
1312+++ b/scripts/snarf-check-and-output-texi
1313@@ -267,6 +267,17 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
1314 (set! *file* file)
1315 (set! *line* line))
1316
1317+ ;; newer gccs like to throw around more location markers into the
1318+ ;; preprocessed source; these (hash . hash) bits are what they translate to
1319+ ;; in snarfy terms.
1320+ (('location ('string . file) ('int . line) ('hash . 'hash))
1321+ (set! *file* file)
1322+ (set! *line* line))
1323+
1324+ (('location ('hash . 'hash) ('string . file) ('int . line) ('hash . 'hash))
1325+ (set! *file* file)
1326+ (set! *line* line))
1327+
1328 (('arglist rest ...)
1329 (set! *args* (do-arglist rest)))
1330
1331diff --git a/srfi/srfi-19.scm b/srfi/srfi-19.scm
1332index ffce990..482ec4e 100644
1333--- a/srfi/srfi-19.scm
1334+++ b/srfi/srfi-19.scm
1335@@ -1,6 +1,6 @@
1336 ;;; srfi-19.scm --- Time/Date Library
1337
1338-;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
1339+;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
1340 ;;
1341 ;; This library is free software; you can redistribute it and/or
1342 ;; modify it under the terms of the GNU Lesser General Public
1343@@ -41,7 +41,8 @@
1344 (define-module (srfi srfi-19)
1345 :use-module (srfi srfi-6)
1346 :use-module (srfi srfi-8)
1347- :use-module (srfi srfi-9))
1348+ :use-module (srfi srfi-9)
1349+ :autoload (ice-9 rdelim) (read-line))
1350
1351 (begin-deprecated
1352 ;; Prevent `export' from re-exporting core bindings. This behaviour
1353@@ -339,7 +340,7 @@
1354 (set-tm:hour result (date-hour date))
1355 ;; FIXME: SRFI day ranges from 0-31. (not compatible with set-tm:mday).
1356 (set-tm:mday result (date-day date))
1357- (set-tm:month result (- (date-month date) 1))
1358+ (set-tm:mon result (- (date-month date) 1))
1359 ;; FIXME: need to signal error on range violation.
1360 (set-tm:year result (+ 1900 (date-year date)))
1361 (set-tm:isdst result -1)
1362@@ -528,33 +529,38 @@
1363 ;; -- these depend on time-monotonic having the same definition as time-tai!
1364 (define (time-monotonic->time-utc time-in)
1365 (if (not (eq? (time-type time-in) time-monotonic))
1366- (priv:time-error caller 'incompatible-time-types time-in))
1367+ (priv:time-error 'time-monotonic->time-utc
1368+ 'incompatible-time-types time-in))
1369 (let ((ntime (copy-time time-in)))
1370 (set-time-type! ntime time-tai)
1371 (priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc)))
1372
1373 (define (time-monotonic->time-utc! time-in)
1374 (if (not (eq? (time-type time-in) time-monotonic))
1375- (priv:time-error caller 'incompatible-time-types time-in))
1376+ (priv:time-error 'time-monotonic->time-utc!
1377+ 'incompatible-time-types time-in))
1378 (set-time-type! time-in time-tai)
1379- (priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc))
1380+ (priv:time-tai->time-utc! time-in time-in 'time-monotonic->time-utc))
1381
1382 (define (time-monotonic->time-tai time-in)
1383 (if (not (eq? (time-type time-in) time-monotonic))
1384- (priv:time-error caller 'incompatible-time-types time-in))
1385+ (priv:time-error 'time-monotonic->time-tai
1386+ 'incompatible-time-types time-in))
1387 (let ((ntime (copy-time time-in)))
1388 (set-time-type! ntime time-tai)
1389 ntime))
1390
1391 (define (time-monotonic->time-tai! time-in)
1392 (if (not (eq? (time-type time-in) time-monotonic))
1393- (priv:time-error caller 'incompatible-time-types time-in))
1394+ (priv:time-error 'time-monotonic->time-tai!
1395+ 'incompatible-time-types time-in))
1396 (set-time-type! time-in time-tai)
1397 time-in)
1398
1399 (define (time-utc->time-monotonic time-in)
1400 (if (not (eq? (time-type time-in) time-utc))
1401- (priv:time-error caller 'incompatible-time-types time-in))
1402+ (priv:time-error 'time-utc->time-monotonic
1403+ 'incompatible-time-types time-in))
1404 (let ((ntime (priv:time-utc->time-tai! time-in (make-time-unnormalized #f #f #f)
1405 'time-utc->time-monotonic)))
1406 (set-time-type! ntime time-monotonic)
1407@@ -562,7 +568,8 @@
1408
1409 (define (time-utc->time-monotonic! time-in)
1410 (if (not (eq? (time-type time-in) time-utc))
1411- (priv:time-error caller 'incompatible-time-types time-in))
1412+ (priv:time-error 'time-utc->time-monotonic!
1413+ 'incompatible-time-types time-in))
1414 (let ((ntime (priv:time-utc->time-tai! time-in time-in
1415 'time-utc->time-monotonic!)))
1416 (set-time-type! ntime time-monotonic)
1417@@ -570,14 +577,16 @@
1418
1419 (define (time-tai->time-monotonic time-in)
1420 (if (not (eq? (time-type time-in) time-tai))
1421- (priv:time-error caller 'incompatible-time-types time-in))
1422+ (priv:time-error 'time-tai->time-monotonic
1423+ 'incompatible-time-types time-in))
1424 (let ((ntime (copy-time time-in)))
1425 (set-time-type! ntime time-monotonic)
1426 ntime))
1427
1428 (define (time-tai->time-monotonic! time-in)
1429 (if (not (eq? (time-type time-in) time-tai))
1430- (priv:time-error caller 'incompatible-time-types time-in))
1431+ (priv:time-error 'time-tai->time-monotonic!
1432+ 'incompatible-time-types time-in))
1433 (set-time-type! time-in time-monotonic)
1434 time-in)
1435
1436@@ -780,7 +789,7 @@
1437 (define (priv:year-day day month year)
1438 (let ((days-pr (assoc month priv:month-assoc)))
1439 (if (not days-pr)
1440- (priv:error 'date-year-day 'invalid-month-specification month))
1441+ (priv:time-error 'date-year-day 'invalid-month-specification month))
1442 (if (and (priv:leap-year? year) (> month 2))
1443 (+ day (cdr days-pr) 1)
1444 (+ day (cdr days-pr)))))
1445@@ -1263,7 +1272,7 @@
1446 ((#\8) 8)
1447 ((#\9) 9)
1448 (else (priv:time-error 'bad-date-template-string
1449- (list "Non-integer character" ch i)))))
1450+ (list "Non-integer character" ch)))))
1451
1452 ;; read an integer upto n characters long on port; upto -> #f is any length
1453 (define (priv:integer-reader upto port)
1454diff --git a/srfi/srfi-35.scm b/srfi/srfi-35.scm
1455index 2035466..ee20a10 100644
1456--- a/srfi/srfi-35.scm
1457+++ b/srfi/srfi-35.scm
1458@@ -57,6 +57,19 @@
1459 (number->string (object-address ct)
1460 16))))))
1461
1462+(define (%make-condition-type layout id parent all-fields)
1463+ (let ((struct (make-struct %condition-type-vtable 0
1464+ (make-struct-layout layout) ;; layout
1465+ print-condition ;; printer
1466+ id parent all-fields)))
1467+
1468+ ;; Hack to associate STRUCT with a name, providing a better name for
1469+ ;; GOOPS classes as returned by `class-of' et al.
1470+ (set-struct-vtable-name! struct (cond ((symbol? id) id)
1471+ ((string? id) (string->symbol id))
1472+ (else (string->symbol ""))))
1473+ struct))
1474+
1475 (define (condition-type? obj)
1476 "Return true if OBJ is a condition type."
1477 (and (struct? obj)
1478@@ -104,10 +117,8 @@ supertypes."
1479 field-names parent-fields)))
1480 (let* ((all-fields (append parent-fields field-names))
1481 (layout (struct-layout-for-condition all-fields)))
1482- (make-struct %condition-type-vtable 0
1483- (make-struct-layout layout) ;; layout
1484- print-condition ;; printer
1485- id parent all-fields))
1486+ (%make-condition-type layout
1487+ id parent all-fields))
1488 (error "invalid condition type field names"
1489 field-names)))
1490 (error "parent is not a condition type" parent))
1491@@ -126,13 +137,10 @@ supertypes."
1492 (let* ((all-fields (append-map condition-type-all-fields
1493 parents))
1494 (layout (struct-layout-for-condition all-fields)))
1495- (make-struct %condition-type-vtable 0
1496- (make-struct-layout layout) ;; layout
1497- print-condition ;; printer
1498- id
1499- parents ;; list of parents!
1500- all-fields
1501- all-fields)))))
1502+ (%make-condition-type layout
1503+ id
1504+ parents ;; list of parents!
1505+ all-fields)))))
1506
1507
1508 ;;;
1509diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am
1510index e7cfd82..058ce93 100644
1511--- a/test-suite/standalone/Makefile.am
1512+++ b/test-suite/standalone/Makefile.am
1513@@ -28,7 +28,9 @@ check_SCRIPTS =
1514 BUILT_SOURCES =
1515 EXTRA_DIST =
1516
1517-TESTS_ENVIRONMENT = "${top_builddir}/pre-inst-guile-env"
1518+TESTS_ENVIRONMENT = \
1519+ builddir="$(builddir)" \
1520+ "${top_builddir}/pre-inst-guile-env"
1521
1522 test_cflags = \
1523 -I$(top_srcdir)/test-suite/standalone \
1524diff --git a/test-suite/standalone/test-asmobs b/test-suite/standalone/test-asmobs
1525index 2ea75d9..9689ab9 100755
1526--- a/test-suite/standalone/test-asmobs
1527+++ b/test-suite/standalone/test-asmobs
1528@@ -2,7 +2,8 @@
1529 exec guile -q -s "$0" "$@"
1530 !#
1531
1532-(load-extension "libtest-asmobs" "libtest_asmobs_init")
1533+(load-extension (string-append (getenv "builddir") "/libtest-asmobs")
1534+ "libtest_asmobs_init")
1535
1536 (define (test x v)
1537 (if v
1538diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c
1539index 41f99d3..caa835d 100644
1540--- a/test-suite/standalone/test-conversion.c
1541+++ b/test-suite/standalone/test-conversion.c
1542@@ -1,4 +1,4 @@
1543-/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
1544+/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
1545 *
1546 * This library is free software; you can redistribute it and/or
1547 * modify it under the terms of the GNU Lesser General Public
1548@@ -702,10 +702,8 @@ DEFSTST (scm_to_int16)
1549 DEFUTST (scm_to_uint16)
1550 DEFSTST (scm_to_int32)
1551 DEFUTST (scm_to_uint32)
1552-#ifdef SCM_HAVE_T_INT64
1553 DEFSTST (scm_to_int64)
1554 DEFUTST (scm_to_uint64)
1555-#endif
1556
1557 #define TEST_8S(v,f,r,re,te) test_8s (v, tst_##f, #f, r, re, te)
1558 #define TEST_8U(v,f,r,re,te) test_8u (v, tst_##f, #f, r, re, te)
1559@@ -745,11 +743,9 @@ test_int_sizes ()
1560 TEST_7S (scm_from_int32, SCM_T_INT32_MAX+1LL, "-2147483648");
1561 TEST_7U (scm_from_uint32, SCM_T_UINT32_MAX, "4294967295");
1562
1563-#if SCM_HAVE_T_INT64
1564 TEST_7S (scm_from_int64, SCM_T_INT64_MIN, "-9223372036854775808");
1565 TEST_7S (scm_from_int64, SCM_T_INT64_MAX, "9223372036854775807");
1566 TEST_7U (scm_from_uint64, SCM_T_UINT64_MAX, "18446744073709551615");
1567-#endif
1568
1569 TEST_8S ("91", scm_to_schar, 91, 0, 0);
1570 TEST_8U ("91", scm_to_uchar, 91, 0, 0);
1571@@ -794,7 +790,6 @@ test_int_sizes ()
1572 TEST_8U ("-1", scm_to_uint32, 0, 1, 0);
1573 TEST_8U ("#f", scm_to_uint32, 0, 0, 1);
1574
1575-#if SCM_HAVE_T_INT64
1576 TEST_8S ("-9223372036854775808", scm_to_int64, SCM_T_INT64_MIN, 0, 0);
1577 TEST_8S ("9223372036854775807", scm_to_int64, SCM_T_INT64_MAX, 0, 0);
1578 TEST_8S ("9223372036854775808", scm_to_int64, 0, 1, 0);
1579@@ -803,7 +798,6 @@ test_int_sizes ()
1580 TEST_8U ("18446744073709551616", scm_to_uint64, 0, 1, 0);
1581 TEST_8U ("-1", scm_to_uint64, 0, 1, 0);
1582 TEST_8U ("#f", scm_to_uint64, 0, 0, 1);
1583-#endif
1584
1585 }
1586
1587diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
1588index fa53fd2..fb2535a 100644
1589--- a/test-suite/tests/goops.test
1590+++ b/test-suite/tests/goops.test
1591@@ -140,7 +140,12 @@
1592 (eq? (class-of "foo") <string>))
1593
1594 (pass-if "port"
1595- (is-a? (%make-void-port "w") <port>)))
1596+ (is-a? (%make-void-port "w") <port>))
1597+
1598+ (pass-if "struct vtable"
1599+ ;; Previously, `class-of' would fail for nameless structs, i.e., structs
1600+ ;; for which `struct-vtable-name' is #f.
1601+ (is-a? (class-of (make-vtable-vtable "prprpr" 0)) <class>)))
1602
1603
1604 (with-test-prefix "defining classes"
1605diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test
1606index 4bfc415..e73f585 100644
1607--- a/test-suite/tests/socket.test
1608+++ b/test-suite/tests/socket.test
1609@@ -1,6 +1,6 @@
1610 ;;;; socket.test --- test socket functions -*- scheme -*-
1611 ;;;;
1612-;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
1613+;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
1614 ;;;;
1615 ;;;; This library is free software; you can redistribute it and/or
1616 ;;;; modify it under the terms of the GNU Lesser General Public
1617@@ -174,13 +174,28 @@
1618 ;;; AF_UNIX sockets and `make-socket-address'
1619 ;;;
1620
1621+(define %tmpdir
1622+ ;; Honor `$TMPDIR', which tmpnam(3) doesn't do.
1623+ (or (getenv "TMPDIR") "/tmp"))
1624+
1625+(define %curdir
1626+ ;; Remember the current working directory.
1627+ (getcwd))
1628+
1629+;; Temporarily cd to %TMPDIR. The goal is to work around path name
1630+;; limitations, which can lead to exceptions like:
1631+;;
1632+;; (misc-error "scm_to_sockaddr"
1633+;; "unix address path too long: ~A"
1634+;; ("/tmp/nix-build-fb7bph4ifh0vr3ihigm702dzffdnapfj-guile-coverage-1.9.5.drv-0/guile-test-socket-1258553296-77619")
1635+;; #f)
1636+(chdir %tmpdir)
1637+
1638 (define (temp-file-path)
1639- ;; Return a temporary file path that honors `$TMPDIR', which `tmpnam'
1640- ;; doesn't do.
1641- (let ((dir (or (getenv "TMPDIR") "/tmp")))
1642- (string-append dir "/guile-test-socket-"
1643- (number->string (current-time)) "-"
1644- (number->string (random 100000)))))
1645+ ;; Return a temporary file name, assuming the current directory is %TMPDIR.
1646+ (string-append "guile-test-socket-"
1647+ (number->string (current-time)) "-"
1648+ (number->string (random 100000))))
1649
1650
1651 (if (defined? 'AF_UNIX)
1652@@ -320,3 +335,91 @@
1653
1654 #t)))
1655
1656+
1657+(if (defined? 'AF_INET6)
1658+ (with-test-prefix "AF_INET6/SOCK_STREAM"
1659+
1660+ ;; testing `bind', `listen' and `connect' on stream-oriented sockets
1661+
1662+ (let ((server-socket (socket AF_INET6 SOCK_STREAM 0))
1663+ (server-bound? #f)
1664+ (server-listening? #f)
1665+ (server-pid #f)
1666+ (ipv6-addr 1) ; ::1
1667+ (server-port 8889)
1668+ (client-port 9998))
1669+
1670+ (pass-if "bind"
1671+ (catch 'system-error
1672+ (lambda ()
1673+ (bind server-socket AF_INET6 ipv6-addr server-port)
1674+ (set! server-bound? #t)
1675+ #t)
1676+ (lambda args
1677+ (let ((errno (system-error-errno args)))
1678+ (cond ((= errno EADDRINUSE) (throw 'unresolved))
1679+ (else (apply throw args)))))))
1680+
1681+ (pass-if "bind/sockaddr"
1682+ (let* ((sock (socket AF_INET6 SOCK_STREAM 0))
1683+ (sockaddr (make-socket-address AF_INET6 ipv6-addr client-port)))
1684+ (catch 'system-error
1685+ (lambda ()
1686+ (bind sock sockaddr)
1687+ #t)
1688+ (lambda args
1689+ (let ((errno (system-error-errno args)))
1690+ (cond ((= errno EADDRINUSE) (throw 'unresolved))
1691+ (else (apply throw args))))))))
1692+
1693+ (pass-if "listen"
1694+ (if (not server-bound?)
1695+ (throw 'unresolved)
1696+ (begin
1697+ (listen server-socket 123)
1698+ (set! server-listening? #t)
1699+ #t)))
1700+
1701+ (if server-listening?
1702+ (let ((pid (primitive-fork)))
1703+ ;; Spawn a server process.
1704+ (case pid
1705+ ((-1) (throw 'unresolved))
1706+ ((0) ;; the kid: serve two connections and exit
1707+ (let serve ((conn
1708+ (false-if-exception (accept server-socket)))
1709+ (count 1))
1710+ (if (not conn)
1711+ (exit 1)
1712+ (if (> count 0)
1713+ (serve (false-if-exception (accept server-socket))
1714+ (- count 1)))))
1715+ (exit 0))
1716+ (else ;; the parent
1717+ (set! server-pid pid)
1718+ #t))))
1719+
1720+ (pass-if "connect"
1721+ (if (not server-pid)
1722+ (throw 'unresolved)
1723+ (let ((s (socket AF_INET6 SOCK_STREAM 0)))
1724+ (connect s AF_INET6 ipv6-addr server-port)
1725+ #t)))
1726+
1727+ (pass-if "connect/sockaddr"
1728+ (if (not server-pid)
1729+ (throw 'unresolved)
1730+ (let ((s (socket AF_INET6 SOCK_STREAM 0)))
1731+ (connect s (make-socket-address AF_INET6 ipv6-addr server-port))
1732+ #t)))
1733+
1734+ (pass-if "accept"
1735+ (if (not server-pid)
1736+ (throw 'unresolved)
1737+ (let ((status (cdr (waitpid server-pid))))
1738+ (eq? 0 (status:exit-val status)))))
1739+
1740+ #t)))
1741+
1742+;; Switch back to the previous directory.
1743+(false-if-exception (chdir %curdir))
diff --git a/meta-oe/recipes-support/guile/guile-1.8.7/configure-fix.patch b/meta-oe/recipes-support/guile/guile-1.8.7/configure-fix.patch
deleted file mode 100644
index c59798d9e..000000000
--- a/meta-oe/recipes-support/guile/guile-1.8.7/configure-fix.patch
+++ /dev/null
@@ -1,10 +0,0 @@
1--- /tmp/configure.in 2008-06-04 12:33:55.451086283 +0200
2+++ guile-1.8.5/configure.in 2008-06-04 12:34:03.974994278 +0200
3@@ -38,7 +38,6 @@
4 ]),
5 [bug-guile@gnu.org])
6 AC_CONFIG_AUX_DIR([build-aux])
7-AC_CONFIG_MACRO_DIR([m4])
8 AC_CONFIG_SRCDIR(GUILE-VERSION)
9
10 AM_INIT_AUTOMAKE([gnu no-define check-news])
diff --git a/meta-oe/recipes-support/guile/guile-native-1.8.7/cpp-linemarkers.patch b/meta-oe/recipes-support/guile/guile-native-1.8.7/cpp-linemarkers.patch
deleted file mode 100644
index 3e48932a3..000000000
--- a/meta-oe/recipes-support/guile/guile-native-1.8.7/cpp-linemarkers.patch
+++ /dev/null
@@ -1,8 +0,0 @@
1--- guile.orig/libguile/guile-snarf-docs.in 2009-07-03 18:19:00.000000000 -0400
2+++ guile/libguile/guile-snarf-docs.in 2009-11-19 12:55:32.487266268 -0500
3@@ -23,4 +23,4 @@
4 ## Let the user override the preprocessor autoconf found.
5 test -n "${CPP+set}" || CPP="@CPP@"
6
7-${CPP} -DSCM_MAGIC_SNARF_DOCS "$@"
8+${CPP} -P -DSCM_MAGIC_SNARF_DOCS "$@"
diff --git a/meta-oe/recipes-support/guile/guile-native-1.8.7/reloc.patch b/meta-oe/recipes-support/guile/guile-native-1.8.7/reloc.patch
deleted file mode 100644
index c061743ab..000000000
--- a/meta-oe/recipes-support/guile/guile-native-1.8.7/reloc.patch
+++ /dev/null
@@ -1,22 +0,0 @@
1--- guile-1.8.7.orig/guile-tools.in
2+++ guile-1.8.7/guile-tools.in
3@@ -42,14 +42,15 @@ Default scripts dir: $default_scriptsdir
4 EOF
5 }
6
7-prefix="@prefix@"
8-datarootdir="@datarootdir@"
9-pkgdatadir="@datadir@/@PACKAGE@"
10+bindir=`dirname $0`
11+bindir=`cd $bindir && pwd`
12+prefix=`dirname $bindir`
13+datarootdir=${prefix}/share
14+pkgdatadir=${prefix}/share/guile
15 guileversion="@GUILE_EFFECTIVE_VERSION@"
16 default_scriptsdir=$pkgdatadir/$guileversion/scripts
17
18 # pre-install invocation frob
19-mydir=`dirname $0`
20 if [ -d "$mydir/scripts" -a -f "$mydir/scripts/Makefile.am" ] ; then
21 default_scriptsdir=`(cd $mydir/scripts ; pwd)`
22 fi
diff --git a/meta-oe/recipes-support/guile/guile-native.inc b/meta-oe/recipes-support/guile/guile-native.inc
deleted file mode 100644
index dfa126af0..000000000
--- a/meta-oe/recipes-support/guile/guile-native.inc
+++ /dev/null
@@ -1,13 +0,0 @@
1SECTION = "unknown"
2DEPENDS = "gettext-native gmp-native"
3
4LICENSE = "LGPLv2.1"
5
6inherit autotools native
7
8S="${WORKDIR}/guile-${PV}"
9
10do_configure_append() {
11 find ${S} -name Makefile | xargs sed -i s:'-Werror':'':g
12}
13
diff --git a/meta-oe/recipes-support/guile/guile-native_1.8.7.bb b/meta-oe/recipes-support/guile/guile-native_1.8.7.bb
deleted file mode 100644
index 2b2707abe..000000000
--- a/meta-oe/recipes-support/guile/guile-native_1.8.7.bb
+++ /dev/null
@@ -1,13 +0,0 @@
1require guile-native.inc
2
3LIC_FILES_CHKSUM = "file://LICENSE;md5=c9ba0d76ca3ef2a1d15a2ac839ef01fa"
4
5PR = "r1"
6SRC_URI = "http://ftp.gnu.org/pub/gnu/guile/guile-${PV}.tar.gz \
7 file://configure-fix.patch \
8 file://cpp-linemarkers.patch \
9 file://reloc.patch \
10 "
11
12SRC_URI[md5sum] = "991b5b3efcbbc3f7507d05bc42f80a5e"
13SRC_URI[sha256sum] = "bfee6339d91955a637e7f541d96f5b1d53271b42bb4a37b8867d186a6c66f0b3"
diff --git a/meta-oe/recipes-support/guile/guile.inc b/meta-oe/recipes-support/guile/guile.inc
deleted file mode 100644
index 842e8d7eb..000000000
--- a/meta-oe/recipes-support/guile/guile.inc
+++ /dev/null
@@ -1,47 +0,0 @@
1DESCRIPTION = "Guile is an interpreter for the Scheme programming language, \
2packaged as a library which can be incorporated into your programs."
3HOMEPAGE = "http://www.gnu.org/software/guile/guile.html"
4SECTION = "devel/scheme"
5DEPENDS = "guile-native gmp libtool"
6PACKAGES =+ "${PN}-el"
7FILES_${PN}-el = "${datadir}/emacs"
8DESCRIPTION_${PN}-el = "Emacs lisp files for Guile"
9
10LICENSE = "LGPLv2.1+"
11
12inherit autotools gettext
13
14acpaths = "-I ${S}/guile-config"
15
16EXTRA_OECONF = " \
17 --without-threads \
18 --without-included-ltdl \
19 "
20
21do_compile() {
22 for i in $(find ${S} -name "Makefile") ; do
23 sed -i -e s:-Werror::g $i
24 done
25
26 (cd libguile; oe_runmake CC="${BUILD_CC}" CFLAGS="${BUILD_CFLAGS}" LDFLAGS="${BUILD_LDFLAGS}" guile_filter_doc_snarfage)
27 oe_runmake preinstguile="`which guile`"
28
29 sed -i -e s:${STAGING_DIR_TARGET}::g \
30 -e s:/${TARGET_SYS}::g \
31 -e s:-L/usr/lib::g \
32 -e s:-isystem/usr/include::g \
33 -e s:,/usr/lib:,\$\{libdir\}:g \
34 guile-1.8.pc
35}
36
37SYSROOT_PREPROCESS_FUNCS = "guile_cross_config"
38
39guile_cross_config() {
40 # Create guile-config returning target values instead of native values
41 install -d ${SYSROOT_DESTDIR}${STAGING_BINDIR_CROSS}
42 echo '#!'`which guile`$' \\\n-e main -s\n!#\n(define %guile-build-info '\'\( >guile-config.cross
43 sed -n $'s:-isystem[^ ]* ::;s:-Wl,-rpath-link,[^ ]* ::;s:^[ \t]*{[ \t]*": (:;s:",[ \t]*": . ":;s:" *}, *\\\\:"):;/^ (/p' <libguile/libpath.h >>guile-config.cross
44 echo '))' >>guile-config.cross
45 cat guile-config/guile-config >>guile-config.cross
46 install guile-config.cross ${SYSROOT_DESTDIR}${STAGING_BINDIR_CROSS}/guile-config
47}
diff --git a/meta-oe/recipes-support/guile/guile_1.8.7.bb b/meta-oe/recipes-support/guile/guile_1.8.7.bb
deleted file mode 100644
index d02fe42e5..000000000
--- a/meta-oe/recipes-support/guile/guile_1.8.7.bb
+++ /dev/null
@@ -1,14 +0,0 @@
1require guile.inc
2
3LIC_FILES_CHKSUM = "file://LICENSE;md5=5711ae313ffd140741e741b88d9d4007"
4
5PR = "r1"
6
7SRC_URI = "http://ftp.gnu.org/pub/gnu/guile/guile-${PV}.tar.gz \
8 file://configure-fix.patch \
9 file://18.diff \
10 "
11
12
13SRC_URI[md5sum] = "991b5b3efcbbc3f7507d05bc42f80a5e"
14SRC_URI[sha256sum] = "bfee6339d91955a637e7f541d96f5b1d53271b42bb4a37b8867d186a6c66f0b3"
generated by cgit v1.2.3-54-g00ecf (git 2.39.0) at 2024-11-14 20:08:21 +0000