From 713526ad211f010bcec0de74362a567d4b6a2ebb Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 13 May 2002 21:45:57 +0000 Subject: [PATCH 001/306] *** empty log message *** --- scripts/ChangeLog | 2 ++ 1 file changed, 2 insertions(+) diff --git a/scripts/ChangeLog b/scripts/ChangeLog index c4146b53b..c4e9c0beb 100644 --- a/scripts/ChangeLog +++ b/scripts/ChangeLog @@ -4,6 +4,8 @@ * Makefile.am (scripts_sources): Add api-diff and read-rfc822. + * scan-api (scan-api): No longer include timestamp. + 2002-05-11 Thien-Thi Nguyen * scan-api (scan-api): Fix bug: No longer omit `C' and `Scheme' in From 04a68c378db580903a8af5480f9de00506a111af Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 14 May 2002 08:51:29 +0000 Subject: [PATCH 002/306] *** empty log message *** --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index a0509c528..aa83367a7 100644 --- a/THANKS +++ b/THANKS @@ -2,6 +2,7 @@ Contributors since the last release: Rob Browning Stefan Jahn + Thien-Thi Nguyen Sponsors since the last release: From 37354cb7b96fca688ff4d15d6852e71aa160796f Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Tue, 14 May 2002 09:24:18 +0000 Subject: [PATCH 003/306] For I386/OPENBSD, allow for `__i386__' in addition to `i386'. --- libguile/gc_os_dep.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/gc_os_dep.c b/libguile/gc_os_dep.c index 55864acb3..89346c705 100644 --- a/libguile/gc_os_dep.c +++ b/libguile/gc_os_dep.c @@ -254,7 +254,7 @@ typedef int GC_bool; # define NEXT # define mach_type_known # endif -# if defined(__OpenBSD__) && defined(i386) +# if defined(__OpenBSD__) && (defined(i386) || defined(__i386__)) # define I386 # define OPENBSD # define mach_type_known From 74c581316a3fecf056da463d8caae30119b28d3b Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Tue, 14 May 2002 09:25:26 +0000 Subject: [PATCH 004/306] *** empty log message *** --- libguile/ChangeLog | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index daea0bcd3..2b5ca7ecd 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-05-14 Thien-Thi Nguyen + + * gc_os_dep.c: For I386/OPENBSD, allow for `__i386__' + in addition to `i386'. + 2002-05-08 Marius Vollmer * eq.c (real_eqv): New. @@ -8,14 +13,14 @@ (scm_leq_p, scm_geq_p): Explicitely return #f when comparing a NaN. (scm_inexact_to_exact): Signal error when converting a NaN. - + 2002-05-06 Marius Vollmer * posix.c (scm_putenv): Handle removing variables explicitely by calling unsetenv. From John W. Eaton. - + * numbers.h: Conditionally include floatingpoint.h, ieeefp.h, and nan.h. Provide declarations for scm_inf_p, scm_nan_p, scn_inf, and scm_nan. @@ -43,7 +48,7 @@ NaN. They will provide their own sign. (scm_divide): Only allow divides by inexact zeros. Dividing by exact zeros still signals an errors. - + 2002-04-22 Thien-Thi Nguyen * goops.h (scm_slot_exists_p): Rename from scm_slots_exists_p. From 0926d46e069e07bf56b387c9b00a2d9f893a5eb4 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Tue, 14 May 2002 09:26:49 +0000 Subject: [PATCH 005/306] *** empty log message *** --- libguile/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2b5ca7ecd..6463c7396 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,7 +1,7 @@ 2002-05-14 Thien-Thi Nguyen * gc_os_dep.c: For I386/OPENBSD, allow for `__i386__' - in addition to `i386'. + in addition to `i386'. Thanks to Dale P. Smith. 2002-05-08 Marius Vollmer From ef018514daab61fb65f618b3f4fc8494d7b96dc3 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Sun, 19 May 2002 05:12:04 +0000 Subject: [PATCH 006/306] (group-diff): Also output +N and -N adds and subs details, respectively. --- scripts/api-diff | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/scripts/api-diff b/scripts/api-diff index cee9668ca..433ff0f45 100755 --- a/scripts/api-diff +++ b/scripts/api-diff @@ -113,11 +113,23 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (old-count (and old (length old))) (new-count (and new (length new))) (delta (and old new (- new-count old-count)))) - (format #t " ~5@A ~5@A ~5@A ~A\n" + (format #t " ~5@A ~5@A : " (or old-count "-") - (or new-count "-") - (or delta "-") - group))) + (or new-count "-")) + (cond ((and old new) + (let ((add-count 0) (sub-count 0)) + (diff+note! + old new + (lambda (subs) + (set! sub-count (length subs))) + (lambda (adds) + (set! add-count (length adds))) + (lambda () #t)) + (format #t "~5@D ~5@D : ~5@D" + add-count (- sub-count) delta))) + (else + (format #t "~5@A ~5@A : ~5@A" "-" "-" "-"))) + (format #t " ~A\n" group))) (sort (union g-old-names g-new-names) (lambda (a b) (stringstring a) From 9664b7ef6ea90ae6c9154245edca121e52180553 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Sun, 19 May 2002 05:12:42 +0000 Subject: [PATCH 007/306] *** empty log message *** --- scripts/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/scripts/ChangeLog b/scripts/ChangeLog index c4e9c0beb..e6b36f8f1 100644 --- a/scripts/ChangeLog +++ b/scripts/ChangeLog @@ -1,3 +1,8 @@ +2002-05-18 Thien-Thi Nguyen + + * api-diff (group-diff): Also output +N and -N adds and subs + details, respectively. + 2002-05-13 Thien-Thi Nguyen * read-rfc822: New script. From e9527dd63d0305acd9f23a5bc61118d83afa6e7b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 22 May 2002 13:49:42 +0000 Subject: [PATCH 008/306] (AC_CHECK_FUNCS): Check for copysign. --- configure.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.in b/configure.in index 37e9b3d23..056fb483f 100644 --- a/configure.in +++ b/configure.in @@ -505,7 +505,7 @@ AC_REPLACE_FUNCS(inet_aton putenv strerror memmove mkstemp) AC_CHECK_HEADERS(floatingpoint.h ieeefp.h nan.h) -AC_CHECK_FUNCS(finite isinf isnan) +AC_CHECK_FUNCS(finite isinf isnan copysign) # When testing for the presence of alloca, we need to add alloca.o # explicitly to LIBOBJS to make sure that it is translated to From abb7e44d1612720a02f3d8bf4883aa1c2e30180b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 22 May 2002 13:50:20 +0000 Subject: [PATCH 009/306] (idbl2str): Don't omit sign when printing negative zero. --- libguile/numbers.c | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index c1f2d93e9..3a50f6c20 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -2076,7 +2076,16 @@ idbl2str (double f, char *a) int exp = 0; if (f == 0.0) - goto zero; /*{a[0]='0'; a[1]='.'; a[2]='0'; return 3;} */ + { +#ifdef HAVE_COPYSIGN + double sgn = copysign (1.0, f); + + if (sgn < 0.0) + a[ch++] = '-'; +#endif + + goto zero; /*{a[0]='0'; a[1]='.'; a[2]='0'; return 3;} */ + } if (xisinf (f)) { From ba1b077b8627688436c0f767c11ffbd7b38cb0e7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 22 May 2002 13:50:43 +0000 Subject: [PATCH 010/306] *** empty log message *** --- ChangeLog | 6 ++++++ NEWS | 15 +++++++++++++++ libguile/ChangeLog | 6 ++++++ 3 files changed, 27 insertions(+) diff --git a/ChangeLog b/ChangeLog index c864261cc..70d26ac1f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2002-05-22 Marius Vollmer + + From John W. Eaton + + * configure.in (AC_CHECK_FUNCS): Check for copysign. + 2002-05-10 Marius Vollmer * libguile.h: Added inclusion of "extensions.h". diff --git a/NEWS b/NEWS index e4f2aac72..d6463593e 100644 --- a/NEWS +++ b/NEWS @@ -50,6 +50,21 @@ For example Two new predicates 'inf?' and 'nan?' can be used to test for the special values. +** Inexact zero can have a sign. + +Guile can now distinguish between plus and minus inexact zero, if your +platform supports this, too. The two zeros are equal according to +'=', but not according to 'eqv?'. For example + + (- 0.0) + => -0.0 + + (= 0.0 (- 0.0)) + => #t + + (eqv? 0.0 (- 0.0)) + => #f + ** We now have uninterned symbols. The new function 'make-symbol' will return a uninterned symbol. This diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 6463c7396..d7b2d9737 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-05-22 Marius Vollmer + + From John W. Eaton + + * numbers.c (idbl2str): Don't omit sign when printing negative zero. + 2002-05-14 Thien-Thi Nguyen * gc_os_dep.c: For I386/OPENBSD, allow for `__i386__' From 164d248174b367db558288080e2270434b6b5301 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 22 May 2002 19:55:40 +0000 Subject: [PATCH 011/306] * numbers.c (mem2ureal): When returning an inexact zero, make sure it is represented as a floating point value so that we can change its sign. --- libguile/numbers.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 3a50f6c20..31dfb33fc 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -2678,6 +2678,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, unsigned int radix, enum t_exactness *p_exactness) { unsigned int idx = *p_idx; + SCM result; if (idx == len) return SCM_BOOL_F; @@ -2709,14 +2710,13 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, else if (!isdigit (mem[idx + 1])) return SCM_BOOL_F; else - return mem2decimal_from_point (SCM_MAKINUM (0), mem, len, - p_idx, p_exactness); + result = mem2decimal_from_point (SCM_MAKINUM (0), mem, len, + p_idx, p_exactness); } else { enum t_exactness x = EXACT; SCM uinteger; - SCM result; uinteger = mem2uinteger (mem, len, &idx, radix, &x); if (SCM_FALSEP (uinteger)) @@ -2748,9 +2748,15 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, *p_idx = idx; if (x == INEXACT) *p_exactness = x; - - return result; } + + /* When returning an inexact zero, make sure it is represented as a + floating point value so that we can change its sign. + */ + if (SCM_EQ_P (result, SCM_MAKINUM(0)) && *p_exactness == INEXACT) + result = scm_make_real (0.0); + + return result; } From 8dc434c78d9058611d42ad15cec3d020cab723ff Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 22 May 2002 19:55:56 +0000 Subject: [PATCH 012/306] *** empty log message *** --- libguile/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d7b2d9737..45c111c3b 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,9 @@ 2002-05-22 Marius Vollmer + * numbers.c (mem2ureal): When returning an inexact zero, make sure + it is represented as a floating point value so that we can change + its sign. + From John W. Eaton * numbers.c (idbl2str): Don't omit sign when printing negative zero. From 57e2f421ddb2361114442d8312f09a08a1a171f6 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 1 Jun 2002 16:06:27 +0000 Subject: [PATCH 013/306] Added exception notice to license statement. --- libguile/mkstemp.c | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/libguile/mkstemp.c b/libguile/mkstemp.c index 795132ce7..6e35f40df 100644 --- a/libguile/mkstemp.c +++ b/libguile/mkstemp.c @@ -15,7 +15,31 @@ You should have received a copy of the GNU Library General Public License along with the GNU C Library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ + Boston, MA 02111-1307, USA. + + As a special exception, the Free Software Foundation gives permission + for additional uses of the text contained in its release of GUILE. + + The exception is that, if you link the GUILE library with other files + to produce an executable, this does not by itself cause the + resulting executable to be covered by the GNU General Public License. + Your use of that executable is in no way restricted on account of + linking the GUILE library code into it. + + This exception does not however invalidate any other reasons why + the executable file might be covered by the GNU General Public License. + + This exception applies only to the code released by the + Free Software Foundation under the name GUILE. If you copy + code from other Free Software Foundation releases into a copy of + GUILE, as the General Public License permits, the exception does + not apply to the code that you add in this way. To avoid misleading + anyone as to the status of such modified files, you must delete + this exception notice from them. + + If you write modifications of your own for GUILE, it is your choice + whether to permit this exception to apply to your modifications. + If you do not wish that, delete this exception notice. */ #include "libguile/scmconfig.h" From 4c1ffcdda19fc45338a02a5f75cc1fd2636f6ea8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 1 Jun 2002 16:06:50 +0000 Subject: [PATCH 014/306] *** empty log message *** --- libguile/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 45c111c3b..9bbfacfdb 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-06-01 Marius Vollmer + + * mkstemp.c: Added exception notice to license statement. + 2002-05-22 Marius Vollmer * numbers.c (mem2ureal): When returning an inexact zero, make sure From f68acbb4b4006e83e7f5da2fa6a6d1468526625b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 1 Jun 2002 16:16:49 +0000 Subject: [PATCH 015/306] (file-set-position): Use seek instead of fseek. --- ice-9/boot-9.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 7dfa381aa..73878cdb6 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -526,7 +526,7 @@ (define (tms:cstime obj) (vector-ref obj 4)) (define (file-position . args) (apply ftell args)) -(define (file-set-position . args) (apply fseek args)) +(define (file-set-position . args) (apply seek args)) (define (move->fdes fd/port fd) (cond ((integer? fd/port) From be87cdb70431c087b96f483f1c9a2770cce76f36 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 1 Jun 2002 16:16:59 +0000 Subject: [PATCH 016/306] *** empty log message *** --- ice-9/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 734d2cdb2..a7201200e 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,7 @@ +2002-06-01 Marius Vollmer + + * boot-9.scm (file-set-position): Use seek instead of fseek. + 2002-05-09 Marius Vollmer * format.scm (format:out-inf-nan): New. From 1334c61ab0b971624e05993094b1c9b1d88c3b85 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sat, 1 Jun 2002 17:14:17 +0000 Subject: [PATCH 017/306] * boot-9.scm (file-set-position): use seek, not fseek. Make third argument optional, for better SCM compatibility. (file-position): simplify definition. --- ice-9/ChangeLog | 6 ++++++ ice-9/boot-9.scm | 6 ++++-- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index a7201200e..ae3084e87 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,9 @@ +2002-06-01 Gary Houston + + * boot-9.scm (file-set-position): Make third argument optional, + for SCM compatibility. + (file-position): simplify definition. + 2002-06-01 Marius Vollmer * boot-9.scm (file-set-position): Use seek instead of fseek. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 73878cdb6..e51bf39bd 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -525,8 +525,10 @@ (define (tms:cutime obj) (vector-ref obj 3)) (define (tms:cstime obj) (vector-ref obj 4)) -(define (file-position . args) (apply ftell args)) -(define (file-set-position . args) (apply seek args)) +(define file-position ftell) +(define (file-set-position port offset . whence) + (let ((whence (if (eq? whence '()) SEEK_SET (car whence)))) + (seek port offset whence))) (define (move->fdes fd/port fd) (cond ((integer? fd/port) From ba4271760f3419cdc44ddff965d9b30102b41f8e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 17 Jun 2002 23:30:20 +0000 Subject: [PATCH 018/306] (scm_simple_format): Print missing part of format before ~% control. Thanks to Daniel Skarda! --- libguile/print.c | 1 + 1 file changed, 1 insertion(+) diff --git a/libguile/print.c b/libguile/print.c index cb80e073e..fd869402a 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -969,6 +969,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, start = p + 1; continue; case '%': + scm_lfwrite (start, p - start - 1, destination); scm_newline (destination); start = p + 1; continue; From e540802f9cfd2d3ce72111af3c3f4fab21c4d1ad Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 17 Jun 2002 23:30:36 +0000 Subject: [PATCH 019/306] *** empty log message *** --- libguile/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 9bbfacfdb..4812ef143 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-06-18 Marius Vollmer + + * print.c (scm_simple_format): Print missing part of format before + ~% control. Thanks to Daniel Skarda! + 2002-06-01 Marius Vollmer * mkstemp.c: Added exception notice to license statement. From 23de7b97e963e5f5e09570639ac6d233865e11ee Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 19 Jun 2002 11:41:13 +0000 Subject: [PATCH 020/306] Bettered wording for inf? and nan? procedures. --- doc/ref/scheme-data.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index 7d0b01f26..fc4a84afd 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -379,11 +379,11 @@ precision. @deffn {Scheme Procedure} inf? x Return @code{#t} if @var{x} is either @samp{+inf.0} or @samp{-inf.0}, -code @var{#f} otherwise. +@code{#f} otherwise. @end deffn @deffn {Scheme Procedure} nan? x -Return @code{#t} if @var{x} is @samp{+nan.0}, code @var{#f} otherwise. +Return @code{#t} if @var{x} is @samp{+nan.0}, @code{#f} otherwise. @end deffn @node Complex Numbers From c136c9205ea6d375ad554c2ee3a1014732042d89 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Fri, 28 Jun 2002 22:40:08 +0000 Subject: [PATCH 021/306] * __scm.h, eval.c, eval.h: Removed compile time option MEMOIZE_LOCALS to clean up the code. Now, caching of local variable positions during memoization is mandatory. However, the option to disable the caching has most probably not been used anyway. --- NEWS | 6 ++++++ libguile/ChangeLog | 8 ++++++++ libguile/__scm.h | 5 ----- libguile/eval.c | 21 --------------------- libguile/eval.h | 4 ---- 5 files changed, 14 insertions(+), 30 deletions(-) diff --git a/NEWS b/NEWS index d6463593e..68431fd3e 100644 --- a/NEWS +++ b/NEWS @@ -167,6 +167,12 @@ used instead, obtained from scm_current_input_port () etc. If an application needs to retain earlier ports, it should save them in a gc-protected location. +** Removed compile time option MEMOIZE_LOCALS + +Now, caching of local variable positions during memoization is mandatory. +However, the option to disable the caching has most probably not been used +anyway. + ** Removed definitions: scm_lisp_nil, scm_lisp_t, s_nil_ify, scm_m_nil_ify, s_t_ify, scm_m_t_ify, s_0_cond, scm_m_0_cond, s_0_ify, scm_m_0_ify, s_1_ify, scm_m_1_ify, scm_debug_newcell, scm_debug_newcell2, scm_tc16_allocated, diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 4812ef143..dfb6d67df 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,11 @@ +2002-06-28 Dirk Herrmann + + * __scm.h, eval.c, eval.h: Removed compile time option + MEMOIZE_LOCALS to clean up the code. Now, caching of local + variable positions during memoization is mandatory. However, the + option to disable the caching has most probably not been used + anyway. + 2002-06-18 Marius Vollmer * print.c (scm_simple_format): Print missing part of format before diff --git a/libguile/__scm.h b/libguile/__scm.h index 986797c57..b437f6d5b 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -112,11 +112,6 @@ #undef SCM_RECKLESS #define SCM_CAUTIOUS -/* After looking up a local for the first time, rewrite the - * code graph, caching its position. - */ -#define MEMOIZE_LOCALS - /* All the number support there is. */ #define BIGNUMS diff --git a/libguile/eval.c b/libguile/eval.c index 2eb1367ed..a41a16a21 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -152,8 +152,6 @@ char *alloca (); #define EXTEND_ENV SCM_EXTEND_ENV -#ifdef MEMOIZE_LOCALS - SCM * scm_ilookup (SCM iloc, SCM env) { @@ -168,7 +166,6 @@ scm_ilookup (SCM iloc, SCM env) return SCM_CDRLOC (er); return SCM_CARLOC (SCM_CDR (er)); } -#endif #ifdef USE_THREADS @@ -259,9 +256,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check) { SCM env = genv; register SCM *al, fl, var = SCM_CAR (vloc); -#ifdef MEMOIZE_LOCALS register SCM iloc = SCM_ILOC00; -#endif for (; SCM_NIMP (env); env = SCM_CDR (env)) { if (!SCM_CONSP (SCM_CAR (env))) @@ -273,13 +268,11 @@ scm_lookupcar (SCM vloc, SCM genv, int check) { if (SCM_EQ_P (fl, var)) { -#ifdef MEMOIZE_LOCALS #ifdef USE_THREADS if (! SCM_EQ_P (SCM_CAR (vloc), var)) goto race; #endif SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (iloc) + SCM_ICDR); -#endif return SCM_CDRLOC (*al); } else @@ -288,7 +281,6 @@ scm_lookupcar (SCM vloc, SCM genv, int check) al = SCM_CDRLOC (*al); if (SCM_EQ_P (SCM_CAR (fl), var)) { -#ifdef MEMOIZE_LOCALS #ifndef SCM_RECKLESS /* letrec inits to SCM_UNDEFINED */ if (SCM_UNBNDP (SCM_CAR (*al))) { @@ -301,16 +293,11 @@ scm_lookupcar (SCM vloc, SCM genv, int check) goto race; #endif SCM_SETCAR (vloc, iloc); -#endif return SCM_CARLOC (*al); } -#ifdef MEMOIZE_LOCALS iloc = SCM_PACK (SCM_UNPACK (iloc) + SCM_IDINC); -#endif } -#ifdef MEMOIZE_LOCALS iloc = SCM_PACK ((~SCM_IDSTMSK) & (SCM_UNPACK(iloc) + SCM_IFRINC)); -#endif } { SCM top_thunk, real_var; @@ -360,10 +347,8 @@ scm_lookupcar (SCM vloc, SCM genv, int check) var = SCM_CAR (vloc); if (SCM_VARIABLEP (var)) return SCM_VARIABLE_LOC (var); -#ifdef MEMOIZE_LOCALS if (SCM_ITAG7 (var) == SCM_ITAG7 (SCM_ILOC00)) return scm_ilookup (var, genv); -#endif /* We can't cope with anything else than variables and ilocs. When a special form has been memoized (i.e. `let' into `#@let') we return NULL and expect the calling function to do the right @@ -408,7 +393,6 @@ scm_unmemocar (SCM form, SCM env) sym = sym_three_question_marks; SCM_SETCAR (form, sym); } -#ifdef MEMOIZE_LOCALS else if (SCM_ILOCP (c)) { unsigned long int ir; @@ -420,7 +404,6 @@ scm_unmemocar (SCM form, SCM env) env = SCM_CDR (env); SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env)); } -#endif return form; } } @@ -2313,11 +2296,9 @@ dispatch: { SCM *location; SCM variable = SCM_CAR (x); -#ifdef MEMOIZE_LOCALS if (SCM_ILOCP (variable)) location = scm_ilookup (variable, env); else -#endif if (SCM_VARIABLEP (variable)) location = SCM_VARIABLE_LOC (variable); else /* (SCM_SYMBOLP (variable)) is known to be true */ @@ -2713,7 +2694,6 @@ dispatch: case scm_tc7_variable: RETURN (SCM_VARIABLE_REF(x)); -#ifdef MEMOIZE_LOCALS case SCM_BIT8(SCM_ILOC00): proc = *scm_ilookup (SCM_CAR (x), env); SCM_ASRTGO (SCM_NIMP (proc), badfun); @@ -2723,7 +2703,6 @@ dispatch: #endif #endif break; -#endif /* ifdef MEMOIZE_LOCALS */ case scm_tcs_cons_nimcar: if (SCM_SYMBOLP (SCM_CAR (x))) diff --git a/libguile/eval.h b/libguile/eval.h index 7d76a9098..53e0a8315 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -105,13 +105,9 @@ SCM_API SCM scm_eval_options_interface (SCM setting); ? scm_misc_error (NULL, scm_s_expression, SCM_EOL), 0 \ : 0), \ (x)) -#ifdef MEMOIZE_LOCALS #define SCM_EVALIM(x, env) (SCM_ILOCP (x) \ ? *scm_ilookup ((x), env) \ : SCM_EVALIM2(x)) -#else -#define SCM_EVALIM(x, env) SCM_EVALIM2(x) -#endif #ifdef DEBUG_EXTENSIONS #define SCM_XEVAL(x, env) (SCM_IMP (x) \ ? SCM_EVALIM2(x) \ From feec7802ff38487fb188946e169a04f3137f3a50 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sun, 30 Jun 2002 17:06:35 +0000 Subject: [PATCH 022/306] * autogen.sh: Changed the path to the scripts directory. In libltdl, run aclocal before autoconf and automake: this eliminated various warnings after upgrading to newer automake. --- ChangeLog | 6 ++++++ autogen.sh | 3 ++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 70d26ac1f..42e1bcefb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2002-06-30 Gary Houston + + * autogen.sh: Changed the path to the scripts directory. + In libltdl, run aclocal before autoconf and automake: this + eliminated various warnings after upgrading to newer automake. + 2002-05-22 Marius Vollmer From John W. Eaton diff --git a/autogen.sh b/autogen.sh index 4f448f95a..3ba9ceec2 100755 --- a/autogen.sh +++ b/autogen.sh @@ -30,7 +30,7 @@ rm -f examples/example.gdbinit ln -s $workbook/build/dist-files/.gdbinit examples/example.gdbinit # TODO: This should be moved to dist-guile -mscripts=$workbook/../scripts +mscripts=../guile-scripts rm -f BUGS $mscripts/render-bugs > BUGS @@ -67,6 +67,7 @@ automake --add-missing # Make sure that libltdl uses the same autoconf version as the rest. # echo "libltdl..." +(cd libltdl && aclocal) (cd libltdl && autoconf) (cd libltdl && automake --gnu --add-missing) From 2ee08a28338d2576f4ccc208933fc6ee499d8a69 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sun, 30 Jun 2002 19:27:18 +0000 Subject: [PATCH 023/306] * posix.c (scm_convert_exec_args), dynl.c (scm_make_argv_from_stringlist): static procs: 1) renamed both to allocate_string_pointers. 2) simplified: don't reallocate the strings, just make an array of pointers 3) avoid memory leaks on error 4) let the procedure report errors in its own name. Consequences: 1) the procedures now assume that SCM strings are nul-terminated, which should always be the case. 2) Since strings are not reallocated, it's now possible for strings passed to dynamic-args-call to be mutated. --- libguile/ChangeLog | 12 +++++++ libguile/dynl.c | 90 ++++++++++++++++++---------------------------- libguile/posix.c | 51 ++++++++++++-------------- 3 files changed, 69 insertions(+), 84 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index dfb6d67df..5295163d2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,15 @@ +2002-06-30 Gary Houston + + * posix.c (scm_convert_exec_args), dynl.c + (scm_make_argv_from_stringlist): static procs: 1) renamed both to + allocate_string_pointers. 2) simplified: don't reallocate the + strings, just make an array of pointers 3) avoid memory leaks on + error 4) let the procedure report errors in its own name. + Consequences: 1) the procedures now assume that SCM strings are + nul-terminated, which should always be the case. 2) Since strings + are not reallocated, it's now possible for strings passed to + dynamic-args-call to be mutated. + 2002-06-28 Dirk Herrmann * __scm.h, eval.c, eval.h: Removed compile time option diff --git a/libguile/dynl.c b/libguile/dynl.c index 1f8c3ca70..2f8eac161 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -75,60 +75,6 @@ maybe_drag_in_eprintf () #include "libguile/lang.h" #include "libguile/validate.h" -/* Create a new C argv array from a scheme list of strings. */ -/* Dirk:FIXME:: A quite similar function is implemented in posix.c */ -/* Dirk:FIXME:: In case of assertion errors, we get memory leaks */ - -/* Converting a list of SCM strings into a argv-style array. You must - have ints disabled for the whole lifetime of the created argv (from - before MAKE_ARGV_FROM_STRINGLIST until after - MUST_FREE_ARGV). Atleast this is was the documentation for - MAKARGVFROMSTRS says, it isn't really used that way. - - This code probably belongs into strings.c - (Dirk: IMO strings.c is not the right place.) */ - -static char ** -scm_make_argv_from_stringlist (SCM args, int *argcp, const char *subr, - int argn) -{ - char **argv; - int argc; - int i; - - argc = scm_ilength (args); - SCM_ASSERT (argc >= 0, args, argn, subr); - argv = (char **) scm_malloc ((argc + 1) * sizeof (char *)); - for (i = 0; !SCM_NULL_OR_NIL_P (args); args = SCM_CDR (args), ++i) { - SCM arg = SCM_CAR (args); - size_t len; - char *dst; - char *src; - - SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr); - len = SCM_STRING_LENGTH (arg); - src = SCM_STRING_CHARS (arg); - dst = (char *) scm_malloc (len + 1); - memcpy (dst, src, len); - dst[len] = 0; - argv[i] = dst; - } - - if (argcp) - *argcp = argc; - argv[argc] = 0; - return argv; -} - -static void -scm_free_argv (char **argv) -{ - char **av = argv; - while (*av) - free (*(av++)); - free (argv); -} - /* Dispatch to the system dependent files * * They define some static functions. These functions are called with @@ -372,6 +318,35 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, } #undef FUNC_NAME +/* return a newly allocated array of char pointers to each of the strings + in args, with a terminating NULL pointer. */ +/* Note: a similar function is defined in posix.c, but we don't necessarily + want to export it. */ +static char **allocate_string_pointers (SCM args, int *num_args_return) +{ + char **result; + int n_args = scm_ilength (args); + int i; + + SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers"); + result = (char **) scm_malloc ((n_args + 1) * sizeof (char *)); + result[n_args] = NULL; + for (i = 0; i < n_args; i++) + { + SCM car = SCM_CAR (args); + + if (!SCM_STRINGP (car)) + { + free (result); + scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car); + } + result[i] = SCM_STRING_CHARS (SCM_CAR (args)); + args = SCM_CDR (args); + } + *num_args_return = n_args; + return result; +} + SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, (SCM func, SCM dobj, SCM args), "Call the C function indicated by @var{func} and @var{dobj},\n" @@ -397,9 +372,12 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func); SCM_DEFER_INTS; - argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME, SCM_ARG3); + argv = allocate_string_pointers (args, &argc); + /* if the procedure mutates its arguments, the original strings will be + changed -- in Guile 1.6 and earlier, this wasn't the case since a + new copy of each string was allocated. */ result = (*fptr) (argc, argv); - scm_free_argv (argv); + free (argv); SCM_ALLOW_INTS; return SCM_MAKINUM (0L + result); diff --git a/libguile/posix.c b/libguile/posix.c index 3e2334898..066e0f90b 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -827,37 +827,32 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0, #undef FUNC_NAME #endif /* HAVE_TCSETPGRP */ -/* Create a new C argv array from a scheme list of strings. */ -/* Dirk:FIXME:: A quite similar function is implemented in dynl.c */ -/* Dirk:FIXME:: In case of assertion errors, we get memory leaks */ - -static char ** -scm_convert_exec_args (SCM args, int argn, const char *subr) +/* return a newly allocated array of char pointers to each of the strings + in args, with a terminating NULL pointer. */ +/* Note: a similar function is defined in dynl.c, but we don't necessarily + want to export it. */ +static char **allocate_string_pointers (SCM args) { - char **argv; - int argc; + char **result; + int n_args = scm_ilength (args); int i; - argc = scm_ilength (args); - SCM_ASSERT (argc >= 0, args, argn, subr); - argv = (char **) scm_malloc ((argc + 1) * sizeof (char *)); - for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i) + SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers"); + result = (char **) scm_malloc ((n_args + 1) * sizeof (char *)); + result[n_args] = NULL; + for (i = 0; i < n_args; i++) { - SCM arg = SCM_CAR (args); - size_t len; - char *dst; - char *src; + SCM car = SCM_CAR (args); - SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr); - len = SCM_STRING_LENGTH (arg); - src = SCM_STRING_CHARS (arg); - dst = (char *) scm_malloc (len + 1); - memcpy (dst, src, len); - dst[len] = 0; - argv[i] = dst; + if (!SCM_STRINGP (car)) + { + free (result); + scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car); + } + result[i] = SCM_STRING_CHARS (SCM_CAR (args)); + args = SCM_CDR (args); } - argv[i] = 0; - return argv; + return result; } SCM_DEFINE (scm_execl, "execl", 1, 0, 1, @@ -875,7 +870,7 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1, { char **execargv; SCM_VALIDATE_STRING (1, filename); - execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME); + execargv = allocate_string_pointers (args); execv (SCM_STRING_CHARS (filename), execargv); SCM_SYSERROR; /* not reached. */ @@ -895,7 +890,7 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1, { char **execargv; SCM_VALIDATE_STRING (1, filename); - execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME); + execargv = allocate_string_pointers (args); execvp (SCM_STRING_CHARS (filename), execargv); SCM_SYSERROR; /* not reached. */ @@ -948,7 +943,7 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1, SCM_VALIDATE_STRING (1, filename); - execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME); + execargv = allocate_string_pointers (args); exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME); execve (SCM_STRING_CHARS (filename), execargv, exec_env); SCM_SYSERROR; From 732b93273252451186bb0ed5d6dc129019676296 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sun, 30 Jun 2002 20:34:38 +0000 Subject: [PATCH 024/306] * dynl.c: Removed all SCM_DEFER_INTS/SCM_ALLOW_INTS, which won't do anything useful. Added a comment about need for a mutex if pre-emptive threading is supported. --- libguile/ChangeLog | 4 ++++ libguile/dynl.c | 35 ++++++++++------------------------- 2 files changed, 14 insertions(+), 25 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5295163d2..85cffcba1 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,9 @@ 2002-06-30 Gary Houston + * dynl.c: Removed all SCM_DEFER_INTS/SCM_ALLOW_INTS, which won't + do anything useful. Added a comment about need for a mutex if + pre-emptive threading is supported. + * posix.c (scm_convert_exec_args), dynl.c (scm_make_argv_from_stringlist): static procs: 1) renamed both to allocate_string_pointers. 2) simplified: don't reallocate the diff --git a/libguile/dynl.c b/libguile/dynl.c index 2f8eac161..de4ee6ca0 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -75,20 +75,19 @@ maybe_drag_in_eprintf () #include "libguile/lang.h" #include "libguile/validate.h" -/* Dispatch to the system dependent files - * - * They define some static functions. These functions are called with - * deferred interrupts. When they want to throw errors, they are - * expected to insert a SCM_ALLOW_INTS before doing the throw. It - * might work to throw an error while interrupts are deferred (because - * they will be unconditionally allowed the next time a SCM_ALLOW_INTS - * is executed, SCM_DEFER_INTS and SCM_ALLOW_INTS do not nest). - */ - #ifdef DYNAMIC_LINKING #include "libltdl/ltdl.h" +/* From the libtool manual: "Note that libltdl is not threadsafe, + i.e. a multithreaded application has to use a mutex for libltdl.". + + Guile does not currently support pre-emptive threads, so there is + no mutex. Previously SCM_DEFER_INTS and SCM_ALLOW_INTS were used: + they are mentioned here in case somebody is grepping for thread + problems ;) +*/ + static void * sysdep_dynl_link (const char *fname, const char *subr) { @@ -99,7 +98,6 @@ sysdep_dynl_link (const char *fname, const char *subr) SCM fn; SCM msg; - SCM_ALLOW_INTS; fn = scm_makfrom0str (fname); msg = scm_makfrom0str (lt_dlerror ()); scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg)); @@ -112,7 +110,6 @@ sysdep_dynl_unlink (void *handle, const char *subr) { if (lt_dlclose ((lt_dlhandle) handle)) { - SCM_ALLOW_INTS; scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); } } @@ -125,7 +122,6 @@ sysdep_dynl_func (const char *symb, void *handle, const char *subr) fptr = lt_dlsym ((lt_dlhandle) handle, symb); if (!fptr) { - SCM_ALLOW_INTS; scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); } return fptr; @@ -149,7 +145,6 @@ sysdep_dynl_init (void) static void no_dynl_error (const char *subr) { - SCM_ALLOW_INTS; scm_misc_error (subr, "dynamic linking not available", SCM_EOL); } @@ -245,10 +240,8 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0, if (DYNL_HANDLE (dobj) == NULL) { SCM_MISC_ERROR ("Already unlinked: ~S", dobj); } else { - SCM_DEFER_INTS; sysdep_dynl_unlink (DYNL_HANDLE (dobj), FUNC_NAME); SET_DYNL_HANDLE (dobj, NULL); - SCM_ALLOW_INTS; return SCM_UNSPECIFIED; } } @@ -281,10 +274,8 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, } else { char *chars; - SCM_DEFER_INTS; chars = SCM_STRING_CHARS (name); func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME); - SCM_ALLOW_INTS; return scm_ulong2num ((unsigned long) func); } } @@ -301,9 +292,7 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, "is equivalent to\n" "@smallexample\n" "(dynamic-call (dynamic-func @var{func} @var{dobj} #f))\n" - "@end smallexample\n\n" - "Interrupts are deferred while the C function is executing (with\n" - "@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}).") + "@end smallexample\n\n") #define FUNC_NAME s_scm_dynamic_call { void (*fptr) (); @@ -311,9 +300,7 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, if (SCM_STRINGP (func)) func = scm_dynamic_func (func, dobj); fptr = (void (*) ()) SCM_NUM2ULONG (1, func); - SCM_DEFER_INTS; fptr (); - SCM_ALLOW_INTS; return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -371,14 +358,12 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, func = scm_dynamic_func (func, dobj); fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func); - SCM_DEFER_INTS; argv = allocate_string_pointers (args, &argc); /* if the procedure mutates its arguments, the original strings will be changed -- in Guile 1.6 and earlier, this wasn't the case since a new copy of each string was allocated. */ result = (*fptr) (argc, argv); free (argv); - SCM_ALLOW_INTS; return SCM_MAKINUM (0L + result); } From 8505e285ec9339884d4d36c1394907aa3101291c Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sun, 30 Jun 2002 22:03:43 +0000 Subject: [PATCH 025/306] * backtrace.c (SCM_ASSERT), debug.c (scm_debug_options), eval.c (scm_lookupcar, scm_lookupcar1, scm_badargsp, SCM_CEVAL, SCM_APPLY, scm_map, scm_for_each), feature.c (scm_init_feature), gsubr.c (scm_gsubr_apply), numbers.c (scm_logand, scm_logior, scm_logxor, scm_i_dbl2big), srcprop.c (scm_source_properties, scm_set_source_properties_x, scm_source_property): Removed compile time option SCM_RECKLESS to clean up the code. Full number of arguments checking of closures is mandatory now. However, the option to disable the checking has most probably not been used anyway. * srcprop.c (scm_source_properties, scm_set_source_properties_x, scm_source_property): Use !SCM_CONSP instead of SCM_NCONSP. --- NEWS | 5 +++++ libguile/ChangeLog | 16 ++++++++++++++++ libguile/__scm.h | 10 +--------- libguile/backtrace.c | 2 -- libguile/debug.c | 7 +------ libguile/eval.c | 18 ------------------ libguile/feature.c | 5 +---- libguile/gsubr.c | 2 -- libguile/numbers.c | 19 +------------------ libguile/srcprop.c | 18 +++++------------- 10 files changed, 30 insertions(+), 72 deletions(-) diff --git a/NEWS b/NEWS index 68431fd3e..2a72b62b6 100644 --- a/NEWS +++ b/NEWS @@ -173,6 +173,11 @@ Now, caching of local variable positions during memoization is mandatory. However, the option to disable the caching has most probably not been used anyway. +** Removed compile time option SCM_RECKLESS + +Full number of arguments checking of closures is mandatory now. However, the +option to disable the checking has most probably not been used anyway. + ** Removed definitions: scm_lisp_nil, scm_lisp_t, s_nil_ify, scm_m_nil_ify, s_t_ify, scm_m_t_ify, s_0_cond, scm_m_0_cond, s_0_ify, scm_m_0_ify, s_1_ify, scm_m_1_ify, scm_debug_newcell, scm_debug_newcell2, scm_tc16_allocated, diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 85cffcba1..60f5026ec 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,19 @@ +2002-06-30 Dirk Herrmann + + * backtrace.c (SCM_ASSERT), debug.c (scm_debug_options), eval.c + (scm_lookupcar, scm_lookupcar1, scm_badargsp, SCM_CEVAL, + SCM_APPLY, scm_map, scm_for_each), feature.c (scm_init_feature), + gsubr.c (scm_gsubr_apply), numbers.c (scm_logand, scm_logior, + scm_logxor, scm_i_dbl2big), srcprop.c (scm_source_properties, + scm_set_source_properties_x, scm_source_property): Removed + compile time option SCM_RECKLESS to clean up the code. Full + number of arguments checking of closures is mandatory now. + However, the option to disable the checking has most probably not + been used anyway. + + * srcprop.c (scm_source_properties, scm_set_source_properties_x, + scm_source_property): Use !SCM_CONSP instead of SCM_NCONSP. + 2002-06-30 Gary Houston * dynl.c: Removed all SCM_DEFER_INTS/SCM_ALLOW_INTS, which won't diff --git a/libguile/__scm.h b/libguile/__scm.h index b437f6d5b..c91908700 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -100,16 +100,8 @@ /* #define GUILE_DEBUG_FREELIST */ /* If the compile FLAG `SCM_CAUTIOUS' is #defined then the number of - * arguments is always checked for application of closures. If the - * compile FLAG `SCM_RECKLESS' is #defined then they are not checked. - * Otherwise, number of argument checks for closures are made only - * when the function position (whose value is the closure) of a - * combination is not an ILOC or a variable (true?). When the - * function position of a combination is a symbol it will be checked - * only the first time it is evaluated because it will then be - * replaced with an ILOC or variable. + * arguments is always checked for application of closures. */ -#undef SCM_RECKLESS #define SCM_CAUTIOUS /* All the number support there is. diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 568e2b9f3..6c707ac90 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -77,12 +77,10 @@ * Note that these functions shouldn't generate errors themselves. */ -#ifndef SCM_RECKLESS #undef SCM_ASSERT #define SCM_ASSERT(_cond, _arg, _pos, _subr) \ if (!(_cond)) \ return SCM_BOOL_F; -#endif SCM scm_the_last_stack_fluid_var; diff --git a/libguile/debug.c b/libguile/debug.c index a7e2e9932..05c0cf3bd 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -81,17 +81,12 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0, { SCM ans; SCM_DEFER_INTS; - ans = scm_options (setting, - scm_debug_opts, - SCM_N_DEBUG_OPTIONS, - FUNC_NAME); -#ifndef SCM_RECKLESS + ans = scm_options (setting, scm_debug_opts, SCM_N_DEBUG_OPTIONS, FUNC_NAME); if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE)) { scm_options (ans, scm_debug_opts, SCM_N_DEBUG_OPTIONS, FUNC_NAME); SCM_OUT_OF_RANGE (1, setting); } -#endif SCM_RESET_DEBUG_MODE; scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P; scm_debug_eframe_size = 2 * SCM_N_FRAMES; diff --git a/libguile/eval.c b/libguile/eval.c index a41a16a21..cadb66727 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -281,13 +281,11 @@ scm_lookupcar (SCM vloc, SCM genv, int check) al = SCM_CDRLOC (*al); if (SCM_EQ_P (SCM_CAR (fl), var)) { -#ifndef SCM_RECKLESS /* letrec inits to SCM_UNDEFINED */ if (SCM_UNBNDP (SCM_CAR (*al))) { env = SCM_EOL; goto errout; } -#endif #ifdef USE_THREADS if (!SCM_EQ_P (SCM_CAR (vloc), var)) goto race; @@ -313,7 +311,6 @@ scm_lookupcar (SCM vloc, SCM genv, int check) if (SCM_FALSEP (real_var)) goto errout; -#ifndef SCM_RECKLESS if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var))) { errout: @@ -335,7 +332,6 @@ scm_lookupcar (SCM vloc, SCM genv, int check) return &undef_object; } } -#endif #ifdef USE_THREADS if (!SCM_EQ_P (SCM_CAR (vloc), var)) @@ -1540,7 +1536,6 @@ scm_unmemocopy (SCM x, SCM env) return unmemocopy (x, env); } -#ifndef SCM_RECKLESS int scm_badargsp (SCM formals, SCM args) @@ -1557,7 +1552,6 @@ scm_badargsp (SCM formals, SCM args) return !SCM_NULLP (args) ? 1 : 0; } -#endif static int scm_badformalsp (SCM closure, int n) @@ -2339,10 +2333,8 @@ dispatch: #ifdef DEVAL debug.info->a.args = arg1; #endif -#ifndef SCM_RECKLESS if (scm_badargsp (formals, arg1)) scm_wrong_num_args (proc); -#endif ENTER_APPLY; /* Copy argument list */ if (SCM_NULL_OR_NIL_P (arg1)) @@ -2697,10 +2689,8 @@ dispatch: case SCM_BIT8(SCM_ILOC00): proc = *scm_ilookup (SCM_CAR (x), env); SCM_ASRTGO (SCM_NIMP (proc), badfun); -#ifndef SCM_RECKLESS #ifdef SCM_CAUTIOUS goto checkargs; -#endif #endif break; @@ -2786,7 +2776,6 @@ dispatch: else proc = SCM_CEVAL (SCM_CAR (x), env); SCM_ASRTGO (!SCM_IMP (proc), badfun); -#ifndef SCM_RECKLESS #ifdef SCM_CAUTIOUS checkargs: #endif @@ -2808,7 +2797,6 @@ dispatch: } else if (SCM_MACROP (proc)) goto handle_a_macro; -#endif } @@ -3663,10 +3651,8 @@ tail: #else arg1 = (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args)); #endif -#ifndef SCM_RECKLESS if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), arg1)) scm_wrong_num_args (proc); -#endif /* Copy argument list */ if (SCM_IMP (arg1)) @@ -3877,9 +3863,7 @@ scm_map (SCM proc, SCM arg1, SCM args) } args = scm_vector (arg1 = scm_cons (arg1, args)); ve = SCM_VELTS (args); -#ifndef SCM_RECKLESS check_map_args (args, len, g_map, proc, arg1, s_map); -#endif while (1) { arg1 = SCM_EOL; @@ -3920,9 +3904,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args) } args = scm_vector (arg1 = scm_cons (arg1, args)); ve = SCM_VELTS (args); -#ifndef SCM_RECKLESS check_map_args (args, len, g_for_each, proc, arg1, s_for_each); -#endif while (1) { arg1 = SCM_EOL; diff --git a/libguile/feature.c b/libguile/feature.c index 8e71676c2..9a9bdc303 100644 --- a/libguile/feature.c +++ b/libguile/feature.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -102,9 +102,6 @@ void scm_init_feature() { features_var = scm_c_define ("*features*", SCM_EOL); -#ifdef SCM_RECKLESS - scm_add_feature("reckless"); -#endif #ifndef _Windows scm_add_feature("system"); #endif diff --git a/libguile/gsubr.c b/libguile/gsubr.c index b8b15462f..42af8ad76 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -223,10 +223,8 @@ scm_gsubr_apply (SCM args) #endif args = SCM_CDR (args); for (i = 0; i < SCM_GSUBR_REQ (typ); i++) { -#ifndef SCM_RECKLESS if (SCM_NULLP (args)) scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self))); -#endif v[i] = SCM_CAR(args); args = SCM_CDR(args); } diff --git a/libguile/numbers.c b/libguile/numbers.c index 31dfb33fc..d3d8eca2e 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 Free Software Foundation, Inc. * * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories * and Bellcore. See scm_divide. @@ -898,15 +898,10 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr, return SCM_MAKINUM (-1); } else if (!SCM_NUMBERP (n1)) { SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); -#ifndef SCM_RECKLESS } else if (SCM_NUMBERP (n1)) { return n1; } else { SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); -#else - } else { - return n1; -#endif } } @@ -982,15 +977,10 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr, if (SCM_UNBNDP (n2)) { if (SCM_UNBNDP (n1)) { return SCM_INUM0; -#ifndef SCM_RECKLESS } else if (SCM_NUMBERP (n1)) { return n1; } else { SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); -#else - } else { - return n1; -#endif } } @@ -1069,15 +1059,10 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr, if (SCM_UNBNDP (n2)) { if (SCM_UNBNDP (n1)) { return SCM_INUM0; -#ifndef SCM_RECKLESS } else if (SCM_NUMBERP (n1)) { return n1; } else { SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); -#else - } else { - return n1; -#endif } } @@ -4537,10 +4522,8 @@ scm_i_dbl2big (double d) u -= c; digits[i] = c; } -#ifndef SCM_RECKLESS if (u != 0) scm_num_overflow ("dbl2big"); -#endif return ans; } diff --git a/libguile/srcprop.c b/libguile/srcprop.c index ae18babf2..3c679d3bd 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 Free Software Foundation * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -182,10 +182,8 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, SCM_VALIDATE_NIM (1,obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); -#ifndef SCM_RECKLESS - else if (SCM_NCONSP (obj)) + else if (!SCM_CONSP (obj)) SCM_WRONG_TYPE_ARG (1, obj); -#endif p = scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F); if (SRCPROPSP (p)) return scm_srcprops_to_plist (p); @@ -205,10 +203,8 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0, SCM_VALIDATE_NIM (1,obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); -#ifndef SCM_RECKLESS - else if (SCM_NCONSP (obj)) + else if (!SCM_CONSP (obj)) SCM_WRONG_TYPE_ARG(1, obj); -#endif handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist); SCM_SETCDR (handle, plist); return plist; @@ -225,10 +221,8 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, SCM_VALIDATE_NIM (1,obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); -#ifndef SCM_RECKLESS - else if (SCM_NCONSP (obj)) + else if (!SCM_CONSP (obj)) SCM_WRONG_TYPE_ARG (1, obj); -#endif p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); if (!SRCPROPSP (p)) goto plist; @@ -259,10 +253,8 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, SCM_VALIDATE_NIM (1,obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); -#ifndef SCM_RECKLESS - else if (SCM_NCONSP (obj)) + else if (!SCM_CONSP (obj)) SCM_WRONG_TYPE_ARG (1, obj); -#endif h = scm_whash_get_handle (scm_source_whash, obj); if (SCM_WHASHFOUNDP (h)) p = SCM_WHASHREF (scm_source_whash, h); From bd987b8edaf016c40e20f980822e92b8b835552a Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sun, 30 Jun 2002 22:40:01 +0000 Subject: [PATCH 026/306] * __scm.h (SCM_CAUTIOUS), eval.c (scm_eval_args, deval_args, SCM_CEVAL): Removed compile time option SCM_CAUTIOUS to clean up the code. Full number of arguments checking of closures is mandatory now. However, the option to disable the checking has most probably not been used anyway. --- NEWS | 5 +++++ libguile/ChangeLog | 28 ++++++++++++++++++---------- libguile/__scm.h | 7 +------ libguile/eval.c | 21 ++------------------- 4 files changed, 26 insertions(+), 35 deletions(-) diff --git a/NEWS b/NEWS index 2a72b62b6..4c73222bf 100644 --- a/NEWS +++ b/NEWS @@ -178,6 +178,11 @@ anyway. Full number of arguments checking of closures is mandatory now. However, the option to disable the checking has most probably not been used anyway. +** Removed compile time option SCM_CAUTIOUS + +Full number of arguments checking of closures is mandatory now. However, the +option to disable the checking has most probably not been used anyway. + ** Removed definitions: scm_lisp_nil, scm_lisp_t, s_nil_ify, scm_m_nil_ify, s_t_ify, scm_m_t_ify, s_0_cond, scm_m_0_cond, s_0_ify, scm_m_0_ify, s_1_ify, scm_m_1_ify, scm_debug_newcell, scm_debug_newcell2, scm_tc16_allocated, diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 60f5026ec..613fb9a34 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,15 +1,23 @@ +2002-07-01 Dirk Herrmann + + * __scm.h (SCM_CAUTIOUS), eval.c (scm_eval_args, deval_args, + SCM_CEVAL): Removed compile time option SCM_CAUTIOUS to clean up + the code. Full number of arguments checking of closures is + mandatory now. However, the option to disable the checking has + most probably not been used anyway. + 2002-06-30 Dirk Herrmann - * backtrace.c (SCM_ASSERT), debug.c (scm_debug_options), eval.c - (scm_lookupcar, scm_lookupcar1, scm_badargsp, SCM_CEVAL, - SCM_APPLY, scm_map, scm_for_each), feature.c (scm_init_feature), - gsubr.c (scm_gsubr_apply), numbers.c (scm_logand, scm_logior, - scm_logxor, scm_i_dbl2big), srcprop.c (scm_source_properties, - scm_set_source_properties_x, scm_source_property): Removed - compile time option SCM_RECKLESS to clean up the code. Full - number of arguments checking of closures is mandatory now. - However, the option to disable the checking has most probably not - been used anyway. + * __scm.h (SCM_RECKLESS), backtrace.c (SCM_ASSERT), debug.c + (scm_debug_options), eval.c (scm_lookupcar, scm_lookupcar1, + scm_badargsp, SCM_CEVAL, SCM_APPLY, scm_map, scm_for_each), + feature.c (scm_init_feature), gsubr.c (scm_gsubr_apply), numbers.c + (scm_logand, scm_logior, scm_logxor, scm_i_dbl2big), srcprop.c + (scm_source_properties, scm_set_source_properties_x, + scm_source_property): Removed compile time option SCM_RECKLESS to + clean up the code. Full number of arguments checking of closures + is mandatory now. However, the option to disable the checking has + most probably not been used anyway. * srcprop.c (scm_source_properties, scm_set_source_properties_x, scm_source_property): Use !SCM_CONSP instead of SCM_NCONSP. diff --git a/libguile/__scm.h b/libguile/__scm.h index c91908700..a7829ba4a 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 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -99,11 +99,6 @@ /* #define GUILE_DEBUG_FREELIST */ -/* If the compile FLAG `SCM_CAUTIOUS' is #defined then the number of - * arguments is always checked for application of closures. - */ -#define SCM_CAUTIOUS - /* All the number support there is. */ #define BIGNUMS diff --git a/libguile/eval.c b/libguile/eval.c index cadb66727..172cc2e4d 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1582,10 +1582,8 @@ scm_eval_args (SCM l, SCM env, SCM proc) lloc = SCM_CDRLOC (*lloc); l = SCM_CDR (l); } -#ifdef SCM_CAUTIOUS if (!SCM_NULLP (l)) scm_wrong_num_args (proc); -#endif return results; } @@ -1790,10 +1788,8 @@ deval_args (SCM l, SCM env, SCM proc, SCM *lloc) lloc = SCM_CDRLOC (*lloc); l = SCM_CDR (l); } -#ifdef SCM_CAUTIOUS if (!SCM_NULLP (l)) scm_wrong_num_args (proc); -#endif return *results; } @@ -2689,10 +2685,7 @@ dispatch: case SCM_BIT8(SCM_ILOC00): proc = *scm_ilookup (SCM_CAR (x), env); SCM_ASRTGO (SCM_NIMP (proc), badfun); -#ifdef SCM_CAUTIOUS goto checkargs; -#endif - break; case scm_tcs_cons_nimcar: if (SCM_SYMBOLP (SCM_CAR (x))) @@ -2776,9 +2769,8 @@ dispatch: else proc = SCM_CEVAL (SCM_CAR (x), env); SCM_ASRTGO (!SCM_IMP (proc), badfun); -#ifdef SCM_CAUTIOUS + checkargs: -#endif if (SCM_CLOSUREP (proc)) { SCM formals = SCM_CLOSURE_FORMALS (proc); @@ -2883,14 +2875,10 @@ evapply: /* inputs: x, proc */ /* must handle macros by here */ x = SCM_CDR (x); -#ifdef SCM_CAUTIOUS if (SCM_CONSP (x)) arg1 = EVALCAR (x, env); else scm_wrong_num_args (proc); -#else - arg1 = EVALCAR (x, env); -#endif #ifdef DEVAL debug.info->a.args = scm_list_1 (arg1); #endif @@ -3018,14 +3006,11 @@ evapply: /* inputs: x, proc */ goto badfun; } } -#ifdef SCM_CAUTIOUS if (SCM_CONSP (x)) arg2 = EVALCAR (x, env); else scm_wrong_num_args (proc); -#else - arg2 = EVALCAR (x, env); -#endif + { /* have two or more arguments */ #ifdef DEVAL debug.info->a.args = scm_list_2 (arg1, arg2); @@ -3134,10 +3119,8 @@ evapply: /* inputs: x, proc */ goto nontoplevel_begin; } } -#ifdef SCM_CAUTIOUS if (!SCM_CONSP (x)) scm_wrong_num_args (proc); -#endif #ifdef DEVAL debug.info->a.args = scm_cons2 (arg1, arg2, deval_args (x, env, proc, From 7c38399f307f9f21cf21a2170f2997b48dff5c94 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sun, 7 Jul 2002 05:18:17 +0000 Subject: [PATCH 027/306] * now using mmacros instead of macros at some places. --- ice-9/ChangeLog | 5 +++++ ice-9/boot-9.scm | 4 ++-- oop/ChangeLog | 4 ++++ oop/goops/save.scm | 4 ++-- 4 files changed, 13 insertions(+), 4 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index ae3084e87..32985e46c 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2002-07-07 Dirk Herrmann + + * boot-9.scm (define-option-interface): Replaced "macro" by + mmacro. + 2002-06-01 Gary Houston * boot-9.scm (file-set-position): Make third argument optional, diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index e51bf39bd..5fd5b638e 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -2024,7 +2024,7 @@ (list '(,'unquote name) (,'unquote exp)))) (,interface))))))) - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (cons 'begin (let* ((option-group (cadr exp)) diff --git a/oop/ChangeLog b/oop/ChangeLog index 5fc09eed1..df483c652 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,7 @@ +2002-07-07 Dirk Herrmann + + * goops/save.scm (restore): Replaced "macro" by mmacro. + 2001-10-21 Mikael Djurfeldt * goops.scm, goops/active-slot.scm, goops/compile.scm, diff --git a/oop/goops/save.scm b/oop/goops/save.scm index 7db319e22..d3d9ed374 100644 --- a/oop/goops/save.scm +++ b/oop/goops/save.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2000,2001,2002 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -403,7 +403,7 @@ (slot-ref class 'getters-n-setters))) (define restore - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) "(restore CLASS (SLOT-NAME1 ...) EXP1 ...)" `(let ((o (,%allocate-instance ,(cadr exp) '()))) From 935233289113a608568e3397dc8ab2615a4fd25f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 19:36:42 +0000 Subject: [PATCH 028/306] Crosscompiling and Cygwin fixes from Jan Nieuwenhuizen. Thanks! --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index aa83367a7..bd6c5cc3f 100644 --- a/THANKS +++ b/THANKS @@ -24,6 +24,7 @@ For fixes or providing information which led to a fix: Richard Kim Matthias Köppe Han-Wen Nienhuys + Jan Nieuwenhuizen Ron Peterson David Pirotte Ken Raeburn From 0db83c0423ef8ba54c5fcb3ef7bbf2b7c2560481 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 19:38:23 +0000 Subject: [PATCH 029/306] * configure.in (AC_LIBTOOL_WIN32_DLL): Add for shared Cygwin build. Add --with-cc-for-build option to re-enable cross building. Add --with-guile-for-build option to re-enable cross building. --- configure.in | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/configure.in b/configure.in index 056fb483f..77ef36564 100644 --- a/configure.in +++ b/configure.in @@ -163,6 +163,9 @@ AC_ISC_POSIX AC_MINIX AM_PROG_CC_STDC + +## Needed for building DLLs on Cygwin, before AM_PROG_LIBTOOL +AC_LIBTOOL_WIN32_DLL AM_PROG_LIBTOOL AC_CHECK_PROG(have_makeinfo, makeinfo, yes, no) @@ -671,6 +674,54 @@ if test "${THREAD_PACKAGE}" != "" ; then fi fi +## Cross building +if test "$cross_compiling" = "yes"; then + AC_MSG_CHECKING(cc for build) + ## /usr/bin/cc still uses wrong assembler + ## CC_FOR_BUILD="${CC_FOR_BUILD-/usr/bincc}" + CC_FOR_BUILD="${CC_FOR_BUILD-PATH=/usr/bin:$PATH cc}" +else + CC_FOR_BUILD="${CC_FOR_BUILD-$CC}" +fi +AC_ARG_WITH(cc-for-build, + [ --with-cc-for-build=CC native C compiler, to be used during build]) +test -n "$with_cc_for_build" && CC_FOR_BUILD="$with_cc_for_build" + +## AC_MSG_CHECKING("if we are cross compiling") +## AC_MSG_RESULT($cross_compiling) +if test "$cross_compiling" = "yes"; then + AC_MSG_RESULT($CC_FOR_BUILD) +fi + +## No need as yet to be more elaborate +CCLD_FOR_BUILD="$CC_FOR_BUILD" + +AC_SUBST(cross_compiling) +AC_SUBST(CC_FOR_BUILD) +AC_SUBST(CCLD_FOR_BUILD) + +## libtool erroneously calls CC_FOR_BUILD HOST_CC; +## --HOST is the platform that PACKAGE is compiled for. +HOST_CC="$CC_FOR_BUILD" +AC_SUBST(HOST_CC) + +if test "$cross_compiling" = "yes"; then + AC_MSG_CHECKING(guile for build) + GUILE_FOR_BUILD="${GUILE_FOR_BUILD-guile}" +else + GUILE_FOR_BUILD='$(preinstguile)' +fi +AC_ARG_WITH(guile-for-build, + [ --with-guile-for-build=guile native guile executable, to be used during build]) +test -n "$with_guile_for_build" && GUILE_FOR_BUILD="$with_guile_for_build" + +## AC_MSG_CHECKING("if we are cross compiling") +## AC_MSG_RESULT($cross_compiling) +if test "$cross_compiling" = "yes"; then + AC_MSG_RESULT($GUILE_FOR_BUILD) +fi +AC_SUBST(GUILE_FOR_BUILD) + ## If we're using GCC, ask for aggressive warnings. case "$GCC" in yes ) From 452e3661981e914e08679d6e087d96b4b9825fea Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 19:39:21 +0000 Subject: [PATCH 030/306] Only fix libltdl/configure.in if it exists. Current libtool CVS does not need this fix. --- autogen.sh | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/autogen.sh b/autogen.sh index 3ba9ceec2..40f71ec01 100755 --- a/autogen.sh +++ b/autogen.sh @@ -47,11 +47,14 @@ $mscripts/render-bugs > BUGS rm -rf libltdl libtoolize --force --copy --automake --ltdl +# Fix older versions of libtool. # Make sure we use a ./configure.in compatible autoconf in ./libltdl/ -mv libltdl/configure.in libltdl/configure.tmp -echo 'AC_PREREQ(2.50)' > libltdl/configure.in -cat libltdl/configure.tmp >> libltdl/configure.in -rm libltdl/configure.tmp +if [ -f libltdl/configure.in ]; then + mv libltdl/configure.in libltdl/configure.tmp + echo 'AC_PREREQ(2.50)' > libltdl/configure.in + cat libltdl/configure.tmp >> libltdl/configure.in + rm libltdl/configure.tmp +fi ###################################################################### autoheader From 887efef59c19a533adf4dcc7758e2997537c734c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 19:40:09 +0000 Subject: [PATCH 031/306] *** empty log message *** --- ChangeLog | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/ChangeLog b/ChangeLog index 42e1bcefb..78fc5c065 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2002-07-07 Marius Vollmer + + Crosscompiling and Cygwin fixes from Jan Nieuwenhuizen. Thanks! + + * autogen.sh: Only fix libltdl/configure.in if it exists. Current + libtool CVS does not need this fix. + + * configure.in (AC_LIBTOOL_WIN32_DLL): Add for shared Cygwin + build. + Add --with-cc-for-build option to re-enable cross building. + Add --with-guile-for-build option to re-enable cross building. + 2002-06-30 Gary Houston * autogen.sh: Changed the path to the scripts directory. From b32fca0fbc10c1856ce425e4bc27271fe85c59e6 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 19:50:49 +0000 Subject: [PATCH 032/306] Override default rule for c-tokenize.$(OBJECT); this should be compiled for BUILD host. Override default rule for guile_filter_doc_snarfage$(EEXECT); this should run on BUILD host. Add missing $(EXEEXT) to guile_filter_doc_snarfage invocation. (snarf2checkedtexi): Use GUILE_FOR_BUILD instead of preinstguile. --- libguile/Makefile.am | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 13dd676d9..ec819d4a4 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -33,14 +33,33 @@ ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_L lib_LTLIBRARIES = libguile.la bin_PROGRAMS = guile + noinst_PROGRAMS = guile_filter_doc_snarfage +guile_filter_doc_snarfage_SOURCES = c-tokenize.c + +## Override default rule; this should be compiled for BUILD host. +## For some reason, OBJEXT does not include the dot +c-tokenize.$(OBJEXT): c-tokenize.c + if [ "$(cross_compiling)" = "yes" ]; then \ + $(CC_FOR_BUILD) -c -o $@ $<; \ + else \ + $(COMPILE) -c -o $@ $<; \ + fi + +## Override default rule; this should run on BUILD host. +guile_filter_doc_snarfage$(EXEEXT): $(guile_filter_doc_snarfage_OBJECTS) $(guile_filter_doc_snarfage_DEPENDENCIES) + @rm -f guile_filter_doc_snarfage$(EXEEXT) + if [ "$(cross_compiling)" = "yes" ]; then \ + $(CCLD_FOR_BUILD) -o $@ $(guile_filter_doc_snarfage_OBJECTS); \ + else \ + $(LINK) $(guile_filter_doc_snarfage_OBJECTS) $(LDADD) $(LIBS); \ + fi + guile_SOURCES = guile.c guile_LDADD = libguile.la guile_LDFLAGS = @DLPREOPEN@ -guile_filter_doc_snarfage_SOURCES = c-tokenize.c - libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ chars.c continuations.c convert.c debug.c deprecation.c dynl.c \ dynwind.c environments.c eq.c error.c eval.c evalext.c extensions.c \ @@ -213,7 +232,7 @@ load.x: libpath.h include $(top_srcdir)/am/pre-inst-guile alldotdocfiles = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) -snarf2checkedtexi = $(preinstguiletool)/snarf-check-and-output-texi +snarf2checkedtexi = GUILE="$(GUILE_FOR_BUILD)" $(top_srcdir)/scripts/snarf-check-and-output-texi dotdoc2texi = cat $(alldotdocfiles) | $(snarf2checkedtexi) guile.texi: $(alldotdocfiles) guile From 7c9e56d664857bd54681c35d90bdd289745194fa Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 19:58:15 +0000 Subject: [PATCH 033/306] Do not include on Cygwin even when we have it. --- libguile/guile.c | 3 ++- libguile/iselect.h | 3 ++- libguile/net_db.c | 3 ++- libguile/posix.c | 3 ++- libguile/socket.c | 3 ++- 5 files changed, 10 insertions(+), 5 deletions(-) diff --git a/libguile/guile.c b/libguile/guile.c index ae17a9606..23e41d0ac 100644 --- a/libguile/guile.c +++ b/libguile/guile.c @@ -58,7 +58,8 @@ #include #endif -#ifdef HAVE_WINSOCK2_H +#if defined (HAVE_WINSOCK2_H) \ + && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) #include #endif diff --git a/libguile/iselect.h b/libguile/iselect.h index a7b59594e..a7db8706b 100644 --- a/libguile/iselect.h +++ b/libguile/iselect.h @@ -68,7 +68,8 @@ #include #endif -#ifdef HAVE_WINSOCK2_H +#if defined (HAVE_WINSOCK2_H) \ + && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) #include #endif diff --git a/libguile/net_db.c b/libguile/net_db.c index ecb075c8b..d0602ba23 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -65,7 +65,8 @@ #include -#ifdef HAVE_WINSOCK2_H +#if defined (HAVE_WINSOCK2_H) \ + && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) #include #else #include diff --git a/libguile/posix.c b/libguile/posix.c index 066e0f90b..e7416974a 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -96,7 +96,8 @@ extern char *ttyname(); #ifdef HAVE_IO_H #include #endif -#ifdef HAVE_WINSOCK2_H +#if defined (HAVE_WINSOCK2_H) \ + && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) #include #endif diff --git a/libguile/socket.c b/libguile/socket.c index 86b61aca1..49501b72c 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -68,7 +68,8 @@ #include #endif #include -#ifdef HAVE_WINSOCK2_H +#if defined (HAVE_WINSOCK2_H) \ + && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) #include #else #include From 3f6571eb9478c10d09ca9c79aa72dd979cf6bdbd Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 20:06:31 +0000 Subject: [PATCH 034/306] *** empty log message *** --- libguile/ChangeLog | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 613fb9a34..0a5114d32 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,17 @@ +2002-07-07 Marius Vollmer + + Crosscompiling and Cygwin fixes by Jan Nieuwenhuizen. Thanks! + + * Makefile.am: Override default rule for c-tokenize.$(OBJECT); + this should be compiled for BUILD host. + Override default rule for + guile_filter_doc_snarfage$(EEXECT); this should run on BUILD host. + Add missing $(EXEEXT) to guile_filter_doc_snarfage invocation. + (snarf2checkedtexi): Use GUILE_FOR_BUILD instead of preinstguile. + + * guile.c, iselect.h, net_db.c, posix.c, socket.c: Do not include + on Cygwin even when we have it. + 2002-07-01 Dirk Herrmann * __scm.h (SCM_CAUTIOUS), eval.c (scm_eval_args, deval_args, From 2e562f3a01232a873d9d6d00e696344f7d4a9e9d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 20:17:29 +0000 Subject: [PATCH 035/306] * autogen.sh: Do not copy INSTALL from workbook since it is not uniform across branches. * INSTALL: Re-added to repository. --- INSTALL | 467 +++++++++++++++++++++++++++++++++++++++++++++++++++++ autogen.sh | 2 +- 2 files changed, 468 insertions(+), 1 deletion(-) create mode 100644 INSTALL diff --git a/INSTALL b/INSTALL new file mode 100644 index 000000000..d75cc57a4 --- /dev/null +++ b/INSTALL @@ -0,0 +1,467 @@ +Guile Installation Guide +Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. + + Permission is granted to anyone to make or distribute verbatim copies + of this document as received, in any medium, provided that the + copyright notice and permission notice are preserved, + and that the distributor grants the recipient permission + for further redistribution as permitted by this notice. + + Permission is granted to distribute modified versions + of this document, or of portions of it, + under the above conditions, provided also that they + carry prominent notices stating who last changed them, + and that any new or changed statements about the activities + of the Free Software Foundation are approved by the Foundation. + + +Brief Installation Instructions =========================================== + +To build Guile on unix, there are two basic steps: + + 1. Type "./configure", to configure the package for your system. + 2. Type "make", to build the package. + +Generic instructions for configuring and compiling GNU distributions +are included below. (For instructions how to install SLIB, the scheme +procedure library, see below.) + + +Guile can use a number of external packages such as `readline' when +they are available. Guile expects to be able to find these packages +in the default compiler setup, it does not try to make any special +arrangements itself. For example, for the `readline' package, Guile +expects to be able to find the include file , +without passing any special `-I' options to the compiler. + +If you installed an external package, and you used the --prefix +installation option to install it somewhere else than /usr/local, you +must arrange for your compiler to find it by default. If that +compiler is gcc, one convenient way of making such arrangements is to +use the --with-local-prefix option during installation, naming the +same directory as you used in the --prefix option of the package. In +particular, it is not good enough to use the same --prefix option when +you install gcc and the package; you need to use the +--with-local-prefix option as well. See the gcc documentation for +more details. + + +Special Instructions For Some Systems ===================================== + +We would like Guile to build on all systems using the simple +instructions above, but it seems that a few systems still need special +treatment. If you can send us fixes for these problems, we'd be +grateful. + +SunOS 4.1: Guile's shared library support seems to be confused, but + hey; shared libraries are confusing. You may need to configure + Guile with a command like: + ./configure --disable-shared + For more information on `--disable-shared', see below, "Flags + Accepted by Configure". + +HP/UX: GCC 2.7.2 (and maybe other versions) have trouble creating + shared libraries if they depend on any non-shared libraries. GCC + seems to have other problems as well. To work around this, we + suggest you configure Guile to use the system's C compiler: + CC=cc ./configure + +NetBSD: Perry Metzger says, "Guile will build under NetBSD only using + gmake -- the native make will not work. (gmake is in our package + system, so this will not be a problem when we packagize 1.3.)" + + +Flags Accepted by Configure =============================================== + +If you run the configure script with no arguments, it should examine +your system and set things up appropriately. However, there are a few +switches specific to Guile you may find useful in some circumstances. + + +--enable-maintainer-mode + + If you have automake, autoconf, and libtool installed on your + system, this switch causes configure to generate Makefiles which + know how to automatically regenerate configure scripts, makefiles, + and headers, when they are out of date. The HACKING file says which + versions of those tools you will need. + + +--with-threads --- Build with thread support + + Build a Guile executable and library that supports cooperative + threading. If you use this switch, Guile will also build and + install the QuickThreads non-preemptive threading library, + libqthreads, which you will need to link into your programs after + libguile. When you use `guile-config', you will pick up all + neccessary linker flags automatically. + + Cooperative threads are not yet thoroughly tested; once they are, + they will be enabled by default. The interaction with blocking I/O + is pretty ad hoc at the moment. In our experience, bugs in the + thread support do not affect you if you don't actually use threads. + + +--disable-linuxthreads --- Disable pthread compatability hack on Linux + + If you experience problems on GNU/Linux that are related to + pthreads, you might try this option. Guile with then not link with + the pthreads library, but will also not try to be compatible to + programs that use both libguile and libpthread. + + +--with-modules --- Specify statically linked `modules' + + Guile can dynamically load `plugin modules' during runtime, using + facilities provided by libtool. Not all platforms support this, + however. On these platforms, you can statically link the plugin + modules into libguile when Guile itself is build. XXX - how does + one specify the modules? + + +--enable-deprecated=LEVEL --- Control the inclusion of deprecated features. + + You can select between different behaviours via the LEVEL argument: + a value of "no" will omit all deprecated features and you will get + "undefined reference", "variable unbound" or similar errors when you + try to use them. All other values will include all deprecated + features. The LEVEL argument is used to determine the default value + for the environment variable GUILE_WARN_DEPRECATED. See the README + for more information. + + The default is to get a vague warning at program exit if deprecated + features were used: + + --enable-deprecated=yes + --enable-deprecated=summary + + To get a detailed warning at first use of a deprecated feature: + + --enable-deprecated=detailed + + To get no warnings: + + --enable-deprecated=shutup + + To omit deprecated features completely and irrevokably: + + --enable-deprecated=no + + +--disable-shared --- Do not build shared libraries. +--disable-static --- Do not build static libraries. + + Normally, both static and shared libraries will be built if your + system supports them. + + +--enable-debug-freelist --- Enable freelist debugging. + + This enables a debugging version of SCM_NEWCELL(), and also + registers an extra primitive, the setter + `gc-set-debug-check-freelist!'. + + Configure with the --enable-debug-freelist option to enable the + gc-set-debug-check-freelist! primitive, and then use: + + (gc-set-debug-check-freelist! #t) # turn on checking of the freelist + (gc-set-debug-check-freelist! #f) # turn off checking + + Checking of the freelist forces a traversal of the freelist and a + garbage collection before each allocation of a cell. This can slow + down the interpreter dramatically, so the setter should be used to + turn on this extra processing only when necessary. + + +--enable-debug-malloc --- Enable malloc debugging. + + Include code for debugging of calls to scm_must_malloc/realloc/free. + + Checks that + + 1. objects freed by scm_must_free has been mallocated by scm_must_malloc + 2. objects reallocated by scm_must_realloc has been allocated by + scm_must_malloc + 3. reallocated objects are reallocated with the same what string + + But, most importantly, it records the number of allocated objects of + each kind. This is useful when searching for memory leaks. + + A Guile compiled with this option provides the primitive + `malloc-stats' which returns an alist with pairs of kind and the + number of objects of that kind. + + +--enable-guile-debug --- Include internal debugging functions +--disable-arrays --- omit array and uniform array support +--disable-posix --- omit posix interfaces +--disable-networking --- omit networking interfaces +--disable-regex --- omit regular expression interfaces + + +Cross building Guile ===================================================== + +As of guile-1.5.x, the build process uses compiled C files for +snarfing, and (indirectly, through libtool) for linking, and uses the +guile executable for generating documentation. + +When cross building guile, you first need to configure, build and +install guile for your build host. + +Then, you may configure guile for cross building, eg: + + ./configure --host=i686-pc-cygwin --disable-shared + +Two special options for cross building are available: + +--with-cc-for-build --- native C compiler, to be used during build + defaults to: `PATH=/usr/bin:$PATH cc' + +--with-guile-for-build --- native Guile executable, to be used during build + defaults to: `guile', assuming you just + installed this guile natively. + + +Using Guile Without Installing It ========================================= + +If you want to run Guile without installing it, set the environment +variable `GUILE_LOAD_PATH' to a colon-separated list of directories, +including the directory containing this INSTALL file. If you used a +separate build directory, you'll need to include the build directory +in the path as well. + +For example, suppose the Guile distribution unpacked into a directory +called `/home/jimb/guile-snap' (so the full name of this INSTALL file +would be `/home/jimb/guile-snap/INSTALL'). Then you might say, if +you're using Bash or any other Bourne shell variant, + + export GUILE_LOAD_PATH=/home/jimb/guile-snap + +or if you're using CSH or one of its variants: + + setenv GUILE_LOAD_PATH /home/jimb/guile-snap + +You will additionally need to set your `LTDL_LIBRARY_PATH' environment +variable to the directory in which the compiled SRFI support modules +are created if you want to use the modules for SRFI-4, SRFI-13 or +SRFI-14 support. Similar to the example above, this will be, + + export LTDL_LIBRARY_PATH=/home/jimb/guile-snap/srfi/.libs + +or if you're using CSH or one of its variants: + + setenv LTDL_LIBRARY_PATH /home/jimb/guile-snap/srfi/.libs + + +Installing SLIB =========================================================== + +In order to use SLIB from Guile you basically only need to put the +`slib' directory _in_ one of the directories on Guile's load path. + +The standard installation is: + + 1. Obtain slib from http://www-swiss.ai.mit.edu/~jaffer/SLIB.html + + 2. Put it in Guile's data directory, that is the directory printed when + you type + + guile-config info pkgdatadir + + at the shell prompt. This is normally `/usr/local/share/guile', so the + directory will normally have full path `/usr/local/share/guile/slib'. + + 3. Start guile as a user with write access to the data directory and type + + (use-modules (ice-9 slib)) + + at the Guile prompt. This will generate the slibcat catalog next to + the slib directory. + +SLIB's `require' is provided by the Guile module (ice-9 slib). + +Example: + + (use-modules (ice-9 slib)) + (require 'primes) + (prime? 7) + + +Generic Instructions for Building Auto-Configured Packages ================ + + The `configure' shell script attempts to guess correct values for +various system-dependent variables used during compilation. It uses +those values to create a `Makefile' in each directory of the package. +It may also create one or more `.h' files containing system-dependent +definitions. Finally, it creates a shell script `config.status' that +you can run in the future to recreate the current configuration, a file +`config.cache' that saves the results of its tests to speed up +reconfiguring, and a file `config.log' containing compiler output +(useful mainly for debugging `configure'). + + If you need to do unusual things to compile the package, please try +to figure out how `configure' could check whether to do them, and mail +diffs or instructions to the address given in the `README' so they can +be considered for the next release. If at some point `config.cache' +contains results you don't want to keep, you may remove or edit it. + + The file `configure.in' is used to create `configure' by a program +called `autoconf'. You only need `configure.in' if you want to change +it or regenerate `configure' using a newer version of `autoconf'. + +The simplest way to compile this package is: + + 1. `cd' to the directory containing the package's source code and type + `./configure' to configure the package for your system. If you're + using `csh' on an old version of System V, you might need to type + `sh ./configure' instead to prevent `csh' from trying to execute + `configure' itself. + + Running `configure' takes awhile. While running, it prints some + messages telling which features it is checking for. + + 2. Type `make' to compile the package. + + 3. Optionally, type `make check' to run any self-tests that come with + the package. + + 4. Type `make install' to install the programs and any data files and + documentation. + + 5. You can remove the program binaries and object files from the + source code directory by typing `make clean'. To also remove the + files that `configure' created (so you can compile the package for + a different kind of computer), type `make distclean'. There is + also a `make maintainer-clean' target, but that is intended mainly + for the package's developers. If you use it, you may have to get + all sorts of other programs in order to regenerate files that came + with the distribution. + +Compilers and Options +===================== + + Some systems require unusual options for compilation or linking that +the `configure' script does not know about. You can give `configure' +initial values for variables by setting them in the environment. Using +a Bourne-compatible shell, you can do that on the command line like +this: + CC=c89 CFLAGS=-O2 LIBS=-lposix ./configure + +Or on systems that have the `env' program, you can do it like this: + env CPPFLAGS=-I/usr/local/include LDFLAGS=-s ./configure + +Compiling For Multiple Architectures +==================================== + + You can compile the package for more than one kind of computer at the +same time, by placing the object files for each architecture in their +own directory. To do this, you must use a version of `make' that +supports the `VPATH' variable, such as GNU `make'. `cd' to the +directory where you want the object files and executables to go and run +the `configure' script. `configure' automatically checks for the +source code in the directory that `configure' is in and in `..'. + + If you have to use a `make' that does not supports the `VPATH' +variable, you have to compile the package for one architecture at a time +in the source code directory. After you have installed the package for +one architecture, use `make distclean' before reconfiguring for another +architecture. + +Installation Names +================== + + By default, `make install' will install the package's files in +`/usr/local/bin', `/usr/local/man', etc. You can specify an +installation prefix other than `/usr/local' by giving `configure' the +option `--prefix=PATH'. + + You can specify separate installation prefixes for +architecture-specific files and architecture-independent files. If you +give `configure' the option `--exec-prefix=PATH', the package will use +PATH as the prefix for installing programs and libraries. +Documentation and other data files will still use the regular prefix. + + In addition, if you use an unusual directory layout you can give +options like `--bindir=PATH' to specify different values for particular +kinds of files. Run `configure --help' for a list of the directories +you can set and what kinds of files go in them. + + If the package supports it, you can cause programs to be installed +with an extra prefix or suffix on their names by giving `configure' the +option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. + +Optional Features +================= + + Some packages pay attention to `--enable-FEATURE' options to +`configure', where FEATURE indicates an optional part of the package. +They may also pay attention to `--with-PACKAGE' options, where PACKAGE +is something like `gnu-as' or `x' (for the X Window System). The +`README' should mention any `--enable-' and `--with-' options that the +package recognizes. + + For packages that use the X Window System, `configure' can usually +find the X include and library files automatically, but if it doesn't, +you can use the `configure' options `--x-includes=DIR' and +`--x-libraries=DIR' to specify their locations. + +Specifying the System Type +========================== + + There may be some features `configure' can not figure out +automatically, but needs to determine by the type of host the package +will run on. Usually `configure' can figure that out, but if it prints +a message saying it can not guess the host type, give it the +`--host=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name with three fields: + CPU-COMPANY-SYSTEM + +See the file `config.sub' for the possible values of each field. If +`config.sub' isn't included in this package, then this package doesn't +need to know the host type. + + If you are building compiler tools for cross-compiling, you can also +use the `--target=TYPE' option to select the type of system they will +produce code for and the `--build=TYPE' option to select the type of +system on which you are compiling the package. + +Sharing Defaults +================ + + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. +`configure' looks for `PREFIX/share/config.site' if it exists, then +`PREFIX/etc/config.site' if it exists. Or, you can set the +`CONFIG_SITE' environment variable to the location of the site script. +A warning: not all `configure' scripts look for a site script. + +Operation Controls +================== + + `configure' recognizes the following options to control how it +operates. + +`--cache-file=FILE' + Use and save the results of the tests in FILE instead of + `./config.cache'. Set FILE to `/dev/null' to disable caching, for + debugging `configure'. + +`--help' + Print a summary of the options to `configure', and exit. + +`--quiet' +`--silent' +`-q' + Do not print messages saying which checks are being made. To + suppress all normal output, redirect it to `/dev/null' (any error + messages will still be shown). + +`--srcdir=DIR' + Look for the package's source code in directory DIR. Usually + `configure' can determine that directory automatically. + +`--version' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`configure' also accepts some other, not widely useful, options. diff --git a/autogen.sh b/autogen.sh index 40f71ec01..2bdd95a90 100755 --- a/autogen.sh +++ b/autogen.sh @@ -21,7 +21,7 @@ fi : found workbook at $workbook workbook=`(cd $workbook ; pwd)` -workbookdistfiles="ANON-CVS HACKING INSTALL SNAPSHOTS" +workbookdistfiles="ANON-CVS HACKING SNAPSHOTS" for f in $workbookdistfiles ; do rm -f $f ln -s $workbook/build/dist-files/$f $f From ca679709cc93f1052cebee0d8218df27ebb9948c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 7 Jul 2002 20:22:15 +0000 Subject: [PATCH 036/306] *** empty log message *** --- ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog b/ChangeLog index 78fc5c065..7c07d30c0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2002-07-07 Marius Vollmer + * autogen.sh: Do not copy INSTALL from workbook since it is not + uniform across branches. + * INSTALL: Re-added to repository. + Crosscompiling and Cygwin fixes from Jan Nieuwenhuizen. Thanks! * autogen.sh: Only fix libltdl/configure.in if it exists. Current From 658b35a01e095ff9ed026847cddb1ae61016bea2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 8 Jul 2002 18:55:21 +0000 Subject: [PATCH 037/306] Renamed :rename to :renamer. --- doc/ref/scheme-modules.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index b2895f636..75b739647 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -178,7 +178,7 @@ them to suit the current module's needs. For example: @smalllisp (use-modules ((ice-9 popen) :select ((open-pipe . pipe-open) close-pipe) - :rename (symbol-prefix-proc 'unixy:))) + :renamer (symbol-prefix-proc 'unixy:))) @end smalllisp Here, the interface specification is more complex than before, and the @@ -215,7 +215,7 @@ whose public interface is found and used. @var{spec} can also be of the form: @smalllisp - (MODULE-NAME [:select SELECTION] [:rename RENAMER]) + (MODULE-NAME [:select SELECTION] [:renamer RENAMER]) @end smalllisp in which case a custom interface is newly created and used. @@ -226,7 +226,7 @@ a pair of symbols @code{(ORIG . SEEN)}, where @var{orig} is the name in the used module and @var{seen} is the name in the using module. Note that @var{seen} is also passed through @var{renamer}. -The @code{:select} and @code{:rename} clauses are optional. If both are +The @code{:select} and @code{:renamer} clauses are optional. If both are omitted, the returned interface has no bindings. If the @code{:select} clause is omitted, @var{renamer} operates on the used module's public interface. From 9ffa41dbaeeb2ecbe58b3f2e5e4761e4520f6e64 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Mon, 8 Jul 2002 20:40:32 +0000 Subject: [PATCH 038/306] * goops.scm (define-generic, define-accessor): Make sure that implicit redefines only happen on top level. * goops.scm (define-class, define-generic, define-accessor), goops/stklos.scm (define-class): Use mmacros instead of macros. --- oop/ChangeLog | 8 ++++++++ oop/goops.scm | 14 ++++++++------ oop/goops/stklos.scm | 4 ++-- 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/oop/ChangeLog b/oop/ChangeLog index df483c652..0bde849e4 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,11 @@ +2002-07-08 Dirk Herrmann + + * goops.scm (define-generic, define-accessor): Make sure that + implicit redefines only happen on top level. + + * goops.scm (define-class, define-generic, define-accessor), + goops/stklos.scm (define-class): Use mmacros instead of macros. + 2002-07-07 Dirk Herrmann * goops/save.scm (restore): Replaced "macro" by mmacro. diff --git a/oop/goops.scm b/oop/goops.scm index b8f63ff27..6f7721d80 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1998,1999,2000,2001,2002 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -224,7 +224,7 @@ (name cadr) (slots cdddr)) - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (cond ((not (top-level-env? env)) (goops-error "define-class: Only allowed at top level")) @@ -361,12 +361,13 @@ ;;; (define define-generic - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (let ((name (cadr exp))) (cond ((not (symbol? name)) (goops-error "bad generic function name: ~S" name)) - ((defined? name env) + ((and (top-level-env? env) + (defined? name env)) `(define ,name (if (is-a? ,name ) (make #:name ',name) @@ -391,12 +392,13 @@ (else (make #:name name))))) (define define-accessor - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (let ((name (cadr exp))) (cond ((not (symbol? name)) (goops-error "bad accessor name: ~S" name)) - ((defined? name env) + ((and (top-level-env? env) + (defined? name env)) `(define ,name (if (and (is-a? ,name ) (is-a? (setter ,name) )) diff --git a/oop/goops/stklos.scm b/oop/goops/stklos.scm index 4d84df444..10e0eba3b 100644 --- a/oop/goops/stklos.scm +++ b/oop/goops/stklos.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999 Free Software Foundation, Inc. +;;;; Copyright (C) 1999,2002 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -81,7 +81,7 @@ (supers caddr) (slots cadddr) (rest cddddr)) - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (standard-define-class-transformer `(define-class ,(name exp) ,(supers exp) ,@(slots exp) From 6012c379ae920f4282d63993fd6ad760653d4b7a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 8 Jul 2002 20:55:20 +0000 Subject: [PATCH 039/306] (make-exchanger): Added. Thanks to Clinton Ebadi! --- ice-9/slib.scm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ice-9/slib.scm b/ice-9/slib.scm index e91edaedc..dc40c2ee0 100644 --- a/ice-9/slib.scm +++ b/ice-9/slib.scm @@ -326,3 +326,6 @@ no other easy or unambiguous way of detecting such features." (set-cdr! entry path-name) (set! *catalog* (acons name path-name *catalog*)))))) + +(define (make-exchanger obj) + (lambda (rep) (let ((old obj)) (set! obj rep) old))) From fdf7e1d7ed9cbfe4760d94c7673cd8b360f49d1e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 8 Jul 2002 20:55:30 +0000 Subject: [PATCH 040/306] *** empty log message *** --- ice-9/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 32985e46c..18ef926ce 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,7 @@ +2002-07-08 Marius Vollmer + + * slib.scm (make-exchanger): Added. Thanks to Clinton Ebadi! + 2002-07-07 Dirk Herrmann * boot-9.scm (define-option-interface): Replaced "macro" by From 9c52b218146e5224096b1730858001f16c1aee95 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Mon, 8 Jul 2002 23:41:00 +0000 Subject: [PATCH 041/306] * gc_os_dep.c: HURD fixes. --- libguile/gc_os_dep.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/libguile/gc_os_dep.c b/libguile/gc_os_dep.c index 89346c705..0e387f029 100644 --- a/libguile/gc_os_dep.c +++ b/libguile/gc_os_dep.c @@ -342,6 +342,11 @@ typedef int GC_bool; # endif # define mach_type_known # endif +# if defined(__GNU__) +# define I386 +# define GNU +# define mach_type_known +# endif /* Feel free to add more clauses here */ @@ -933,6 +938,9 @@ typedef int GC_bool; # define DATASTART ((ptr_t) &__nullarea) # define DATAEND ((ptr_t) &_end) # endif +# ifdef GNU +# define OS_TYPE "GNU" +# endif # endif # ifdef NS32K From c09d12e0fdaae1814c31b88af311271ad2c5036d Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Tue, 9 Jul 2002 04:42:49 +0000 Subject: [PATCH 042/306] *** empty log message *** --- libguile/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 0a5114d32..6aaad7db1 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-07-08 Rob Browning + + * gc_os_dep.c: HURD fixes. + 2002-07-07 Marius Vollmer Crosscompiling and Cygwin fixes by Jan Nieuwenhuizen. Thanks! From 0f59dd5fe6ee1c28820e785d5f85048e72c7743a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 9 Jul 2002 13:25:40 +0000 Subject: [PATCH 043/306] Patch libltdl/ltdl.c to avoid a nasty bug in libtool-1.4.2. --- autogen.sh | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/autogen.sh b/autogen.sh index 2bdd95a90..a41df1179 100755 --- a/autogen.sh +++ b/autogen.sh @@ -55,6 +55,34 @@ if [ -f libltdl/configure.in ]; then cat libltdl/configure.tmp >> libltdl/configure.in rm libltdl/configure.tmp fi + +# Maybe patch ltdl.c. This is only needed for 1.4.2 and earlier. +if patch libltdl/ltdl.c < Date: Tue, 9 Jul 2002 13:25:53 +0000 Subject: [PATCH 044/306] *** empty log message *** --- ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ChangeLog b/ChangeLog index 7c07d30c0..b7c6d3c8a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2002-07-09 Marius Vollmer + + * autogen.sh: Patch libltdl/ltdl.c to avoid a nasty bug in + libtool-1.4.2. + 2002-07-07 Marius Vollmer * autogen.sh: Do not copy INSTALL from workbook since it is not From fc5c6d0047b0dd3edf8b9827ebf31d2156c6c36b Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Tue, 9 Jul 2002 21:09:58 +0000 Subject: [PATCH 045/306] * docstring.el: defined caddr, used in several places but missing for some reason. --- doc/maint/ChangeLog | 5 +++++ doc/maint/docstring.el | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/doc/maint/ChangeLog b/doc/maint/ChangeLog index 7e8cd2eae..36735af2d 100644 --- a/doc/maint/ChangeLog +++ b/doc/maint/ChangeLog @@ -1,3 +1,8 @@ +2002-07-09 Gary Houston + + * docstring.el: defined caddr, used in several places but missing + for some reason. + 2002-04-02 Thien-Thi Nguyen * doctring.el: List commands in commentary; nfc. diff --git a/doc/maint/docstring.el b/doc/maint/docstring.el index dddc8ba92..fda0b466b 100644 --- a/doc/maint/docstring.el +++ b/doc/maint/docstring.el @@ -243,6 +243,10 @@ to which new docstrings should be added.") alist)))))))))) alist)) +;; missing in some environments? +(defun caddr (list) + (nth 2 list)) + ;; Return the docstring from the specified LOCATION. LOCATION is a ;; list of three elements: buffer, start position and end position. (defun location-to-docstring (location) From 46732b5441d3a4056fdde7f933d40b2f16f5eebf Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Tue, 9 Jul 2002 22:40:03 +0000 Subject: [PATCH 046/306] * dynl.c (scm_dynamic_call): docstring editing. --- doc/maint/guile.texi | 29 ++++++++++++++++++----------- doc/ref/new-docstrings.texi | 12 +++++++++++- doc/ref/scheme-modules.texi | 29 ++++++++++++++++++----------- libguile/ChangeLog | 4 ++++ libguile/dynl.c | 25 ++++++++++++++++--------- 5 files changed, 67 insertions(+), 32 deletions(-) diff --git a/doc/maint/guile.texi b/doc/maint/guile.texi index ed7576b51..84a4c1c8f 100644 --- a/doc/maint/guile.texi +++ b/doc/maint/guile.texi @@ -493,18 +493,25 @@ needed or not and will add it when necessary. dynamic-call @deffn {Scheme Procedure} dynamic-call func dobj @deffnx {C Function} scm_dynamic_call (func, dobj) -Call the C function indicated by @var{func} and @var{dobj}. -The function is passed no arguments and its return value is -ignored. When @var{function} is something returned by -@code{dynamic-func}, call that function and ignore @var{dobj}. -When @var{func} is a string , look it up in @var{dynobj}; this -is equivalent to -@smallexample -(dynamic-call (dynamic-func @var{func} @var{dobj} #f)) -@end smallexample +Call a C function in a dynamic object. Two styles of +invocation are supported: -Interrupts are deferred while the C function is executing (with -@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}). +@itemize @bullet +@item @var{func} can be a function handle returned by +@code{dynamic-func}. In this case @var{dobj} is +ignored +@item @var{func} can be a string with the name of the +function to call, with @var{dobj} the handle of the +dynamic object in which to find the function. +This is equivalent to +@smallexample + +(dynamic-call (dynamic-func @var{func} @var{dobj}) #f) +@end smallexample +@end itemize + +In either case, the function is passed no arguments +and its return value is ignored. @end deffn dynamic-args-call diff --git a/doc/ref/new-docstrings.texi b/doc/ref/new-docstrings.texi index 2180561a6..17aa45680 100644 --- a/doc/ref/new-docstrings.texi +++ b/doc/ref/new-docstrings.texi @@ -412,7 +412,7 @@ from the arguments @var{initargs}. @end deffn @deffn {Scheme Procedure} slot-exists? obj slot_name -@deffnx {C Function} scm_slots_exists_p (obj, slot_name) +@deffnx {C Function} scm_slot_exists_p (obj, slot_name) Return @code{#t} if @var{obj} has a slot named @var{slot_name}. @end deffn @@ -689,3 +689,13 @@ implemented by the C function "scm_single_thread_p" Return an integer that for the lifetime of @var{obj} is uniquely returned by this function for @var{obj} @end deffn + +@deffn {Scheme Procedure} nan +@deffnx {C Function} scm_nan () +Return NaN. +@end deffn + +@deffn {Scheme Procedure} inf +@deffnx {C Function} scm_inf () +Return Inf. +@end deffn diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index 75b739647..032330973 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -542,18 +542,25 @@ needed or not and will add it when necessary. @deffn {Scheme Procedure} dynamic-call func dobj @deffnx {C Function} scm_dynamic_call (func, dobj) -Call the C function indicated by @var{func} and @var{dobj}. -The function is passed no arguments and its return value is -ignored. When @var{function} is something returned by -@code{dynamic-func}, call that function and ignore @var{dobj}. -When @var{func} is a string , look it up in @var{dynobj}; this -is equivalent to -@smallexample -(dynamic-call (dynamic-func @var{func} @var{dobj} #f)) -@end smallexample +Call a C function in a dynamic object. Two styles of +invocation are supported: -Interrupts are deferred while the C function is executing (with -@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}). +@itemize @bullet +@item @var{func} can be a function handle returned by +@code{dynamic-func}. In this case @var{dobj} is +ignored +@item @var{func} can be a string with the name of the +function to call, with @var{dobj} the handle of the +dynamic object in which to find the function. +This is equivalent to +@smallexample + +(dynamic-call (dynamic-func @var{func} @var{dobj}) #f) +@end smallexample +@end itemize + +In either case, the function is passed no arguments +and its return value is ignored. @end deffn @deffn {Scheme Procedure} dynamic-args-call func dobj args diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 6aaad7db1..c347f3225 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-07-09 Gary Houston + + * dynl.c (scm_dynamic_call): docstring editing. + 2002-07-08 Rob Browning * gc_os_dep.c: HURD fixes. diff --git a/libguile/dynl.c b/libguile/dynl.c index de4ee6ca0..4d90827cb 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -284,15 +284,22 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, (SCM func, SCM dobj), - "Call the C function indicated by @var{func} and @var{dobj}.\n" - "The function is passed no arguments and its return value is\n" - "ignored. When @var{function} is something returned by\n" - "@code{dynamic-func}, call that function and ignore @var{dobj}.\n" - "When @var{func} is a string , look it up in @var{dynobj}; this\n" - "is equivalent to\n" - "@smallexample\n" - "(dynamic-call (dynamic-func @var{func} @var{dobj} #f))\n" - "@end smallexample\n\n") + "Call a C function in a dynamic object. Two styles of\n" + "invocation are supported:\n\n" + "@itemize @bullet\n" + "@item @var{func} can be a function handle returned by\n" + "@code{dynamic-func}. In this case @var{dobj} is\n" + "ignored\n" + "@item @var{func} can be a string with the name of the\n" + "function to call, with @var{dobj} the handle of the\n" + "dynamic object in which to find the function.\n" + "This is equivalent to\n" + "@smallexample\n\n" + "(dynamic-call (dynamic-func @var{func} @var{dobj}) #f)\n" + "@end smallexample\n" + "@end itemize\n\n" + "In either case, the function is passed no arguments\n" + "and its return value is ignored.") #define FUNC_NAME s_scm_dynamic_call { void (*fptr) (); From 59afd555379f753cca37039c3111c743dc3f782c Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Wed, 10 Jul 2002 17:18:41 +0000 Subject: [PATCH 047/306] * docstring.el: optional 2nd environment variable to locate built files. --- doc/maint/ChangeLog | 5 +++++ doc/maint/README | 15 +++++++++++---- doc/maint/docstring.el | 14 +++++++++++--- 3 files changed, 27 insertions(+), 7 deletions(-) diff --git a/doc/maint/ChangeLog b/doc/maint/ChangeLog index 36735af2d..dc3bccbfe 100644 --- a/doc/maint/ChangeLog +++ b/doc/maint/ChangeLog @@ -1,3 +1,8 @@ +2002-07-10 Gary Houston + + * docstring.el: optional 2nd environment variable to locate + built files. + 2002-07-09 Gary Houston * docstring.el: defined caddr, used in several places but missing diff --git a/doc/maint/README b/doc/maint/README index c06599127..adfa13f82 100644 --- a/doc/maint/README +++ b/doc/maint/README @@ -13,11 +13,18 @@ in the libguile C source change. `docstring-process-module' and `docstring-ediff-this-line'. -- guile.texi is a snapshot of the built file - guile-core/libguile/guile.texi, copied last time the reference - manual was determined to be in sync with the libguile source. +- guile.texi is a snapshot of the built file libguile/guile.texi, + copied last time the reference manual was determined to be in sync + with the libguile source. -For example: +docstring.el requires the setting of an environment variable, e.g., + +export GUILE_MAINTAINER_GUILE_CORE_DIR=$HOME/guile/guile-core + +If the build directory differs from the source directory, an additional +variable is required: + +export GUILE_MAINTAINER_BUILD_CORE_DIR=$HOME/guile/guile-core-build If you've just fixed a docstring in, say, ../libguile/strop.c, do in emacs: diff --git a/doc/maint/docstring.el b/doc/maint/docstring.el index fda0b466b..263d763ff 100644 --- a/doc/maint/docstring.el +++ b/doc/maint/docstring.el @@ -63,10 +63,14 @@ ;; docstring-ediff-this-line ;; docstring-show-source -;;; Code: (defvar guile-core-dir (or (getenv "GUILE_MAINTAINER_GUILE_CORE_DIR") - "~/Guile/cvs/guile-core")) + (error "GUILE_MAINTAINER_GUILE_CORE_DIR not set")) + "*Full path of guile-core source directory.") + +(defvar guile-build-dir (or (getenv "GUILE_MAINTAINER_BUILD_CORE_DIR") + guile-core-dir) + "*Full path of guile-core build directory. Defaults to guile-core-dir.") (defvar docstring-manual-directory (expand-file-name "doc/ref" guile-core-dir) "*The directory containing the Texinfo source for the Guile reference manual.") @@ -555,6 +559,10 @@ new snarfed docstring file.\n\n") guile-core-dir) "*The directory containing the C source for libguile.") +(defvar docstring-libguile-build-directory (expand-file-name "libguile" + guile-build-dir) + "*The directory containing the libguile build directory.") + (defun docstring-display-location (file line) (let ((buffer (find-file-noselect (expand-file-name file docstring-libguile-directory)))) @@ -589,7 +597,7 @@ docstring so that it is easy for you to do this." (end-of-line) (point))))) (guile-texi-file - (expand-file-name "guile.texi" docstring-libguile-directory)) + (expand-file-name "guile.texi" docstring-libguile-build-directory)) (source-location (save-excursion (set-buffer (find-file-noselect guile-texi-file)) From d2e13cf79d62ebab9df0a37d38451abaa74546d6 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Wed, 10 Jul 2002 18:13:59 +0000 Subject: [PATCH 048/306] *** empty log message *** --- doc/maint/docstring.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/maint/docstring.el b/doc/maint/docstring.el index 263d763ff..a01558fbb 100644 --- a/doc/maint/docstring.el +++ b/doc/maint/docstring.el @@ -82,7 +82,7 @@ for module (a b c) is expected to be in the file (defvar docstring-snarfed-roots (mapcar #'(lambda (frag) - (expand-file-name frag guile-core-dir)) + (expand-file-name frag guile-build-dir)) '("libguile" "ice-9" "oop")) "*List of possible root directories for snarfed docstring files. For each entry in this list, the snarfed docstring file for module (a From f87c105ae3ffbf1dadddf7685e9f8d176aa536d4 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 10 Jul 2002 19:40:43 +0000 Subject: [PATCH 049/306] No need to check for Cygwin when including , this is already check for by configure. Thus, revert change from 2002-07-07. --- libguile/guile.c | 3 +-- libguile/iselect.h | 3 +-- libguile/net_db.c | 3 +-- libguile/posix.c | 3 +-- libguile/socket.c | 3 +-- 5 files changed, 5 insertions(+), 10 deletions(-) diff --git a/libguile/guile.c b/libguile/guile.c index 23e41d0ac..ae17a9606 100644 --- a/libguile/guile.c +++ b/libguile/guile.c @@ -58,8 +58,7 @@ #include #endif -#if defined (HAVE_WINSOCK2_H) \ - && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) +#ifdef HAVE_WINSOCK2_H #include #endif diff --git a/libguile/iselect.h b/libguile/iselect.h index a7db8706b..1d27013fb 100644 --- a/libguile/iselect.h +++ b/libguile/iselect.h @@ -68,8 +68,7 @@ #include #endif -#if defined (HAVE_WINSOCK2_H) \ - && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) +#if HAVE_WINSOCK2_H #include #endif diff --git a/libguile/net_db.c b/libguile/net_db.c index d0602ba23..ecb075c8b 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -65,8 +65,7 @@ #include -#if defined (HAVE_WINSOCK2_H) \ - && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) +#ifdef HAVE_WINSOCK2_H #include #else #include diff --git a/libguile/posix.c b/libguile/posix.c index e7416974a..066e0f90b 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -96,8 +96,7 @@ extern char *ttyname(); #ifdef HAVE_IO_H #include #endif -#if defined (HAVE_WINSOCK2_H) \ - && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) +#ifdef HAVE_WINSOCK2_H #include #endif diff --git a/libguile/socket.c b/libguile/socket.c index 49501b72c..86b61aca1 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -68,8 +68,7 @@ #include #endif #include -#if defined (HAVE_WINSOCK2_H) \ - && !(defined (__CYGWIN32__) || defined (__CYGWIN__)) +#ifdef HAVE_WINSOCK2_H #include #else #include From ee95d597c7cba6b034b3454c021eaf5aeba0380b Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Wed, 10 Jul 2002 22:20:16 +0000 Subject: [PATCH 050/306] * dynl.c: docstring editing. --- libguile/ChangeLog | 4 ++++ libguile/dynl.c | 42 ++++++++++++++++++++++++------------------ 2 files changed, 28 insertions(+), 18 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c347f3225..278f26b90 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-07-10 Gary Houston + + * dynl.c: docstring editing. + 2002-07-09 Gary Houston * dynl.c (scm_dynamic_call): docstring editing. diff --git a/libguile/dynl.c b/libguile/dynl.c index 4d90827cb..494b88dfe 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -201,10 +201,15 @@ dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate) SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0, (SCM filename), - "Open the dynamic library called @var{filename}. A library\n" - "handle representing the opened library is returned; this handle\n" - "should be used as the @var{dobj} argument to the following\n" - "functions.") + "Find the shared object (shared library) denoted by\n" + "@var{filename} and link it into the running Guile\n" + "application. The returned\n" + "scheme object is a ``handle'' for the library which can\n" + "be passed to @code{dynamic-func}, @code{dynamic-call} etc.\n\n" + "Searching for object files is system dependent. Normally,\n" + "if @var{filename} does have an explicit directory it will\n" + "be searched for in locations\n" + "such as @file{/usr/lib} and @file{/usr/local/lib}.") #define FUNC_NAME s_scm_dynamic_link { void *handle; @@ -218,8 +223,8 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0, SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0, (SCM obj), - "Return @code{#t} if @var{obj} is a dynamic library handle, or @code{#f}\n" - "otherwise.") + "Return @code{#t} if @var{obj} is a dynamic object handle,\n" + "or @code{#f} otherwise.") #define FUNC_NAME s_scm_dynamic_object_p { return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj)); @@ -229,10 +234,11 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0, SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0, (SCM dobj), - "Unlink the indicated object file from the application. The\n" - "argument @var{dobj} must have been obtained by a call to\n" - "@code{dynamic-link}. After @code{dynamic-unlink} has been\n" - "called on @var{dobj}, its content is no longer accessible.") + "Unlink a dynamic object from the application, if possible. The\n" + "object must have been linked by @code{dynamic-link}, with \n" + "@var{dobj} the corresponding handle. After this procedure\n" + "is called, the handle can no longer be used to access the\n" + "object.") #define FUNC_NAME s_scm_dynamic_unlink { /*fixme* GC-problem */ @@ -250,14 +256,14 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0, SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, (SCM name, SCM dobj), - "Search the dynamic object @var{dobj} for the C function\n" - "indicated by the string @var{name} and return some Scheme\n" - "handle that can later be used with @code{dynamic-call} to\n" - "actually call the function.\n\n" - "Regardless whether your C compiler prepends an underscore @samp{_} to\n" - "the global names in a program, you should @strong{not} include this\n" - "underscore in @var{function}. Guile knows whether the underscore is\n" - "needed or not and will add it when necessary.") + "Return a ``handle'' for the function @var{name} in the\n" + "shared object referred to by @var{dobj}. The handle\n" + "can be passed to @code{dynamic-call} to actually\n" + "call the function.\n\n" + "Regardless whether your C compiler prepends an underscore\n" + "@samp{_} to the global names in a program, you should\n" + "@strong{not} include this underscore in @var{name}\n" + "since it will be added automatically when necessary.") #define FUNC_NAME s_scm_dynamic_func { /* The returned handle is formed by casting the address of the function to a From dd235de4a69805f20b2f57f7b9dc58de7369733e Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Wed, 10 Jul 2002 22:21:25 +0000 Subject: [PATCH 051/306] * scheme-modules.texi (Compiled Code Modules): Removed description of scm_register_module_xxx, which no longer exists. A description of current techniques is needed. --- doc/maint/guile.texi | 928 ++++++++++++++++++++++++++++++++---- doc/ref/ChangeLog | 6 + doc/ref/scheme-modules.texi | 145 ++---- 3 files changed, 882 insertions(+), 197 deletions(-) diff --git a/doc/maint/guile.texi b/doc/maint/guile.texi index 84a4c1c8f..fa8125594 100644 --- a/doc/maint/guile.texi +++ b/doc/maint/guile.texi @@ -1,5 +1,6 @@ acons +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:59 @deffn {Scheme Procedure} acons key value alist @deffnx {C Function} scm_acons (key, value, alist) Add a new key-value pair to @var{alist}. A new pair is @@ -9,6 +10,7 @@ function is @emph{not} destructive; @var{alist} is not modified. @end deffn sloppy-assq +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:73 @deffn {Scheme Procedure} sloppy-assq key alist @deffnx {C Function} scm_sloppy_assq (key, alist) Behaves like @code{assq} but does not do any error checking. @@ -16,6 +18,7 @@ Recommended only for use in Guile internals. @end deffn sloppy-assv +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:91 @deffn {Scheme Procedure} sloppy-assv key alist @deffnx {C Function} scm_sloppy_assv (key, alist) Behaves like @code{assv} but does not do any error checking. @@ -23,6 +26,7 @@ Recommended only for use in Guile internals. @end deffn sloppy-assoc +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:109 @deffn {Scheme Procedure} sloppy-assoc key alist @deffnx {C Function} scm_sloppy_assoc (key, alist) Behaves like @code{assoc} but does not do any error checking. @@ -30,6 +34,7 @@ Recommended only for use in Guile internals. @end deffn assq +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:136 @deffn {Scheme Procedure} assq key alist @deffnx {Scheme Procedure} assv key alist @deffnx {Scheme Procedure} assoc key alist @@ -44,18 +49,21 @@ return the entire alist entry found (i.e. both the key and the value). @end deffn assv +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:157 @deffn {Scheme Procedure} assv key alist @deffnx {C Function} scm_assv (key, alist) Behaves like @code{assq} but uses @code{eqv?} for key comparison. @end deffn assoc +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:178 @deffn {Scheme Procedure} assoc key alist @deffnx {C Function} scm_assoc (key, alist) Behaves like @code{assq} but uses @code{equal?} for key comparison. @end deffn assq-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:222 @deffn {Scheme Procedure} assq-ref alist key @deffnx {Scheme Procedure} assv-ref alist key @deffnx {Scheme Procedure} assoc-ref alist key @@ -73,18 +81,21 @@ where @var{associator} is one of @code{assq}, @code{assv} or @code{assoc}. @end deffn assv-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:239 @deffn {Scheme Procedure} assv-ref alist key @deffnx {C Function} scm_assv_ref (alist, key) Behaves like @code{assq-ref} but uses @code{eqv?} for key comparison. @end deffn assoc-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:256 @deffn {Scheme Procedure} assoc-ref alist key @deffnx {C Function} scm_assoc_ref (alist, key) Behaves like @code{assq-ref} but uses @code{equal?} for key comparison. @end deffn assq-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:285 @deffn {Scheme Procedure} assq-set! alist key val @deffnx {Scheme Procedure} assv-set! alist key value @deffnx {Scheme Procedure} assoc-set! alist key value @@ -100,18 +111,21 @@ association list. @end deffn assv-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:303 @deffn {Scheme Procedure} assv-set! alist key val @deffnx {C Function} scm_assv_set_x (alist, key, val) Behaves like @code{assq-set!} but uses @code{eqv?} for key comparison. @end deffn assoc-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:321 @deffn {Scheme Procedure} assoc-set! alist key val @deffnx {C Function} scm_assoc_set_x (alist, key, val) Behaves like @code{assq-set!} but uses @code{equal?} for key comparison. @end deffn assq-remove! +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:345 @deffn {Scheme Procedure} assq-remove! alist key @deffnx {Scheme Procedure} assv-remove! alist key @deffnx {Scheme Procedure} assoc-remove! alist key @@ -121,18 +135,21 @@ the resulting alist. @end deffn assv-remove! +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:361 @deffn {Scheme Procedure} assv-remove! alist key @deffnx {C Function} scm_assv_remove_x (alist, key) Behaves like @code{assq-remove!} but uses @code{eqv?} for key comparison. @end deffn assoc-remove! +@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:377 @deffn {Scheme Procedure} assoc-remove! alist key @deffnx {C Function} scm_assoc_remove_x (alist, key) Behaves like @code{assq-remove!} but uses @code{equal?} for key comparison. @end deffn make-arbiter +@c snarfed from /home/ghouston/guile/guile-core/libguile/arbiters.c:82 @deffn {Scheme Procedure} make-arbiter name @deffnx {C Function} scm_make_arbiter (name) Return an object of type arbiter and name @var{name}. Its @@ -141,6 +158,7 @@ process synchronization. @end deffn try-arbiter +@c snarfed from /home/ghouston/guile/guile-core/libguile/arbiters.c:92 @deffn {Scheme Procedure} try-arbiter arb @deffnx {C Function} scm_try_arbiter (arb) Return @code{#t} and lock the arbiter @var{arb} if the arbiter @@ -148,6 +166,7 @@ was unlocked. Otherwise, return @code{#f}. @end deffn release-arbiter +@c snarfed from /home/ghouston/guile/guile-core/libguile/arbiters.c:113 @deffn {Scheme Procedure} release-arbiter arb @deffnx {C Function} scm_release_arbiter (arb) Return @code{#t} and unlock the arbiter @var{arb} if the @@ -155,12 +174,14 @@ arbiter was locked. Otherwise, return @code{#f}. @end deffn async +@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:289 @deffn {Scheme Procedure} async thunk @deffnx {C Function} scm_async (thunk) Create a new async for the procedure @var{thunk}. @end deffn system-async +@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:299 @deffn {Scheme Procedure} system-async thunk @deffnx {C Function} scm_system_async (thunk) Create a new async for the procedure @var{thunk}. Also @@ -168,24 +189,28 @@ add it to the system's list of active async objects. @end deffn async-mark +@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:310 @deffn {Scheme Procedure} async-mark a @deffnx {C Function} scm_async_mark (a) Mark the async @var{a} for future execution. @end deffn system-async-mark +@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:326 @deffn {Scheme Procedure} system-async-mark a @deffnx {C Function} scm_system_async_mark (a) Mark the async @var{a} for future execution. @end deffn run-asyncs +@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:351 @deffn {Scheme Procedure} run-asyncs list_of_a @deffnx {C Function} scm_run_asyncs (list_of_a) Execute all thunks from the asyncs of the list @var{list_of_a}. @end deffn noop +@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:385 @deffn {Scheme Procedure} noop . args @deffnx {C Function} scm_noop (args) Do nothing. When called without arguments, return @code{#f}, @@ -193,18 +218,21 @@ otherwise return the first argument. @end deffn unmask-signals +@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:437 @deffn {Scheme Procedure} unmask-signals @deffnx {C Function} scm_unmask_signals () Unmask signals. The returned value is not specified. @end deffn mask-signals +@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:448 @deffn {Scheme Procedure} mask-signals @deffnx {C Function} scm_mask_signals () Mask signals. The returned value is not specified. @end deffn display-error +@c snarfed from /home/ghouston/guile/guile-core/libguile/backtrace.c:264 @deffn {Scheme Procedure} display-error stack port subr message args rest @deffnx {C Function} scm_display_error (stack, port, subr, message, args, rest) Display an error message to the output port @var{port}. @@ -217,6 +245,7 @@ ignored. @end deffn display-application +@c snarfed from /home/ghouston/guile/guile-core/libguile/backtrace.c:400 @deffn {Scheme Procedure} display-application frame [port [indent]] @deffnx {C Function} scm_display_application (frame, port, indent) Display a procedure application @var{frame} to the output port @@ -225,6 +254,7 @@ output. @end deffn display-backtrace +@c snarfed from /home/ghouston/guile/guile-core/libguile/backtrace.c:711 @deffn {Scheme Procedure} display-backtrace stack port [first [depth]] @deffnx {C Function} scm_display_backtrace (stack, port, first, depth) Display a backtrace to the output port @var{port}. @var{stack} @@ -235,6 +265,7 @@ which means that default values will be used. @end deffn backtrace +@c snarfed from /home/ghouston/guile/guile-core/libguile/backtrace.c:734 @deffn {Scheme Procedure} backtrace @deffnx {C Function} scm_backtrace () Display a backtrace of the stack saved by the last error @@ -242,83 +273,97 @@ to the current output port. @end deffn not +@c snarfed from /home/ghouston/guile/guile-core/libguile/boolean.c:55 @deffn {Scheme Procedure} not x @deffnx {C Function} scm_not (x) Return @code{#t} iff @var{x} is @code{#f}, else return @code{#f}. @end deffn boolean? +@c snarfed from /home/ghouston/guile/guile-core/libguile/boolean.c:65 @deffn {Scheme Procedure} boolean? obj @deffnx {C Function} scm_boolean_p (obj) Return @code{#t} iff @var{obj} is either @code{#t} or @code{#f}. @end deffn char? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:54 @deffn {Scheme Procedure} char? x @deffnx {C Function} scm_char_p (x) Return @code{#t} iff @var{x} is a character, else @code{#f}. @end deffn char=? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:63 @deffn {Scheme Procedure} char=? x y Return @code{#t} iff @var{x} is the same character as @var{y}, else @code{#f}. @end deffn char? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:100 @deffn {Scheme Procedure} char>? x y Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII sequence, else @code{#f}. @end deffn char>=? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:112 @deffn {Scheme Procedure} char>=? x y Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the ASCII sequence, else @code{#f}. @end deffn char-ci=? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:124 @deffn {Scheme Procedure} char-ci=? x y Return @code{#t} iff @var{x} is the same character as @var{y} ignoring case, else @code{#f}. @end deffn char-ci? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:160 @deffn {Scheme Procedure} char-ci>? x y Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII sequence ignoring case, else @code{#f}. @end deffn char-ci>=? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:172 @deffn {Scheme Procedure} char-ci>=? x y Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the ASCII sequence ignoring case, else @code{#f}. @end deffn char-alphabetic? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:185 @deffn {Scheme Procedure} char-alphabetic? chr @deffnx {C Function} scm_char_alphabetic_p (chr) Return @code{#t} iff @var{chr} is alphabetic, else @code{#f}. @@ -326,6 +371,7 @@ Alphabetic means the same thing as the isalpha C library function. @end deffn char-numeric? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:196 @deffn {Scheme Procedure} char-numeric? chr @deffnx {C Function} scm_char_numeric_p (chr) Return @code{#t} iff @var{chr} is numeric, else @code{#f}. @@ -333,6 +379,7 @@ Numeric means the same thing as the isdigit C library function. @end deffn char-whitespace? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:207 @deffn {Scheme Procedure} char-whitespace? chr @deffnx {C Function} scm_char_whitespace_p (chr) Return @code{#t} iff @var{chr} is whitespace, else @code{#f}. @@ -340,6 +387,7 @@ Whitespace means the same thing as the isspace C library function. @end deffn char-upper-case? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:220 @deffn {Scheme Procedure} char-upper-case? chr @deffnx {C Function} scm_char_upper_case_p (chr) Return @code{#t} iff @var{chr} is uppercase, else @code{#f}. @@ -347,6 +395,7 @@ Uppercase means the same thing as the isupper C library function. @end deffn char-lower-case? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:232 @deffn {Scheme Procedure} char-lower-case? chr @deffnx {C Function} scm_char_lower_case_p (chr) Return @code{#t} iff @var{chr} is lowercase, else @code{#f}. @@ -354,6 +403,7 @@ Lowercase means the same thing as the islower C library function. @end deffn char-is-both? +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:246 @deffn {Scheme Procedure} char-is-both? chr @deffnx {C Function} scm_char_is_both_p (chr) Return @code{#t} iff @var{chr} is either uppercase or lowercase, else @code{#f}. @@ -362,6 +412,7 @@ C library functions. @end deffn char->integer +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:260 @deffn {Scheme Procedure} char->integer chr @deffnx {C Function} scm_char_to_integer (chr) Return the number corresponding to ordinal position of @var{chr} in the @@ -369,24 +420,28 @@ ASCII sequence. @end deffn integer->char +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:272 @deffn {Scheme Procedure} integer->char n @deffnx {C Function} scm_integer_to_char (n) Return the character at position @var{n} in the ASCII sequence. @end deffn char-upcase +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:283 @deffn {Scheme Procedure} char-upcase chr @deffnx {C Function} scm_char_upcase (chr) Return the uppercase character version of @var{chr}. @end deffn char-downcase +@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:294 @deffn {Scheme Procedure} char-downcase chr @deffnx {C Function} scm_char_downcase (chr) Return the lowercase character version of @var{chr}. @end deffn debug-options-interface +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:79 @deffn {Scheme Procedure} debug-options-interface [setting] @deffnx {C Function} scm_debug_options (setting) Option interface for the debug options. Instead of using @@ -395,48 +450,56 @@ this procedure directly, use the procedures @code{debug-enable}, @end deffn with-traps +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:122 @deffn {Scheme Procedure} with-traps thunk @deffnx {C Function} scm_with_traps (thunk) Call @var{thunk} with traps enabled. @end deffn memoized? +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:164 @deffn {Scheme Procedure} memoized? obj @deffnx {C Function} scm_memoized_p (obj) Return @code{#t} if @var{obj} is memoized. @end deffn unmemoize +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:328 @deffn {Scheme Procedure} unmemoize m @deffnx {C Function} scm_unmemoize (m) Unmemoize the memoized expression @var{m}, @end deffn memoized-environment +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:338 @deffn {Scheme Procedure} memoized-environment m @deffnx {C Function} scm_memoized_environment (m) Return the environment of the memoized expression @var{m}. @end deffn procedure-name +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:348 @deffn {Scheme Procedure} procedure-name proc @deffnx {C Function} scm_procedure_name (proc) Return the name of the procedure @var{proc} @end deffn procedure-source +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:374 @deffn {Scheme Procedure} procedure-source proc @deffnx {C Function} scm_procedure_source (proc) Return the source of the procedure @var{proc}. @end deffn procedure-environment +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:407 @deffn {Scheme Procedure} procedure-environment proc @deffnx {C Function} scm_procedure_environment (proc) Return the environment of the procedure @var{proc}. @end deffn local-eval +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:439 @deffn {Scheme Procedure} local-eval exp [env] @deffnx {C Function} scm_local_eval (exp, env) Evaluate @var{exp} in its environment. If @var{env} is supplied, @@ -446,51 +509,64 @@ is implicit). @end deffn debug-object? +@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:526 @deffn {Scheme Procedure} debug-object? obj @deffnx {C Function} scm_debug_object_p (obj) Return @code{#t} if @var{obj} is a debug object. @end deffn dynamic-link +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:212 @deffn {Scheme Procedure} dynamic-link filename @deffnx {C Function} scm_dynamic_link (filename) -Open the dynamic library called @var{filename}. A library -handle representing the opened library is returned; this handle -should be used as the @var{dobj} argument to the following -functions. +Find the shared object (shared library) denoted by +@var{filename} and link it into the running Guile +application. The returned +scheme object is a ``handle'' for the library which can +be passed to @code{dynamic-func}, @code{dynamic-call} etc. + +Searching for object files is system dependent. Normally, +if @var{filename} does have an explicit directory it will +be searched for in locations +such as @file{/usr/lib} and @file{/usr/local/lib}. @end deffn dynamic-object? +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:227 @deffn {Scheme Procedure} dynamic-object? obj @deffnx {C Function} scm_dynamic_object_p (obj) -Return @code{#t} if @var{obj} is a dynamic library handle, or @code{#f} -otherwise. +Return @code{#t} if @var{obj} is a dynamic object handle, +or @code{#f} otherwise. @end deffn dynamic-unlink +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:241 @deffn {Scheme Procedure} dynamic-unlink dobj @deffnx {C Function} scm_dynamic_unlink (dobj) -Unlink the indicated object file from the application. The -argument @var{dobj} must have been obtained by a call to -@code{dynamic-link}. After @code{dynamic-unlink} has been -called on @var{dobj}, its content is no longer accessible. +Unlink a dynamic object from the application, if possible. The +object must have been linked by @code{dynamic-link}, with +@var{dobj} the corresponding handle. After this procedure +is called, the handle can no longer be used to access the +object. @end deffn dynamic-func +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:266 @deffn {Scheme Procedure} dynamic-func name dobj @deffnx {C Function} scm_dynamic_func (name, dobj) -Search the dynamic object @var{dobj} for the C function -indicated by the string @var{name} and return some Scheme -handle that can later be used with @code{dynamic-call} to -actually call the function. +Return a ``handle'' for the function @var{name} in the +shared object referred to by @var{dobj}. The handle +can be passed to @code{dynamic-call} to actually +call the function. -Regardless whether your C compiler prepends an underscore @samp{_} to -the global names in a program, you should @strong{not} include this -underscore in @var{function}. Guile knows whether the underscore is -needed or not and will add it when necessary. +Regardless whether your C compiler prepends an underscore +@samp{_} to the global names in a program, you should +@strong{not} include this underscore in @var{name} +since it will be added automatically when necessary. @end deffn dynamic-call +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:308 @deffn {Scheme Procedure} dynamic-call func dobj @deffnx {C Function} scm_dynamic_call (func, dobj) Call a C function in a dynamic object. Two styles of @@ -515,6 +591,7 @@ and its return value is ignored. @end deffn dynamic-args-call +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:363 @deffn {Scheme Procedure} dynamic-args-call func dobj args @deffnx {C Function} scm_dynamic_args_call (func, dobj, args) Call the C function indicated by @var{func} and @var{dobj}, @@ -533,6 +610,7 @@ converted to a Scheme number and returned from the call to @end deffn dynamic-wind +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynwind.c:119 @deffn {Scheme Procedure} dynamic-wind in_guard thunk out_guard @deffnx {C Function} scm_dynamic_wind (in_guard, thunk, out_guard) All three arguments must be 0-argument procedures. @@ -586,6 +664,7 @@ a-cont @end deffn environment? +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:129 @deffn {Scheme Procedure} environment? obj @deffnx {C Function} scm_environment_p (obj) Return @code{#t} if @var{obj} is an environment, or @code{#f} @@ -593,6 +672,7 @@ otherwise. @end deffn environment-bound? +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:140 @deffn {Scheme Procedure} environment-bound? env sym @deffnx {C Function} scm_environment_bound_p (env, sym) Return @code{#t} if @var{sym} is bound in @var{env}, or @@ -600,6 +680,7 @@ Return @code{#t} if @var{sym} is bound in @var{env}, or @end deffn environment-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:155 @deffn {Scheme Procedure} environment-ref env sym @deffnx {C Function} scm_environment_ref (env, sym) Return the value of the location bound to @var{sym} in @@ -608,6 +689,7 @@ Return the value of the location bound to @var{sym} in @end deffn environment-fold +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:225 @deffn {Scheme Procedure} environment-fold env proc init @deffnx {C Function} scm_environment_fold (env, proc, init) Iterate over all the bindings in @var{env}, accumulating some @@ -644,6 +726,7 @@ using environment-fold: @end deffn environment-define +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:260 @deffn {Scheme Procedure} environment-define env sym val @deffnx {C Function} scm_environment_define (env, sym, val) Bind @var{sym} to a new location containing @var{val} in @@ -656,6 +739,7 @@ immutable, signal an @code{environment:immutable-binding} error. @end deffn environment-undefine +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:286 @deffn {Scheme Procedure} environment-undefine env sym @deffnx {C Function} scm_environment_undefine (env, sym) Remove any binding for @var{sym} from @var{env}. If @var{sym} @@ -666,6 +750,7 @@ immutable, signal an @code{environment:immutable-binding} error. @end deffn environment-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:314 @deffn {Scheme Procedure} environment-set! env sym val @deffnx {C Function} scm_environment_set_x (env, sym, val) If @var{env} binds @var{sym} to some location, change that @@ -678,6 +763,7 @@ to an immutable location, signal an @end deffn environment-cell +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:349 @deffn {Scheme Procedure} environment-cell env sym for_write @deffnx {C Function} scm_environment_cell (env, sym, for_write) Return the value cell which @var{env} binds to @var{sym}, or @@ -695,6 +781,7 @@ re-bound to a new value cell, or becomes undefined. @end deffn environment-observe +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:401 @deffn {Scheme Procedure} environment-observe env proc @deffnx {C Function} scm_environment_observe (env, proc) Whenever @var{env}'s bindings change, apply @var{proc} to @@ -706,6 +793,7 @@ token is unspecified. @end deffn environment-observe-weak +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:418 @deffn {Scheme Procedure} environment-observe-weak env proc @deffnx {C Function} scm_environment_observe_weak (env, proc) This function is the same as environment-observe, except that @@ -717,6 +805,7 @@ list of observing procedures. @end deffn environment-unobserve +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:454 @deffn {Scheme Procedure} environment-unobserve token @deffnx {C Function} scm_environment_unobserve (token) Cancel the observation request which returned the value @@ -728,6 +817,7 @@ bindings change. @end deffn make-leaf-environment +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1031 @deffn {Scheme Procedure} make-leaf-environment @deffnx {C Function} scm_make_leaf_environment () Create a new leaf environment, containing no bindings. @@ -736,6 +826,7 @@ will be mutable. @end deffn leaf-environment? +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1054 @deffn {Scheme Procedure} leaf-environment? object @deffnx {C Function} scm_leaf_environment_p (object) Return @code{#t} if object is a leaf environment, or @code{#f} @@ -743,6 +834,7 @@ otherwise. @end deffn make-eval-environment +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1419 @deffn {Scheme Procedure} make-eval-environment local imported @deffnx {C Function} scm_make_eval_environment (local, imported) Return a new environment object eval whose bindings are the @@ -769,6 +861,7 @@ In typical use, @var{local} will be a finite environment, and @end deffn eval-environment? +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1456 @deffn {Scheme Procedure} eval-environment? object @deffnx {C Function} scm_eval_environment_p (object) Return @code{#t} if object is an eval environment, or @code{#f} @@ -776,30 +869,35 @@ otherwise. @end deffn eval-environment-local +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1466 @deffn {Scheme Procedure} eval-environment-local env @deffnx {C Function} scm_eval_environment_local (env) Return the local environment of eval environment @var{env}. @end deffn eval-environment-set-local! +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1478 @deffn {Scheme Procedure} eval-environment-set-local! env local @deffnx {C Function} scm_eval_environment_set_local_x (env, local) Change @var{env}'s local environment to @var{local}. @end deffn eval-environment-imported +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1504 @deffn {Scheme Procedure} eval-environment-imported env @deffnx {C Function} scm_eval_environment_imported (env) Return the imported environment of eval environment @var{env}. @end deffn eval-environment-set-imported! +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1516 @deffn {Scheme Procedure} eval-environment-set-imported! env imported @deffnx {C Function} scm_eval_environment_set_imported_x (env, imported) Change @var{env}'s imported environment to @var{imported}. @end deffn make-import-environment +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1839 @deffn {Scheme Procedure} make-import-environment imports conflict_proc @deffnx {C Function} scm_make_import_environment (imports, conflict_proc) Return a new environment @var{imp} whose bindings are the union @@ -830,6 +928,7 @@ if one of its imported environments changes. @end deffn import-environment? +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1868 @deffn {Scheme Procedure} import-environment? object @deffnx {C Function} scm_import_environment_p (object) Return @code{#t} if object is an import environment, or @@ -837,6 +936,7 @@ Return @code{#t} if object is an import environment, or @end deffn import-environment-imports +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1879 @deffn {Scheme Procedure} import-environment-imports env @deffnx {C Function} scm_import_environment_imports (env) Return the list of environments imported by the import @@ -844,6 +944,7 @@ environment @var{env}. @end deffn import-environment-set-imports! +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1892 @deffn {Scheme Procedure} import-environment-set-imports! env imports @deffnx {C Function} scm_import_environment_set_imports_x (env, imports) Change @var{env}'s list of imported environments to @@ -851,6 +952,7 @@ Change @var{env}'s list of imported environments to @end deffn make-export-environment +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2159 @deffn {Scheme Procedure} make-export-environment private signature @deffnx {C Function} scm_make_export_environment (private, signature) Return a new environment @var{exp} containing only those @@ -900,6 +1002,7 @@ if the bindings in private change. @end deffn export-environment? +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2194 @deffn {Scheme Procedure} export-environment? object @deffnx {C Function} scm_export_environment_p (object) Return @code{#t} if object is an export environment, or @@ -907,30 +1010,35 @@ Return @code{#t} if object is an export environment, or @end deffn export-environment-private +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2204 @deffn {Scheme Procedure} export-environment-private env @deffnx {C Function} scm_export_environment_private (env) Return the private environment of export environment @var{env}. @end deffn export-environment-set-private! +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2216 @deffn {Scheme Procedure} export-environment-set-private! env private @deffnx {C Function} scm_export_environment_set_private_x (env, private) Change the private environment of export environment @var{env}. @end deffn export-environment-signature +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2238 @deffn {Scheme Procedure} export-environment-signature env @deffnx {C Function} scm_export_environment_signature (env) Return the signature of export environment @var{env}. @end deffn export-environment-set-signature! +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2312 @deffn {Scheme Procedure} export-environment-set-signature! env signature @deffnx {C Function} scm_export_environment_set_signature_x (env, signature) Change the signature of export environment @var{env}. @end deffn eq? +@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:62 @deffn {Scheme Procedure} eq? x y Return @code{#t} iff @var{x} references the same object as @var{y}. @code{eq?} is similar to @code{eqv?} except that in some cases it is @@ -939,6 +1047,7 @@ capable of discerning distinctions finer than those detectable by @end deffn eqv? +@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:85 @deffn {Scheme Procedure} eqv? x y The @code{eqv?} procedure defines a useful equivalence relation on objects. Briefly, it returns @code{#t} if @var{x} and @var{y} should normally be @@ -948,6 +1057,7 @@ and inexact numbers. @end deffn equal? +@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:138 @deffn {Scheme Procedure} equal? x y Return @code{#t} iff @var{x} and @var{y} are recursively @code{eqv?} equivalent. @code{equal?} recursively compares the contents of pairs, @@ -958,6 +1068,7 @@ terminate if its arguments are circular data structures. @end deffn scm-error +@c snarfed from /home/ghouston/guile/guile-core/libguile/error.c:117 @deffn {Scheme Procedure} scm-error key subr message args data @deffnx {C Function} scm_error_scm (key, subr, message, args, data) Raise an error with key @var{key}. @var{subr} can be a string @@ -976,6 +1087,7 @@ it will usually be @code{#f}. @end deffn strerror +@c snarfed from /home/ghouston/guile/guile-core/libguile/error.c:168 @deffn {Scheme Procedure} strerror err @deffnx {C Function} scm_strerror (err) Return the Unix error message corresponding to @var{err}, which @@ -983,6 +1095,7 @@ must be an integer value. @end deffn apply:nconc2last +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3409 @deffn {Scheme Procedure} apply:nconc2last lst @deffnx {C Function} scm_nconc2last (lst) Given a list (@var{arg1} @dots{} @var{args}), this function @@ -995,6 +1108,7 @@ destroys its argument, so use with care. @end deffn force +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3945 @deffn {Scheme Procedure} force x @deffnx {C Function} scm_force (x) If the promise @var{x} has not been computed yet, compute and @@ -1003,6 +1117,7 @@ value. @end deffn promise? +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3968 @deffn {Scheme Procedure} promise? obj @deffnx {C Function} scm_promise_p (obj) Return true if @var{obj} is a promise, i.e. a delayed computation @@ -1010,6 +1125,7 @@ Return true if @var{obj} is a promise, i.e. a delayed computation @end deffn cons-source +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3980 @deffn {Scheme Procedure} cons-source xorig x y @deffnx {C Function} scm_cons_source (xorig, x, y) Create and return a new pair whose car and cdr are @var{x} and @var{y}. @@ -1018,6 +1134,7 @@ with the new pair. @end deffn copy-tree +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4000 @deffn {Scheme Procedure} copy-tree obj @deffnx {C Function} scm_copy_tree (obj) Recursively copy the data tree that is bound to @var{obj}, and return a @@ -1028,6 +1145,7 @@ any other object. @end deffn primitive-eval +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4093 @deffn {Scheme Procedure} primitive-eval exp @deffnx {C Function} scm_primitive_eval (exp) Evaluate @var{exp} in the top-level environment specified by @@ -1035,6 +1153,7 @@ the current module. @end deffn eval +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4162 @deffn {Scheme Procedure} eval exp module @deffnx {C Function} scm_eval (exp, module) Evaluate @var{exp}, a list representing a Scheme expression, @@ -1045,6 +1164,7 @@ is reset to its previous value when @var{eval} returns. @end deffn eval-options-interface +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:1747 @deffn {Scheme Procedure} eval-options-interface [setting] @deffnx {C Function} scm_eval_options_interface (setting) Option interface for the evaluation options. Instead of using @@ -1053,23 +1173,27 @@ this procedure directly, use the procedures @code{eval-enable}, @end deffn evaluator-traps-interface +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:1764 @deffn {Scheme Procedure} evaluator-traps-interface [setting] @deffnx {C Function} scm_evaluator_traps (setting) Option interface for the evaluator trap options. @end deffn defined? +@c snarfed from /home/ghouston/guile/guile-core/libguile/evalext.c:75 @deffn {Scheme Procedure} defined? sym [env] @deffnx {C Function} scm_definedp (sym, env) Return @code{#t} if @var{sym} is defined in the lexical environment @var{env}. When @var{env} is not specified, look in the top-level environment as defined by the current module. @end deffn map-in-order +@c snarfed from /home/ghouston/guile/guile-core/libguile/evalext.c:144 @deffn {Scheme Procedure} map-in-order implemented by the C function "scm_map" @end deffn load-extension +@c snarfed from /home/ghouston/guile/guile-core/libguile/extensions.c:152 @deffn {Scheme Procedure} load-extension lib init @deffnx {C Function} scm_load_extension (lib, init) Load and initialize the extension designated by LIB and INIT. @@ -1109,6 +1233,7 @@ well. For example, @end deffn program-arguments +@c snarfed from /home/ghouston/guile/guile-core/libguile/feature.c:77 @deffn {Scheme Procedure} program-arguments @deffnx {Scheme Procedure} command-line @deffnx {C Function} scm_program_arguments () @@ -1119,6 +1244,7 @@ options like @code{-e} and @code{-l}. @end deffn make-fluid +@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:124 @deffn {Scheme Procedure} make-fluid @deffnx {C Function} scm_make_fluid () Return a newly created fluid. @@ -1131,6 +1257,7 @@ in its own dynamic root, you can use fluids for thread local storage. @end deffn fluid? +@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:137 @deffn {Scheme Procedure} fluid? obj @deffnx {C Function} scm_fluid_p (obj) Return @code{#t} iff @var{obj} is a fluid; otherwise, return @@ -1138,6 +1265,7 @@ Return @code{#t} iff @var{obj} is a fluid; otherwise, return @end deffn fluid-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:148 @deffn {Scheme Procedure} fluid-ref fluid @deffnx {C Function} scm_fluid_ref (fluid) Return the value associated with @var{fluid} in the current @@ -1146,12 +1274,14 @@ dynamic root. If @var{fluid} has not been set, then return @end deffn fluid-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:164 @deffn {Scheme Procedure} fluid-set! fluid value @deffnx {C Function} scm_fluid_set_x (fluid, value) Set the value associated with @var{fluid} in the current dynamic root. @end deffn with-fluids* +@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:223 @deffn {Scheme Procedure} with-fluids* fluids values thunk @deffnx {C Function} scm_with_fluids (fluids, values, thunk) Set @var{fluids} to @var{values} temporary, and call @var{thunk}. @@ -1161,6 +1291,7 @@ one after another. @var{thunk} must be a procedure with no argument. @end deffn setvbuf +@c snarfed from /home/ghouston/guile/guile-core/libguile/fports.c:156 @deffn {Scheme Procedure} setvbuf port mode [size] @deffnx {C Function} scm_setvbuf (port, mode, size) Set the buffering mode for @var{port}. @var{mode} can be: @@ -1176,12 +1307,14 @@ If @var{size} is omitted, a default size will be used. @end deffn file-port? +@c snarfed from /home/ghouston/guile/guile-core/libguile/fports.c:245 @deffn {Scheme Procedure} file-port? obj @deffnx {C Function} scm_file_port_p (obj) Determine whether @var{obj} is a port that is related to a file. @end deffn open-file +@c snarfed from /home/ghouston/guile/guile-core/libguile/fports.c:299 @deffn {Scheme Procedure} open-file filename mode @deffnx {C Function} scm_open_file (filename, mode) Open the file whose name is @var{filename}, and return a port @@ -1224,6 +1357,7 @@ requested, @code{open-file} throws an exception. @end deffn gc-stats +@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:735 @deffn {Scheme Procedure} gc-stats @deffnx {C Function} scm_gc_stats () Return an association list of statistics about Guile's current @@ -1231,6 +1365,7 @@ use of storage. @end deffn object-address +@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:832 @deffn {Scheme Procedure} object-address obj @deffnx {C Function} scm_object_address (obj) Return an integer that for the lifetime of @var{obj} is uniquely @@ -1238,6 +1373,7 @@ returned by this function for @var{obj} @end deffn gc +@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:843 @deffn {Scheme Procedure} gc @deffnx {C Function} scm_gc () Scans all of SCM objects and reclaims for further use those that are @@ -1245,6 +1381,7 @@ no longer accessible. @end deffn %compute-slots +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:291 @deffn {Scheme Procedure} %compute-slots class @deffnx {C Function} scm_sys_compute_slots (class) Return a list consisting of the names of all slots belonging to @@ -1253,6 +1390,7 @@ its superclasses. @end deffn get-keyword +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:376 @deffn {Scheme Procedure} get-keyword key l default_value @deffnx {C Function} scm_get_keyword (key, l, default_value) Determine an associated value for the keyword @var{key} from @@ -1264,6 +1402,7 @@ If @var{l} does not hold a value for @var{key}, the value @end deffn %initialize-object +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:399 @deffn {Scheme Procedure} %initialize-object obj initargs @deffnx {C Function} scm_sys_initialize_object (obj, initargs) Initialize the object @var{obj} with the given arguments @@ -1271,126 +1410,147 @@ Initialize the object @var{obj} with the given arguments @end deffn %prep-layout! +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:479 @deffn {Scheme Procedure} %prep-layout! class @deffnx {C Function} scm_sys_prep_layout_x (class) @end deffn %inherit-magic! +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:556 @deffn {Scheme Procedure} %inherit-magic! class dsupers @deffnx {C Function} scm_sys_inherit_magic_x (class, dsupers) @end deffn instance? +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:799 @deffn {Scheme Procedure} instance? obj @deffnx {C Function} scm_instance_p (obj) Return @code{#t} if @var{obj} is an instance. @end deffn class-name +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:814 @deffn {Scheme Procedure} class-name obj @deffnx {C Function} scm_class_name (obj) Return the class name of @var{obj}. @end deffn class-direct-supers +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:824 @deffn {Scheme Procedure} class-direct-supers obj @deffnx {C Function} scm_class_direct_supers (obj) Return the direct superclasses of the class @var{obj}. @end deffn class-direct-slots +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:834 @deffn {Scheme Procedure} class-direct-slots obj @deffnx {C Function} scm_class_direct_slots (obj) Return the direct slots of the class @var{obj}. @end deffn class-direct-subclasses +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:844 @deffn {Scheme Procedure} class-direct-subclasses obj @deffnx {C Function} scm_class_direct_subclasses (obj) Return the direct subclasses of the class @var{obj}. @end deffn class-direct-methods +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:854 @deffn {Scheme Procedure} class-direct-methods obj @deffnx {C Function} scm_class_direct_methods (obj) Return the direct methods of the class @var{obj} @end deffn class-precedence-list +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:864 @deffn {Scheme Procedure} class-precedence-list obj @deffnx {C Function} scm_class_precedence_list (obj) Return the class precedence list of the class @var{obj}. @end deffn class-slots +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:874 @deffn {Scheme Procedure} class-slots obj @deffnx {C Function} scm_class_slots (obj) Return the slot list of the class @var{obj}. @end deffn class-environment +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:884 @deffn {Scheme Procedure} class-environment obj @deffnx {C Function} scm_class_environment (obj) Return the environment of the class @var{obj}. @end deffn generic-function-name +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:895 @deffn {Scheme Procedure} generic-function-name obj @deffnx {C Function} scm_generic_function_name (obj) Return the name of the generic function @var{obj}. @end deffn generic-function-methods +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:905 @deffn {Scheme Procedure} generic-function-methods obj @deffnx {C Function} scm_generic_function_methods (obj) Return the methods of the generic function @var{obj}. @end deffn method-generic-function +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:916 @deffn {Scheme Procedure} method-generic-function obj @deffnx {C Function} scm_method_generic_function (obj) Return the generic function for the method @var{obj}. @end deffn method-specializers +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:926 @deffn {Scheme Procedure} method-specializers obj @deffnx {C Function} scm_method_specializers (obj) Return specializers of the method @var{obj}. @end deffn method-procedure +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:936 @deffn {Scheme Procedure} method-procedure obj @deffnx {C Function} scm_method_procedure (obj) Return the procedure of the method @var{obj}. @end deffn accessor-method-slot-definition +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:946 @deffn {Scheme Procedure} accessor-method-slot-definition obj @deffnx {C Function} scm_accessor_method_slot_definition (obj) Return the slot definition of the accessor @var{obj}. @end deffn %tag-body +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:956 @deffn {Scheme Procedure} %tag-body body @deffnx {C Function} scm_sys_tag_body (body) Internal GOOPS magic---don't use this function! @end deffn make-unbound +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:971 @deffn {Scheme Procedure} make-unbound @deffnx {C Function} scm_make_unbound () Return the unbound value. @end deffn unbound? +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:980 @deffn {Scheme Procedure} unbound? obj @deffnx {C Function} scm_unbound_p (obj) Return @code{#t} if @var{obj} is unbound. @end deffn assert-bound +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:990 @deffn {Scheme Procedure} assert-bound value obj @deffnx {C Function} scm_assert_bound (value, obj) Return @var{value} if it is bound, and invoke the @@ -1398,6 +1558,7 @@ Return @var{value} if it is bound, and invoke the @end deffn @@assert-bound-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1002 @deffn {Scheme Procedure} @@assert-bound-ref obj index @deffnx {C Function} scm_at_assert_bound_ref (obj, index) Like @code{assert-bound}, but use @var{index} for accessing @@ -1405,12 +1566,14 @@ the value from @var{obj}. @end deffn %fast-slot-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1014 @deffn {Scheme Procedure} %fast-slot-ref obj index @deffnx {C Function} scm_sys_fast_slot_ref (obj, index) Return the slot value with index @var{index} from @var{obj}. @end deffn %fast-slot-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1032 @deffn {Scheme Procedure} %fast-slot-set! obj index value @deffnx {C Function} scm_sys_fast_slot_set_x (obj, index, value) Set the slot with index @var{index} in @var{obj} to @@ -1418,30 +1581,35 @@ Set the slot with index @var{index} in @var{obj} to @end deffn slot-ref-using-class +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1162 @deffn {Scheme Procedure} slot-ref-using-class class obj slot_name @deffnx {C Function} scm_slot_ref_using_class (class, obj, slot_name) @end deffn slot-set-using-class! +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1181 @deffn {Scheme Procedure} slot-set-using-class! class obj slot_name value @deffnx {C Function} scm_slot_set_using_class_x (class, obj, slot_name, value) @end deffn slot-bound-using-class? +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1195 @deffn {Scheme Procedure} slot-bound-using-class? class obj slot_name @deffnx {C Function} scm_slot_bound_using_class_p (class, obj, slot_name) @end deffn slot-exists-using-class? +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1210 @deffn {Scheme Procedure} slot-exists-using-class? class obj slot_name @deffnx {C Function} scm_slot_exists_using_class_p (class, obj, slot_name) @end deffn slot-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1226 @deffn {Scheme Procedure} slot-ref obj slot_name @deffnx {C Function} scm_slot_ref (obj, slot_name) Return the value from @var{obj}'s slot with the name @@ -1449,12 +1617,14 @@ Return the value from @var{obj}'s slot with the name @end deffn slot-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1243 @deffn {Scheme Procedure} slot-set! obj slot_name value @deffnx {C Function} scm_slot_set_x (obj, slot_name, value) Set the slot named @var{slot_name} of @var{obj} to @var{value}. @end deffn slot-bound? +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1260 @deffn {Scheme Procedure} slot-bound? obj slot_name @deffnx {C Function} scm_slot_bound_p (obj, slot_name) Return @code{#t} if the slot named @var{slot_name} of @var{obj} @@ -1462,12 +1632,14 @@ is bound. @end deffn slot-exists? +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1278 @deffn {Scheme Procedure} slot-exists? obj slot_name -@deffnx {C Function} scm_slots_exists_p (obj, slot_name) +@deffnx {C Function} scm_slot_exists_p (obj, slot_name) Return @code{#t} if @var{obj} has a slot named @var{slot_name}. @end deffn %allocate-instance +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1317 @deffn {Scheme Procedure} %allocate-instance class initargs @deffnx {C Function} scm_sys_allocate_instance (class, initargs) Create a new instance of class @var{class} and initialize it @@ -1475,54 +1647,63 @@ from the arguments @var{initargs}. @end deffn %set-object-setter! +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1387 @deffn {Scheme Procedure} %set-object-setter! obj setter @deffnx {C Function} scm_sys_set_object_setter_x (obj, setter) @end deffn %modify-instance +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1412 @deffn {Scheme Procedure} %modify-instance old new @deffnx {C Function} scm_sys_modify_instance (old, new) @end deffn %modify-class +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1438 @deffn {Scheme Procedure} %modify-class old new @deffnx {C Function} scm_sys_modify_class (old, new) @end deffn %invalidate-class +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1462 @deffn {Scheme Procedure} %invalidate-class class @deffnx {C Function} scm_sys_invalidate_class (class) @end deffn %invalidate-method-cache! +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1589 @deffn {Scheme Procedure} %invalidate-method-cache! gf @deffnx {C Function} scm_sys_invalidate_method_cache_x (gf) @end deffn generic-capability? +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1615 @deffn {Scheme Procedure} generic-capability? proc @deffnx {C Function} scm_generic_capability_p (proc) @end deffn enable-primitive-generic! +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1628 @deffn {Scheme Procedure} enable-primitive-generic! . subrs @deffnx {C Function} scm_enable_primitive_generic_x (subrs) @end deffn primitive-generic-generic +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1649 @deffn {Scheme Procedure} primitive-generic-generic subr @deffnx {C Function} scm_primitive_generic_generic (subr) @end deffn make +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2010 @deffn {Scheme Procedure} make . args @deffnx {C Function} scm_make (args) Make a new object. @var{args} must contain the class and @@ -1530,18 +1711,21 @@ all necessary initialization information. @end deffn find-method +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2103 @deffn {Scheme Procedure} find-method . l @deffnx {C Function} scm_find_method (l) @end deffn %method-more-specific? +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2123 @deffn {Scheme Procedure} %method-more-specific? m1 m2 targs @deffnx {C Function} scm_sys_method_more_specific_p (m1, m2, targs) @end deffn %goops-loaded +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2648 @deffn {Scheme Procedure} %goops-loaded @deffnx {C Function} scm_sys_goops_loaded () Announce that GOOPS is loaded and perform initialization @@ -1549,6 +1733,7 @@ on the C level which depends on the loaded GOOPS modules. @end deffn make-guardian +@c snarfed from /home/ghouston/guile/guile-core/libguile/guardians.c:330 @deffn {Scheme Procedure} make-guardian [greedy_p] @deffnx {C Function} scm_make_guardian (greedy_p) Create a new guardian. @@ -1579,18 +1764,21 @@ paper still (mostly) accurately describes the interface). @end deffn guardian-destroyed? +@c snarfed from /home/ghouston/guile/guile-core/libguile/guardians.c:358 @deffn {Scheme Procedure} guardian-destroyed? guardian @deffnx {C Function} scm_guardian_destroyed_p (guardian) Return @code{#t} if @var{guardian} has been destroyed, otherwise @code{#f}. @end deffn guardian-greedy? +@c snarfed from /home/ghouston/guile/guile-core/libguile/guardians.c:376 @deffn {Scheme Procedure} guardian-greedy? guardian @deffnx {C Function} scm_guardian_greedy_p (guardian) Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}. @end deffn destroy-guardian! +@c snarfed from /home/ghouston/guile/guile-core/libguile/guardians.c:387 @deffn {Scheme Procedure} destroy-guardian! guardian @deffnx {C Function} scm_destroy_guardian_x (guardian) Destroys @var{guardian}, by making it impossible to put any more @@ -1599,6 +1787,7 @@ objects guarded by @var{guardian}. @end deffn hashq +@c snarfed from /home/ghouston/guile/guile-core/libguile/hash.c:200 @deffn {Scheme Procedure} hashq key size @deffnx {C Function} scm_hashq (key, size) Determine a hash value for @var{key} that is suitable for @@ -1614,6 +1803,7 @@ different values, since @code{foo} will be garbage collected. @end deffn hashv +@c snarfed from /home/ghouston/guile/guile-core/libguile/hash.c:236 @deffn {Scheme Procedure} hashv key size @deffnx {C Function} scm_hashv (key, size) Determine a hash value for @var{key} that is suitable for @@ -1629,6 +1819,7 @@ different values, since @code{foo} will be garbage collected. @end deffn hash +@c snarfed from /home/ghouston/guile/guile-core/libguile/hash.c:259 @deffn {Scheme Procedure} hash key size @deffnx {C Function} scm_hash (key, size) Determine a hash value for @var{key} that is suitable for @@ -1638,6 +1829,7 @@ integer in the range 0 to @var{size} - 1. @end deffn hashq-get-handle +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:173 @deffn {Scheme Procedure} hashq-get-handle table key @deffnx {C Function} scm_hashq_get_handle (table, key) This procedure returns the @code{(key . value)} pair from the @@ -1647,6 +1839,7 @@ Uses @code{eq?} for equality testing. @end deffn hashq-create-handle! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:185 @deffn {Scheme Procedure} hashq-create-handle! table key init @deffnx {C Function} scm_hashq_create_handle_x (table, key, init) This function looks up @var{key} in @var{table} and returns its handle. @@ -1655,6 +1848,7 @@ associates @var{key} with @var{init}. @end deffn hashq-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:198 @deffn {Scheme Procedure} hashq-ref table key [dflt] @deffnx {C Function} scm_hashq_ref (table, key, dflt) Look up @var{key} in the hash table @var{table}, and return the @@ -1664,6 +1858,7 @@ is supplied). Uses @code{eq?} for equality testing. @end deffn hashq-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:212 @deffn {Scheme Procedure} hashq-set! table key val @deffnx {C Function} scm_hashq_set_x (table, key, val) Find the entry in @var{table} associated with @var{key}, and @@ -1671,6 +1866,7 @@ store @var{value} there. Uses @code{eq?} for equality testing. @end deffn hashq-remove! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:224 @deffn {Scheme Procedure} hashq-remove! table key @deffnx {C Function} scm_hashq_remove_x (table, key) Remove @var{key} (and any value associated with it) from @@ -1678,6 +1874,7 @@ Remove @var{key} (and any value associated with it) from @end deffn hashv-get-handle +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:240 @deffn {Scheme Procedure} hashv-get-handle table key @deffnx {C Function} scm_hashv_get_handle (table, key) This procedure returns the @code{(key . value)} pair from the @@ -1687,6 +1884,7 @@ Uses @code{eqv?} for equality testing. @end deffn hashv-create-handle! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:252 @deffn {Scheme Procedure} hashv-create-handle! table key init @deffnx {C Function} scm_hashv_create_handle_x (table, key, init) This function looks up @var{key} in @var{table} and returns its handle. @@ -1695,6 +1893,7 @@ associates @var{key} with @var{init}. @end deffn hashv-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:266 @deffn {Scheme Procedure} hashv-ref table key [dflt] @deffnx {C Function} scm_hashv_ref (table, key, dflt) Look up @var{key} in the hash table @var{table}, and return the @@ -1704,6 +1903,7 @@ is supplied). Uses @code{eqv?} for equality testing. @end deffn hashv-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:280 @deffn {Scheme Procedure} hashv-set! table key val @deffnx {C Function} scm_hashv_set_x (table, key, val) Find the entry in @var{table} associated with @var{key}, and @@ -1711,6 +1911,7 @@ store @var{value} there. Uses @code{eqv?} for equality testing. @end deffn hashv-remove! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:291 @deffn {Scheme Procedure} hashv-remove! table key @deffnx {C Function} scm_hashv_remove_x (table, key) Remove @var{key} (and any value associated with it) from @@ -1718,6 +1919,7 @@ Remove @var{key} (and any value associated with it) from @end deffn hash-get-handle +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:306 @deffn {Scheme Procedure} hash-get-handle table key @deffnx {C Function} scm_hash_get_handle (table, key) This procedure returns the @code{(key . value)} pair from the @@ -1727,6 +1929,7 @@ Uses @code{equal?} for equality testing. @end deffn hash-create-handle! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:318 @deffn {Scheme Procedure} hash-create-handle! table key init @deffnx {C Function} scm_hash_create_handle_x (table, key, init) This function looks up @var{key} in @var{table} and returns its handle. @@ -1735,6 +1938,7 @@ associates @var{key} with @var{init}. @end deffn hash-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:331 @deffn {Scheme Procedure} hash-ref table key [dflt] @deffnx {C Function} scm_hash_ref (table, key, dflt) Look up @var{key} in the hash table @var{table}, and return the @@ -1744,6 +1948,7 @@ is supplied). Uses @code{equal?} for equality testing. @end deffn hash-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:346 @deffn {Scheme Procedure} hash-set! table key val @deffnx {C Function} scm_hash_set_x (table, key, val) Find the entry in @var{table} associated with @var{key}, and @@ -1752,6 +1957,7 @@ testing. @end deffn hash-remove! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:358 @deffn {Scheme Procedure} hash-remove! table key @deffnx {C Function} scm_hash_remove_x (table, key) Remove @var{key} (and any value associated with it) from @@ -1759,6 +1965,7 @@ Remove @var{key} (and any value associated with it) from @end deffn hashx-get-handle +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:422 @deffn {Scheme Procedure} hashx-get-handle hash assoc table key @deffnx {C Function} scm_hashx_get_handle (hash, assoc, table, key) This behaves the same way as the corresponding @@ -1770,6 +1977,7 @@ table size. @code{assoc} must be an associator function, like @end deffn hashx-create-handle! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:441 @deffn {Scheme Procedure} hashx-create-handle! hash assoc table key init @deffnx {C Function} scm_hashx_create_handle_x (hash, assoc, table, key, init) This behaves the same way as the corresponding @@ -1781,6 +1989,7 @@ table size. @code{assoc} must be an associator function, like @end deffn hashx-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:464 @deffn {Scheme Procedure} hashx-ref hash assoc table key [dflt] @deffnx {C Function} scm_hashx_ref (hash, assoc, table, key, dflt) This behaves the same way as the corresponding @code{ref} @@ -1795,6 +2004,7 @@ equivalent to @code{hashx-ref hashq assq table key}. @end deffn hashx-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:490 @deffn {Scheme Procedure} hashx-set! hash assoc table key val @deffnx {C Function} scm_hashx_set_x (hash, assoc, table, key, val) This behaves the same way as the corresponding @code{set!} @@ -1809,6 +2019,7 @@ equivalent to @code{hashx-set! hashq assq table key}. @end deffn hash-fold +@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:528 @deffn {Scheme Procedure} hash-fold proc init table @deffnx {C Function} scm_hash_fold (proc, init, table) An iterator over hash-table elements. @@ -1822,6 +2033,7 @@ table into an a-list of key-value pairs. @end deffn make-hook +@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:178 @deffn {Scheme Procedure} make-hook [n_args] @deffnx {C Function} scm_make_hook (n_args) Create a hook for storing procedure of arity @var{n_args}. @@ -1830,12 +2042,14 @@ object to be used with the other hook procedures. @end deffn hook? +@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:201 @deffn {Scheme Procedure} hook? x @deffnx {C Function} scm_hook_p (x) Return @code{#t} if @var{x} is a hook, @code{#f} otherwise. @end deffn hook-empty? +@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:212 @deffn {Scheme Procedure} hook-empty? hook @deffnx {C Function} scm_hook_empty_p (hook) Return @code{#t} if @var{hook} is an empty hook, @code{#f} @@ -1843,6 +2057,7 @@ otherwise. @end deffn add-hook! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:226 @deffn {Scheme Procedure} add-hook! hook proc [append_p] @deffnx {C Function} scm_add_hook_x (hook, proc, append_p) Add the procedure @var{proc} to the hook @var{hook}. The @@ -1852,6 +2067,7 @@ procedure is not specified. @end deffn remove-hook! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:253 @deffn {Scheme Procedure} remove-hook! hook proc @deffnx {C Function} scm_remove_hook_x (hook, proc) Remove the procedure @var{proc} from the hook @var{hook}. The @@ -1859,6 +2075,7 @@ return value of this procedure is not specified. @end deffn reset-hook! +@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:267 @deffn {Scheme Procedure} reset-hook! hook @deffnx {C Function} scm_reset_hook_x (hook) Remove all procedures from the hook @var{hook}. The return @@ -1866,6 +2083,7 @@ value of this procedure is not specified. @end deffn run-hook +@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:281 @deffn {Scheme Procedure} run-hook hook . args @deffnx {C Function} scm_run_hook (hook, args) Apply all procedures from the hook @var{hook} to the arguments @@ -1874,12 +2092,14 @@ last. The return value of this procedure is not specified. @end deffn hook->list +@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:308 @deffn {Scheme Procedure} hook->list hook @deffnx {C Function} scm_hook_to_list (hook) Convert the procedure list of @var{hook} to a list. @end deffn ftell +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:73 @deffn {Scheme Procedure} ftell fd_port @deffnx {C Function} scm_ftell (fd_port) Return an integer representing the current position of @@ -1891,6 +2111,7 @@ Return an integer representing the current position of @end deffn redirect-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:91 @deffn {Scheme Procedure} redirect-port old new @deffnx {C Function} scm_redirect_port (old, new) This procedure takes two ports and duplicates the underlying file @@ -1909,6 +2130,7 @@ revealed counts. @end deffn dup->fdes +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:130 @deffn {Scheme Procedure} dup->fdes fd_or_port [fd] @deffnx {C Function} scm_dup_to_fdes (fd_or_port, fd) Return a new integer file descriptor referring to the open file @@ -1917,6 +2139,7 @@ file port or a file descriptor. @end deffn dup2 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:177 @deffn {Scheme Procedure} dup2 oldfd newfd @deffnx {C Function} scm_dup2 (oldfd, newfd) A simple wrapper for the @code{dup2} system call. @@ -1930,6 +2153,7 @@ The return value is unspecified. @end deffn fileno +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:196 @deffn {Scheme Procedure} fileno port @deffnx {C Function} scm_fileno (port) Return the integer file descriptor underlying @var{port}. Does @@ -1937,6 +2161,7 @@ not change its revealed count. @end deffn isatty? +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:216 @deffn {Scheme Procedure} isatty? port @deffnx {C Function} scm_isatty_p (port) Return @code{#t} if @var{port} is using a serial non--file @@ -1944,6 +2169,7 @@ device, otherwise @code{#f}. @end deffn fdopen +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:238 @deffn {Scheme Procedure} fdopen fdes modes @deffnx {C Function} scm_fdopen (fdes, modes) Return a new port based on the file descriptor @var{fdes}. @@ -1953,6 +2179,7 @@ same as that accepted by @ref{File Ports, open-file}. @end deffn primitive-move->fdes +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:262 @deffn {Scheme Procedure} primitive-move->fdes port fd @deffnx {C Function} scm_primitive_move_to_fdes (port, fd) Moves the underlying file descriptor for @var{port} to the integer @@ -1964,6 +2191,7 @@ required value or @code{#t} if it was moved. @end deffn fdes->ports +@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:296 @deffn {Scheme Procedure} fdes->ports fd @deffnx {C Function} scm_fdes_to_ports (fd) Return a list of existing ports which have @var{fdes} as an @@ -1972,12 +2200,14 @@ counts. @end deffn make-keyword-from-dash-symbol +@c snarfed from /home/ghouston/guile/guile-core/libguile/keywords.c:74 @deffn {Scheme Procedure} make-keyword-from-dash-symbol symbol @deffnx {C Function} scm_make_keyword_from_dash_symbol (symbol) Make a keyword object from a @var{symbol} that starts with a dash. @end deffn keyword? +@c snarfed from /home/ghouston/guile/guile-core/libguile/keywords.c:112 @deffn {Scheme Procedure} keyword? obj @deffnx {C Function} scm_keyword_p (obj) Return @code{#t} if the argument @var{obj} is a keyword, else @@ -1985,6 +2215,7 @@ Return @code{#t} if the argument @var{obj} is a keyword, else @end deffn keyword-dash-symbol +@c snarfed from /home/ghouston/guile/guile-core/libguile/keywords.c:123 @deffn {Scheme Procedure} keyword-dash-symbol keyword @deffnx {C Function} scm_keyword_dash_symbol (keyword) Return the dash symbol for @var{keyword}. @@ -1992,6 +2223,7 @@ This is the inverse of @code{make-keyword-from-dash-symbol}. @end deffn list +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:127 @deffn {Scheme Procedure} list . objs @deffnx {C Function} scm_list (objs) Return a list containing @var{objs}, the arguments to @@ -1999,6 +2231,7 @@ Return a list containing @var{objs}, the arguments to @end deffn cons* +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:142 @deffn {Scheme Procedure} cons* arg . rest @deffnx {C Function} scm_cons_star (arg, rest) Like @code{list}, but the last arg provides the tail of the @@ -2010,24 +2243,28 @@ Schemes and in Common LISP. @end deffn null? +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:166 @deffn {Scheme Procedure} null? x @deffnx {C Function} scm_null_p (x) Return @code{#t} iff @var{x} is the empty list, else @code{#f}. @end deffn list? +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:176 @deffn {Scheme Procedure} list? x @deffnx {C Function} scm_list_p (x) Return @code{#t} iff @var{x} is a proper list, else @code{#f}. @end deffn length +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:217 @deffn {Scheme Procedure} length lst @deffnx {C Function} scm_length (lst) Return the number of elements in list @var{lst}. @end deffn append +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:246 @deffn {Scheme Procedure} append . args @deffnx {C Function} scm_append (args) Return a list consisting of the elements the lists passed as @@ -2048,6 +2285,7 @@ if the last argument is not a proper list. @end deffn append! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:280 @deffn {Scheme Procedure} append! . lists @deffnx {C Function} scm_append_x (lists) A destructive version of @code{append} (@pxref{Pairs and @@ -2058,6 +2296,7 @@ the mutated list. @end deffn last-pair +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:306 @deffn {Scheme Procedure} last-pair lst @deffnx {C Function} scm_last_pair (lst) Return a pointer to the last pair in @var{lst}, signalling an error if @@ -2065,6 +2304,7 @@ Return a pointer to the last pair in @var{lst}, signalling an error if @end deffn reverse +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:336 @deffn {Scheme Procedure} reverse lst @deffnx {C Function} scm_reverse (lst) Return a new list that contains the elements of @var{lst} but @@ -2072,6 +2312,7 @@ in reverse order. @end deffn reverse! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:370 @deffn {Scheme Procedure} reverse! lst [new_tail] @deffnx {C Function} scm_reverse_x (lst, new_tail) A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r5rs, @@ -2088,23 +2329,27 @@ of the modified list is not lost, it is wise to save the return value of @end deffn list-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:396 @deffn {Scheme Procedure} list-ref list k @deffnx {C Function} scm_list_ref (list, k) Return the @var{k}th element from @var{list}. @end deffn list-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:420 @deffn {Scheme Procedure} list-set! list k val @deffnx {C Function} scm_list_set_x (list, k, val) Set the @var{k}th element of @var{list} to @var{val}. @end deffn list-cdr-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:443 @deffn {Scheme Procedure} list-cdr-ref implemented by the C function "scm_list_tail" @end deffn list-tail +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:452 @deffn {Scheme Procedure} list-tail lst k @deffnx {Scheme Procedure} list-cdr-ref lst k @deffnx {C Function} scm_list_tail (lst, k) @@ -2117,12 +2362,14 @@ or returning the results of cdring @var{k} times down @var{lst}. @end deffn list-cdr-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:468 @deffn {Scheme Procedure} list-cdr-set! list k val @deffnx {C Function} scm_list_cdr_set_x (list, k, val) Set the @var{k}th cdr of @var{list} to @var{val}. @end deffn list-head +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:497 @deffn {Scheme Procedure} list-head lst k @deffnx {C Function} scm_list_head (lst, k) Copy the first @var{k} elements from @var{lst} into a new list, and @@ -2130,12 +2377,14 @@ return it. @end deffn list-copy +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:521 @deffn {Scheme Procedure} list-copy lst @deffnx {C Function} scm_list_copy (lst) Return a (newly-created) copy of @var{lst}. @end deffn memq +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:575 @deffn {Scheme Procedure} memq x lst @deffnx {C Function} scm_memq (x, lst) Return the first sublist of @var{lst} whose car is @code{eq?} @@ -2147,6 +2396,7 @@ returned. @end deffn memv +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:591 @deffn {Scheme Procedure} memv x lst @deffnx {C Function} scm_memv (x, lst) Return the first sublist of @var{lst} whose car is @code{eqv?} @@ -2158,6 +2408,7 @@ returned. @end deffn member +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:612 @deffn {Scheme Procedure} member x lst @deffnx {C Function} scm_member (x, lst) Return the first sublist of @var{lst} whose car is @@ -2169,6 +2420,7 @@ empty list) is returned. @end deffn delq! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:637 @deffn {Scheme Procedure} delq! item lst @deffnx {Scheme Procedure} delv! item lst @deffnx {Scheme Procedure} delete! item lst @@ -2182,6 +2434,7 @@ destructive list functions, these functions cannot modify the binding of @end deffn delv! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:661 @deffn {Scheme Procedure} delv! item lst @deffnx {C Function} scm_delv_x (item, lst) Destructively remove all elements from @var{lst} that are @@ -2189,6 +2442,7 @@ Destructively remove all elements from @var{lst} that are @end deffn delete! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:686 @deffn {Scheme Procedure} delete! item lst @deffnx {C Function} scm_delete_x (item, lst) Destructively remove all elements from @var{lst} that are @@ -2196,6 +2450,7 @@ Destructively remove all elements from @var{lst} that are @end deffn delq +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:715 @deffn {Scheme Procedure} delq item lst @deffnx {C Function} scm_delq (item, lst) Return a newly-created copy of @var{lst} with elements @@ -2205,6 +2460,7 @@ Return a newly-created copy of @var{lst} with elements @end deffn delv +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:728 @deffn {Scheme Procedure} delv item lst @deffnx {C Function} scm_delv (item, lst) Return a newly-created copy of @var{lst} with elements @@ -2214,6 +2470,7 @@ Return a newly-created copy of @var{lst} with elements @end deffn delete +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:741 @deffn {Scheme Procedure} delete item lst @deffnx {C Function} scm_delete (item, lst) Return a newly-created copy of @var{lst} with elements @@ -2223,6 +2480,7 @@ against @var{item} with @code{equal?}. @end deffn delq1! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:754 @deffn {Scheme Procedure} delq1! item lst @deffnx {C Function} scm_delq1_x (item, lst) Like @code{delq!}, but only deletes the first occurrence of @@ -2231,6 +2489,7 @@ Like @code{delq!}, but only deletes the first occurrence of @end deffn delv1! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:782 @deffn {Scheme Procedure} delv1! item lst @deffnx {C Function} scm_delv1_x (item, lst) Like @code{delv!}, but only deletes the first occurrence of @@ -2239,6 +2498,7 @@ Like @code{delv!}, but only deletes the first occurrence of @end deffn delete1! +@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:810 @deffn {Scheme Procedure} delete1! item lst @deffnx {C Function} scm_delete1_x (item, lst) Like @code{delete!}, but only deletes the first occurrence of @@ -2247,6 +2507,7 @@ Like @code{delete!}, but only deletes the first occurrence of @end deffn primitive-load +@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:111 @deffn {Scheme Procedure} primitive-load filename @deffnx {C Function} scm_primitive_load (filename) Load the file named @var{filename} and evaluate its contents in @@ -2259,6 +2520,7 @@ documentation for @code{%load-hook} later in this section. @end deffn %package-data-dir +@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:151 @deffn {Scheme Procedure} %package-data-dir @deffnx {C Function} scm_sys_package_data_dir () Return the name of the directory where Scheme packages, modules and @@ -2267,6 +2529,7 @@ libraries are kept. On most Unix systems, this will be @end deffn %library-dir +@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:163 @deffn {Scheme Procedure} %library-dir @deffnx {C Function} scm_sys_library_dir () Return the directory where the Guile Scheme library files are installed. @@ -2274,6 +2537,7 @@ E.g., may return "/usr/share/guile/1.3.5". @end deffn %site-dir +@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:175 @deffn {Scheme Procedure} %site-dir @deffnx {C Function} scm_sys_site_dir () Return the directory where the Guile site files are installed. @@ -2281,6 +2545,7 @@ E.g., may return "/usr/share/guile/site". @end deffn parse-path +@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:227 @deffn {Scheme Procedure} parse-path path [tail] @deffnx {C Function} scm_parse_path (path, tail) Parse @var{path}, which is expected to be a colon-separated @@ -2290,6 +2555,7 @@ is returned. @end deffn search-path +@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:277 @deffn {Scheme Procedure} search-path path filename [extensions] @deffnx {C Function} scm_search_path (path, filename, extensions) Search @var{path} for a directory containing a file named @@ -2302,6 +2568,7 @@ concatenated with each @var{extension}. @end deffn %search-load-path +@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:423 @deffn {Scheme Procedure} %search-load-path filename @deffnx {C Function} scm_sys_search_load_path (filename) Search @var{%load-path} for the file named @var{filename}, @@ -2314,6 +2581,7 @@ will try each extension automatically. @end deffn primitive-load-path +@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:444 @deffn {Scheme Procedure} primitive-load-path filename @deffnx {C Function} scm_primitive_load_path (filename) Search @var{%load-path} for the file named @var{filename} and @@ -2323,6 +2591,7 @@ an error is signalled. @end deffn procedure->syntax +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:104 @deffn {Scheme Procedure} procedure->syntax code @deffnx {C Function} scm_makacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2332,6 +2601,7 @@ environment. @end deffn procedure->macro +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:125 @deffn {Scheme Procedure} procedure->macro code @deffnx {C Function} scm_makmacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2349,6 +2619,7 @@ environment. For example: @end deffn procedure->memoizing-macro +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:143 @deffn {Scheme Procedure} procedure->memoizing-macro code @deffnx {C Function} scm_makmmacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2363,6 +2634,7 @@ form of the containing code. @end deffn macro? +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:155 @deffn {Scheme Procedure} macro? obj @deffnx {C Function} scm_macro_p (obj) Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a @@ -2370,6 +2642,7 @@ syntax transformer. @end deffn macro-type +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:173 @deffn {Scheme Procedure} macro-type m @deffnx {C Function} scm_macro_type (m) Return one of the symbols @code{syntax}, @code{macro} or @@ -2380,24 +2653,28 @@ returned. @end deffn macro-name +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:191 @deffn {Scheme Procedure} macro-name m @deffnx {C Function} scm_macro_name (m) Return the name of the macro @var{m}. @end deffn macro-transformer +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:202 @deffn {Scheme Procedure} macro-transformer m @deffnx {C Function} scm_macro_transformer (m) Return the transformer of the macro @var{m}. @end deffn current-module +@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:69 @deffn {Scheme Procedure} current-module @deffnx {C Function} scm_current_module () Return the current module. @end deffn set-current-module +@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:81 @deffn {Scheme Procedure} set-current-module module @deffnx {C Function} scm_set_current_module (module) Set the current module to @var{module} and return @@ -2405,6 +2682,7 @@ the previous current module. @end deffn interaction-environment +@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:104 @deffn {Scheme Procedure} interaction-environment @deffnx {C Function} scm_interaction_environment () Return a specifier for the environment that contains @@ -2415,30 +2693,35 @@ evaluate expressions dynamically typed by the user. @end deffn env-module +@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:271 @deffn {Scheme Procedure} env-module env @deffnx {C Function} scm_env_module (env) Return the module of @var{ENV}, a lexical environment. @end deffn standard-eval-closure +@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:348 @deffn {Scheme Procedure} standard-eval-closure module @deffnx {C Function} scm_standard_eval_closure (module) Return an eval closure for the module @var{module}. @end deffn standard-interface-eval-closure +@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:359 @deffn {Scheme Procedure} standard-interface-eval-closure module @deffnx {C Function} scm_standard_interface_eval_closure (module) Return a interface eval closure for the module @var{module}. Such a closure does not allow new bindings to be added. @end deffn %get-pre-modules-obarray +@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:582 @deffn {Scheme Procedure} %get-pre-modules-obarray @deffnx {C Function} scm_get_pre_modules_obarray () Return the obarray that is used for all new bindings before the module system is booted. The first call to @code{set-current-module} will boot the module system. @end deffn exact? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:106 @deffn {Scheme Procedure} exact? x @deffnx {C Function} scm_exact_p (x) Return @code{#t} if @var{x} is an exact number, @code{#f} @@ -2446,6 +2729,7 @@ otherwise. @end deffn odd? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:123 @deffn {Scheme Procedure} odd? n @deffnx {C Function} scm_odd_p (n) Return @code{#t} if @var{n} is an odd number, @code{#f} @@ -2453,13 +2737,45 @@ otherwise. @end deffn even? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:142 @deffn {Scheme Procedure} even? n @deffnx {C Function} scm_even_p (n) Return @code{#t} if @var{n} is an even number, @code{#f} otherwise. @end deffn + inf? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:184 +@deffn {Scheme Procedure} inf? n +@deffnx {C Function} scm_inf_p (n) +Return @code{#t} if @var{n} is infinite, @code{#f} +otherwise. +@end deffn + + nan? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:201 +@deffn {Scheme Procedure} nan? n +@deffnx {C Function} scm_nan_p (n) +Return @code{#t} if @var{n} is a NaN, @code{#f} +otherwise. +@end deffn + + inf +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:263 +@deffn {Scheme Procedure} inf +@deffnx {C Function} scm_inf () +Return Inf. +@end deffn + + nan +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:278 +@deffn {Scheme Procedure} nan +@deffnx {C Function} scm_nan () +Return NaN. +@end deffn + logand +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:891 @deffn {Scheme Procedure} logand n1 n2 Return the bitwise AND of the integer arguments. @@ -2471,6 +2787,7 @@ Return the bitwise AND of the integer arguments. @end deffn logior +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:972 @deffn {Scheme Procedure} logior n1 n2 Return the bitwise OR of the integer arguments. @@ -2482,6 +2799,7 @@ Return the bitwise OR of the integer arguments. @end deffn logxor +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1054 @deffn {Scheme Procedure} logxor n1 n2 Return the bitwise XOR of the integer arguments. A bit is set in the result if it is set in an odd number of arguments. @@ -2494,6 +2812,7 @@ set in the result if it is set in an odd number of arguments. @end deffn logtest +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1118 @deffn {Scheme Procedure} logtest j k @deffnx {C Function} scm_logtest (j, k) @lisp @@ -2505,6 +2824,7 @@ set in the result if it is set in an odd number of arguments. @end deffn logbit? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1175 @deffn {Scheme Procedure} logbit? index j @deffnx {C Function} scm_logbit_p (index, j) @lisp @@ -2519,6 +2839,7 @@ set in the result if it is set in an odd number of arguments. @end deffn lognot +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1224 @deffn {Scheme Procedure} lognot n @deffnx {C Function} scm_lognot (n) Return the integer which is the 2s-complement of the integer @@ -2533,6 +2854,7 @@ argument. @end deffn integer-expt +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1241 @deffn {Scheme Procedure} integer-expt n k @deffnx {C Function} scm_integer_expt (n, k) Return @var{n} raised to the non-negative integer exponent @@ -2547,6 +2869,7 @@ Return @var{n} raised to the non-negative integer exponent @end deffn ash +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1296 @deffn {Scheme Procedure} ash n cnt @deffnx {C Function} scm_ash (n, cnt) The function ash performs an arithmetic shift left by @var{cnt} @@ -2567,6 +2890,7 @@ Formally, the function returns an integer equivalent to @end deffn bit-extract +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1349 @deffn {Scheme Procedure} bit-extract n start end @deffnx {C Function} scm_bit_extract (n, start, end) Return the integer composed of the @var{start} (inclusive) @@ -2582,6 +2906,7 @@ through @var{end} (exclusive) bits of @var{n}. The @end deffn logcount +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1421 @deffn {Scheme Procedure} logcount n @deffnx {C Function} scm_logcount (n) Return the number of bits in integer @var{n}. If integer is @@ -2600,6 +2925,7 @@ representation are counted. If 0, 0 is returned. @end deffn integer-length +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1472 @deffn {Scheme Procedure} integer-length n @deffnx {C Function} scm_integer_length (n) Return the number of bits necessary to represent @var{n}. @@ -2615,6 +2941,7 @@ Return the number of bits necessary to represent @var{n}. @end deffn number->string +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:2330 @deffn {Scheme Procedure} number->string n [radix] @deffnx {C Function} scm_number_to_string (n, radix) Return a string holding the external representation of the @@ -2623,6 +2950,7 @@ inexact, a radix of 10 will be used. @end deffn string->number +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:2989 @deffn {Scheme Procedure} string->number string [radix] @deffnx {C Function} scm_string_to_number (string, radix) Return a number of the maximally precise representation @@ -2636,11 +2964,13 @@ syntactically valid notation for a number, then @end deffn number? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3058 @deffn {Scheme Procedure} number? implemented by the C function "scm_number_p" @end deffn complex? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3070 @deffn {Scheme Procedure} complex? x @deffnx {C Function} scm_number_p (x) Return @code{#t} if @var{x} is a complex number, @code{#f} @@ -2651,11 +2981,13 @@ rational or integer number. @end deffn real? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3078 @deffn {Scheme Procedure} real? implemented by the C function "scm_real_p" @end deffn rational? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3091 @deffn {Scheme Procedure} rational? x @deffnx {C Function} scm_real_p (x) Return @code{#t} if @var{x} is a rational number, @code{#f} @@ -2667,6 +2999,7 @@ precision. @end deffn integer? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3112 @deffn {Scheme Procedure} integer? x @deffnx {C Function} scm_integer_p (x) Return @code{#t} if @var{x} is an integer number, @code{#f} @@ -2674,6 +3007,7 @@ else. @end deffn inexact? +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3137 @deffn {Scheme Procedure} inexact? x @deffnx {C Function} scm_inexact_p (x) Return @code{#t} if @var{x} is an inexact number, @code{#f} @@ -2681,6 +3015,7 @@ else. @end deffn $expt +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4297 @deffn {Scheme Procedure} $expt x y @deffnx {C Function} scm_sys_expt (x, y) Return @var{x} raised to the power of @var{y}. This @@ -2688,6 +3023,7 @@ procedure does not accept complex arguments. @end deffn $atan2 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4313 @deffn {Scheme Procedure} $atan2 x y @deffnx {C Function} scm_sys_atan2 (x, y) Return the arc tangent of the two arguments @var{x} and @@ -2698,6 +3034,7 @@ procedure does not accept complex arguments. @end deffn make-rectangular +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4326 @deffn {Scheme Procedure} make-rectangular real imaginary @deffnx {C Function} scm_make_rectangular (real, imaginary) Return a complex number constructed of the given @var{real} and @@ -2705,42 +3042,49 @@ Return a complex number constructed of the given @var{real} and @end deffn make-polar +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4339 @deffn {Scheme Procedure} make-polar x y @deffnx {C Function} scm_make_polar (x, y) Return the complex number @var{x} * e^(i * @var{y}). @end deffn inexact->exact +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4474 @deffn {Scheme Procedure} inexact->exact z @deffnx {C Function} scm_inexact_to_exact (z) Return an exact number that is numerically closest to @var{z}. @end deffn class-of +@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:86 @deffn {Scheme Procedure} class-of x @deffnx {C Function} scm_class_of (x) Return the class of @var{x}. @end deffn entity? +@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:360 @deffn {Scheme Procedure} entity? obj @deffnx {C Function} scm_entity_p (obj) Return @code{#t} if @var{obj} is an entity. @end deffn operator? +@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:369 @deffn {Scheme Procedure} operator? obj @deffnx {C Function} scm_operator_p (obj) Return @code{#t} if @var{obj} is an operator. @end deffn valid-object-procedure? +@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:385 @deffn {Scheme Procedure} valid-object-procedure? proc @deffnx {C Function} scm_valid_object_procedure_p (proc) Return @code{#t} iff @var{proc} is a procedure that can be used with @code{set-object-procedure}. It is always valid to use a closure constructed by @code{lambda}. @end deffn set-object-procedure! +@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:407 @deffn {Scheme Procedure} set-object-procedure! obj proc @deffnx {C Function} scm_set_object_procedure_x (obj, proc) Set the object procedure of @var{obj} to @var{proc}. @@ -2748,6 +3092,7 @@ Set the object procedure of @var{obj} to @var{proc}. @end deffn make-class-object +@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:467 @deffn {Scheme Procedure} make-class-object metaclass layout @deffnx {C Function} scm_make_class_object (metaclass, layout) Create a new class object of class @var{metaclass}, with the @@ -2755,6 +3100,7 @@ slot layout specified by @var{layout}. @end deffn make-subclass-object +@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:482 @deffn {Scheme Procedure} make-subclass-object class layout @deffnx {C Function} scm_make_subclass_object (class, layout) Create a subclass object of @var{class}, with the slot layout @@ -2762,24 +3108,28 @@ specified by @var{layout}. @end deffn object-properties +@c snarfed from /home/ghouston/guile/guile-core/libguile/objprop.c:59 @deffn {Scheme Procedure} object-properties obj @deffnx {C Function} scm_object_properties (obj) Return @var{obj}'s property list. @end deffn set-object-properties! +@c snarfed from /home/ghouston/guile/guile-core/libguile/objprop.c:69 @deffn {Scheme Procedure} set-object-properties! obj alist @deffnx {C Function} scm_set_object_properties_x (obj, alist) Set @var{obj}'s property list to @var{alist}. @end deffn object-property +@c snarfed from /home/ghouston/guile/guile-core/libguile/objprop.c:80 @deffn {Scheme Procedure} object-property obj key @deffnx {C Function} scm_object_property (obj, key) Return the property of @var{obj} with name @var{key}. @end deffn set-object-property! +@c snarfed from /home/ghouston/guile/guile-core/libguile/objprop.c:92 @deffn {Scheme Procedure} set-object-property! obj key value @deffnx {C Function} scm_set_object_property_x (obj, key, value) In @var{obj}'s property list, set the property named @var{key} @@ -2787,6 +3137,7 @@ to @var{value}. @end deffn cons +@c snarfed from /home/ghouston/guile/guile-core/libguile/pairs.c:80 @deffn {Scheme Procedure} cons x y @deffnx {C Function} scm_cons (x, y) Return a newly allocated pair whose car is @var{x} and whose @@ -2795,6 +3146,7 @@ sense of @code{eq?}) from every previously existing object. @end deffn pair? +@c snarfed from /home/ghouston/guile/guile-core/libguile/pairs.c:98 @deffn {Scheme Procedure} pair? x @deffnx {C Function} scm_pair_p (x) Return @code{#t} if @var{x} is a pair; otherwise return @@ -2802,6 +3154,7 @@ Return @code{#t} if @var{x} is a pair; otherwise return @end deffn set-car! +@c snarfed from /home/ghouston/guile/guile-core/libguile/pairs.c:109 @deffn {Scheme Procedure} set-car! pair value @deffnx {C Function} scm_set_car_x (pair, value) Stores @var{value} in the car field of @var{pair}. The value returned @@ -2809,6 +3162,7 @@ by @code{set-car!} is unspecified. @end deffn set-cdr! +@c snarfed from /home/ghouston/guile/guile-core/libguile/pairs.c:122 @deffn {Scheme Procedure} set-cdr! pair value @deffnx {C Function} scm_set_cdr_x (pair, value) Stores @var{value} in the cdr field of @var{pair}. The value returned @@ -2816,6 +3170,7 @@ by @code{set-cdr!} is unspecified. @end deffn char-ready? +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:259 @deffn {Scheme Procedure} char-ready? [port] @deffnx {C Function} scm_char_ready_p (port) Return @code{#t} if a character is ready on input @var{port} @@ -2834,6 +3189,7 @@ interactive port that has no ready characters.} @end deffn drain-input +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:336 @deffn {Scheme Procedure} drain-input port @deffnx {C Function} scm_drain_input (port) This procedure clears a port's input buffers, similar @@ -2853,6 +3209,7 @@ for further input. @end deffn current-input-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:363 @deffn {Scheme Procedure} current-input-port @deffnx {C Function} scm_current_input_port () Return the current input port. This is the default port used @@ -2861,6 +3218,7 @@ returns the @dfn{standard input} in Unix and C terminology. @end deffn current-output-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:375 @deffn {Scheme Procedure} current-output-port @deffnx {C Function} scm_current_output_port () Return the current output port. This is the default port used @@ -2870,6 +3228,7 @@ Unix and C terminology. @end deffn current-error-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:385 @deffn {Scheme Procedure} current-error-port @deffnx {C Function} scm_current_error_port () Return the port to which errors and warnings should be sent (the @@ -2877,6 +3236,7 @@ Return the port to which errors and warnings should be sent (the @end deffn current-load-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:395 @deffn {Scheme Procedure} current-load-port @deffnx {C Function} scm_current_load_port () Return the current-load-port. @@ -2884,6 +3244,7 @@ The load port is used internally by @code{primitive-load}. @end deffn set-current-input-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:408 @deffn {Scheme Procedure} set-current-input-port port @deffnx {Scheme Procedure} set-current-output-port port @deffnx {Scheme Procedure} set-current-error-port port @@ -2894,24 +3255,28 @@ so that they use the supplied @var{port} for input or output. @end deffn set-current-output-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:421 @deffn {Scheme Procedure} set-current-output-port port @deffnx {C Function} scm_set_current_output_port (port) Set the current default output port to @var{port}. @end deffn set-current-error-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:435 @deffn {Scheme Procedure} set-current-error-port port @deffnx {C Function} scm_set_current_error_port (port) Set the current default error port to @var{port}. @end deffn port-revealed +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:578 @deffn {Scheme Procedure} port-revealed port @deffnx {C Function} scm_port_revealed (port) Return the revealed count for @var{port}. @end deffn set-port-revealed! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:591 @deffn {Scheme Procedure} set-port-revealed! port rcount @deffnx {C Function} scm_set_port_revealed_x (port, rcount) Sets the revealed count for a port to a given value. @@ -2919,6 +3284,7 @@ The return value is unspecified. @end deffn port-mode +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:634 @deffn {Scheme Procedure} port-mode port @deffnx {C Function} scm_port_mode (port) Return the port modes associated with the open port @var{port}. @@ -2928,6 +3294,7 @@ used only during port creation are not retained. @end deffn close-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:671 @deffn {Scheme Procedure} close-port port @deffnx {C Function} scm_close_port (port) Close the specified port object. Return @code{#t} if it @@ -2939,6 +3306,7 @@ descriptors. @end deffn close-input-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:699 @deffn {Scheme Procedure} close-input-port port @deffnx {C Function} scm_close_input_port (port) Close the specified input port object. The routine has no effect if @@ -2950,6 +3318,7 @@ which can close file descriptors. @end deffn close-output-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:714 @deffn {Scheme Procedure} close-output-port port @deffnx {C Function} scm_close_output_port (port) Close the specified output port object. The routine has no effect if @@ -2961,6 +3330,7 @@ which can close file descriptors. @end deffn port-for-each +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:731 @deffn {Scheme Procedure} port-for-each proc @deffnx {C Function} scm_port_for_each (proc) Apply @var{proc} to each port in the Guile port table @@ -2972,6 +3342,7 @@ have no effect as far as @var{port-for-each} is concerned. @end deffn input-port? +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:772 @deffn {Scheme Procedure} input-port? x @deffnx {C Function} scm_input_port_p (x) Return @code{#t} if @var{x} is an input port, otherwise return @@ -2980,6 +3351,7 @@ Return @code{#t} if @var{x} is an input port, otherwise return @end deffn output-port? +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:783 @deffn {Scheme Procedure} output-port? x @deffnx {C Function} scm_output_port_p (x) Return @code{#t} if @var{x} is an output port, otherwise return @@ -2988,6 +3360,7 @@ Return @code{#t} if @var{x} is an output port, otherwise return @end deffn port? +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:795 @deffn {Scheme Procedure} port? x @deffnx {C Function} scm_port_p (x) Return a boolean indicating whether @var{x} is a port. @@ -2996,6 +3369,7 @@ Equivalent to @code{(or (input-port? @var{x}) (output-port? @end deffn port-closed? +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:805 @deffn {Scheme Procedure} port-closed? port @deffnx {C Function} scm_port_closed_p (port) Return @code{#t} if @var{port} is closed or @code{#f} if it is @@ -3003,6 +3377,7 @@ open. @end deffn eof-object? +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:816 @deffn {Scheme Procedure} eof-object? x @deffnx {C Function} scm_eof_object_p (x) Return @code{#t} if @var{x} is an end-of-file object; otherwise @@ -3010,6 +3385,7 @@ return @code{#f}. @end deffn force-output +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:830 @deffn {Scheme Procedure} force-output [port] @deffnx {C Function} scm_force_output (port) Flush the specified output port, or the current output port if @var{port} @@ -3022,6 +3398,7 @@ The return value is unspecified. @end deffn flush-all-ports +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:848 @deffn {Scheme Procedure} flush-all-ports @deffnx {C Function} scm_flush_all_ports () Equivalent to calling @code{force-output} on @@ -3029,6 +3406,7 @@ all open output ports. The return value is unspecified. @end deffn read-char +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:866 @deffn {Scheme Procedure} read-char [port] @deffnx {C Function} scm_read_char (port) Return the next character available from @var{port}, updating @@ -3037,6 +3415,7 @@ characters are available, the end-of-file object is returned. @end deffn peek-char +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1192 @deffn {Scheme Procedure} peek-char [port] @deffnx {C Function} scm_peek_char (port) Return the next character available from @var{port}, @@ -3054,6 +3433,7 @@ to @code{read-char} would have hung.} @end deffn unread-char +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1213 @deffn {Scheme Procedure} unread-char cobj [port] @deffnx {C Function} scm_unread_char (cobj, port) Place @var{char} in @var{port} so that it will be read by the @@ -3063,6 +3443,7 @@ not supplied, the current input port is used. @end deffn unread-string +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1236 @deffn {Scheme Procedure} unread-string str port @deffnx {C Function} scm_unread_string (str, port) Place the string @var{str} in @var{port} so that its characters will be @@ -3072,6 +3453,7 @@ unread characters will be read again in last-in first-out order. If @end deffn seek +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1275 @deffn {Scheme Procedure} seek fd_port offset whence @deffnx {C Function} scm_seek (fd_port, offset, whence) Sets the current position of @var{fd/port} to the integer @@ -3100,6 +3482,7 @@ that the current position of a port can be obtained using: @end deffn truncate-file +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1330 @deffn {Scheme Procedure} truncate-file object [length] @deffnx {C Function} scm_truncate_file (object, length) Truncates the object referred to by @var{object} to at most @@ -3111,18 +3494,21 @@ position. The return value is unspecified. @end deffn port-line +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1383 @deffn {Scheme Procedure} port-line port @deffnx {C Function} scm_port_line (port) Return the current line number for @var{port}. @end deffn set-port-line! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1394 @deffn {Scheme Procedure} set-port-line! port line @deffnx {C Function} scm_set_port_line_x (port, line) Set the current line number for @var{port} to @var{line}. @end deffn port-column +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1415 @deffn {Scheme Procedure} port-column port @deffnx {Scheme Procedure} port-line port @deffnx {C Function} scm_port_column (port) @@ -3137,6 +3523,7 @@ what non-programmers will find most natural.) @end deffn set-port-column! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1428 @deffn {Scheme Procedure} set-port-column! port column @deffnx {Scheme Procedure} set-port-line! port line @deffnx {C Function} scm_set_port_column_x (port, column) @@ -3145,6 +3532,7 @@ current input port if none is specified. @end deffn port-filename +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1443 @deffn {Scheme Procedure} port-filename port @deffnx {C Function} scm_port_filename (port) Return the filename associated with @var{port}. This function returns @@ -3153,6 +3541,7 @@ when called on the current input, output and error ports respectively. @end deffn set-port-filename! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1457 @deffn {Scheme Procedure} set-port-filename! port filename @deffnx {C Function} scm_set_port_filename_x (port, filename) Change the filename associated with @var{port}, using the current input @@ -3162,6 +3551,7 @@ source of data, but only the value that is returned by @end deffn %make-void-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1551 @deffn {Scheme Procedure} %make-void-port mode @deffnx {C Function} scm_sys_make_void_port (mode) Create and return a new void port. A void port acts like @@ -3171,6 +3561,7 @@ documentation for @code{open-file} in @ref{File Ports}. @end deffn print-options-interface +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:142 @deffn {Scheme Procedure} print-options-interface [setting] @deffnx {C Function} scm_print_options (setting) Option interface for the print options. Instead of using @@ -3180,6 +3571,7 @@ and @code{print-options}. @end deffn simple-format +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:921 @deffn {Scheme Procedure} simple-format destination message . args @deffnx {C Function} scm_simple_format (destination, message, args) Write @var{message} to @var{destination}, defaulting to @@ -3196,6 +3588,7 @@ containing the formatted text. Does not add a trailing newline. @end deffn newline +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1009 @deffn {Scheme Procedure} newline [port] @deffnx {C Function} scm_newline (port) Send a newline to @var{port}. @@ -3203,12 +3596,14 @@ If @var{port} is omitted, send to the current output port. @end deffn write-char +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1024 @deffn {Scheme Procedure} write-char chr [port] @deffnx {C Function} scm_write_char (chr, port) Send character @var{chr} to @var{port}. @end deffn port-with-print-state +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1078 @deffn {Scheme Procedure} port-with-print-state port pstate @deffnx {C Function} scm_port_with_print_state (port, pstate) Create a new port which behaves like @var{port}, but with an @@ -3216,6 +3611,7 @@ included print state @var{pstate}. @end deffn get-print-state +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1093 @deffn {Scheme Procedure} get-print-state port @deffnx {C Function} scm_get_print_state (port) Return the print state of the port @var{port}. If @var{port} @@ -3223,24 +3619,28 @@ has no associated print state, @code{#f} is returned. @end deffn procedure-properties +@c snarfed from /home/ghouston/guile/guile-core/libguile/procprop.c:176 @deffn {Scheme Procedure} procedure-properties proc @deffnx {C Function} scm_procedure_properties (proc) Return @var{obj}'s property list. @end deffn set-procedure-properties! +@c snarfed from /home/ghouston/guile/guile-core/libguile/procprop.c:189 @deffn {Scheme Procedure} set-procedure-properties! proc new_val @deffnx {C Function} scm_set_procedure_properties_x (proc, new_val) Set @var{obj}'s property list to @var{alist}. @end deffn procedure-property +@c snarfed from /home/ghouston/guile/guile-core/libguile/procprop.c:202 @deffn {Scheme Procedure} procedure-property p k @deffnx {C Function} scm_procedure_property (p, k) Return the property of @var{obj} with name @var{key}. @end deffn set-procedure-property! +@c snarfed from /home/ghouston/guile/guile-core/libguile/procprop.c:225 @deffn {Scheme Procedure} set-procedure-property! p k v @deffnx {C Function} scm_set_procedure_property_x (p, k, v) In @var{obj}'s property list, set the property named @var{key} to @@ -3248,24 +3648,28 @@ In @var{obj}'s property list, set the property named @var{key} to @end deffn procedure? +@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:186 @deffn {Scheme Procedure} procedure? obj @deffnx {C Function} scm_procedure_p (obj) Return @code{#t} if @var{obj} is a procedure. @end deffn closure? +@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:213 @deffn {Scheme Procedure} closure? obj @deffnx {C Function} scm_closure_p (obj) Return @code{#t} if @var{obj} is a closure. @end deffn thunk? +@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:222 @deffn {Scheme Procedure} thunk? obj @deffnx {C Function} scm_thunk_p (obj) Return @code{#t} if @var{obj} is a thunk. @end deffn procedure-documentation +@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:272 @deffn {Scheme Procedure} procedure-documentation proc @deffnx {C Function} scm_procedure_documentation (proc) Return the documentation string associated with @code{proc}. By @@ -3275,6 +3679,7 @@ documentation for that procedure. @end deffn procedure-with-setter? +@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:308 @deffn {Scheme Procedure} procedure-with-setter? obj @deffnx {C Function} scm_procedure_with_setter_p (obj) Return @code{#t} if @var{obj} is a procedure with an @@ -3282,6 +3687,7 @@ associated setter procedure. @end deffn make-procedure-with-setter +@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:318 @deffn {Scheme Procedure} make-procedure-with-setter procedure setter @deffnx {C Function} scm_make_procedure_with_setter (procedure, setter) Create a new procedure which behaves like @var{procedure}, but @@ -3289,6 +3695,7 @@ with the associated setter @var{setter}. @end deffn procedure +@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:332 @deffn {Scheme Procedure} procedure proc @deffnx {C Function} scm_procedure (proc) Return the procedure of @var{proc}, which must be either a @@ -3296,6 +3703,7 @@ procedure with setter, or an operator struct. @end deffn primitive-make-property +@c snarfed from /home/ghouston/guile/guile-core/libguile/properties.c:64 @deffn {Scheme Procedure} primitive-make-property not_found_proc @deffnx {C Function} scm_primitive_make_property (not_found_proc) Create a @dfn{property token} that can be used with @@ -3305,6 +3713,7 @@ See @code{primitive-property-ref} for the significance of @end deffn primitive-property-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/properties.c:82 @deffn {Scheme Procedure} primitive-property-ref prop obj @deffnx {C Function} scm_primitive_property_ref (prop, obj) Return the property @var{prop} of @var{obj}. When no value @@ -3317,18 +3726,21 @@ default value of @var{prop}. @end deffn primitive-property-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/properties.c:113 @deffn {Scheme Procedure} primitive-property-set! prop obj val @deffnx {C Function} scm_primitive_property_set_x (prop, obj, val) Associate @var{code} with @var{prop} and @var{obj}. @end deffn primitive-property-del! +@c snarfed from /home/ghouston/guile/guile-core/libguile/properties.c:134 @deffn {Scheme Procedure} primitive-property-del! prop obj @deffnx {C Function} scm_primitive_property_del_x (prop, obj) Remove any value associated with @var{prop} and @var{obj}. @end deffn random +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:376 @deffn {Scheme Procedure} random n [state] @deffnx {C Function} scm_random (n, state) Return a number in [0,N). @@ -3346,18 +3758,21 @@ as a side effect of the random operation. @end deffn copy-random-state +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:399 @deffn {Scheme Procedure} copy-random-state [state] @deffnx {C Function} scm_copy_random_state (state) Return a copy of the random state @var{state}. @end deffn seed->random-state +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:411 @deffn {Scheme Procedure} seed->random-state seed @deffnx {C Function} scm_seed_to_random_state (seed) Return a new random state using @var{seed}. @end deffn random:uniform +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:425 @deffn {Scheme Procedure} random:uniform [state] @deffnx {C Function} scm_random_uniform (state) Return a uniformly distributed inexact real random number in @@ -3365,6 +3780,7 @@ Return a uniformly distributed inexact real random number in @end deffn random:normal +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:440 @deffn {Scheme Procedure} random:normal [state] @deffnx {C Function} scm_random_normal (state) Return an inexact real in a normal distribution. The @@ -3374,6 +3790,7 @@ normal distribution with mean m and standard deviation d use @end deffn random:solid-sphere! +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:496 @deffn {Scheme Procedure} random:solid-sphere! v [state] @deffnx {C Function} scm_random_solid_sphere_x (v, state) Fills vect with inexact real random numbers @@ -3385,6 +3802,7 @@ The sum of the squares of the numbers is returned. @end deffn random:hollow-sphere! +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:519 @deffn {Scheme Procedure} random:hollow-sphere! v [state] @deffnx {C Function} scm_random_hollow_sphere_x (v, state) Fills vect with inexact real random numbers @@ -3396,6 +3814,7 @@ unit n-sphere. @end deffn random:normal-vector! +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:537 @deffn {Scheme Procedure} random:normal-vector! v [state] @deffnx {C Function} scm_random_normal_vector_x (v, state) Fills vect with inexact real random numbers that are @@ -3404,6 +3823,7 @@ independent and standard normally distributed @end deffn random:exp +@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:562 @deffn {Scheme Procedure} random:exp [state] @deffnx {C Function} scm_random_exp (state) Return an inexact real in an exponential distribution with mean @@ -3412,6 +3832,7 @@ Return an inexact real in an exponential distribution with mean @end deffn %read-delimited! +@c snarfed from /home/ghouston/guile/guile-core/libguile/rdelim.c:78 @deffn {Scheme Procedure} %read-delimited! delims str gobble [port [start [end]]] @deffnx {C Function} scm_read_delimited_x (delims, str, gobble, port, start, end) Read characters from @var{port} into @var{str} until one of the @@ -3432,6 +3853,7 @@ a delimiter, this value is @code{#f}. @end deffn %read-line +@c snarfed from /home/ghouston/guile/guile-core/libguile/rdelim.c:222 @deffn {Scheme Procedure} %read-line [port] @deffnx {C Function} scm_read_line (port) Read a newline-terminated line from @var{port}, allocating storage as @@ -3443,6 +3865,7 @@ delimiter may be either a newline or the @var{eof-object}; if @end deffn write-line +@c snarfed from /home/ghouston/guile/guile-core/libguile/rdelim.c:275 @deffn {Scheme Procedure} write-line obj [port] @deffnx {C Function} scm_write_line (obj, port) Display @var{obj} and a newline character to @var{port}. If @@ -3455,6 +3878,7 @@ used. This function is equivalent to: @end deffn read-options-interface +@c snarfed from /home/ghouston/guile/guile-core/libguile/read.c:82 @deffn {Scheme Procedure} read-options-interface [setting] @deffnx {C Function} scm_read_options (setting) Option interface for the read options. Instead of using @@ -3463,6 +3887,7 @@ this procedure directly, use the procedures @code{read-enable}, @end deffn read +@c snarfed from /home/ghouston/guile/guile-core/libguile/read.c:102 @deffn {Scheme Procedure} read [port] @deffnx {C Function} scm_read (port) Read an s-expression from the input port @var{port}, or from @@ -3471,6 +3896,7 @@ Any whitespace before the next token is discarded. @end deffn read-hash-extend +@c snarfed from /home/ghouston/guile/guile-core/libguile/read.c:769 @deffn {Scheme Procedure} read-hash-extend chr proc @deffnx {C Function} scm_read_hash_extend (chr, proc) Install the procedure @var{proc} for reading expressions @@ -3481,6 +3907,7 @@ returned will be the return value of @code{read}. @end deffn call-with-dynamic-root +@c snarfed from /home/ghouston/guile/guile-core/libguile/root.c:346 @deffn {Scheme Procedure} call-with-dynamic-root thunk handler @deffnx {C Function} scm_call_with_dynamic_root (thunk, handler) Evaluate @code{(thunk)} in a new dynamic context, returning its value. @@ -3528,6 +3955,7 @@ be under a new dynamic root.) @end deffn dynamic-root +@c snarfed from /home/ghouston/guile/guile-core/libguile/root.c:359 @deffn {Scheme Procedure} dynamic-root @deffnx {C Function} scm_dynamic_root () Return an object representing the current dynamic root. @@ -3538,6 +3966,7 @@ in no way depend on this. @end deffn read-string!/partial +@c snarfed from /home/ghouston/guile/guile-core/libguile/rw.c:121 @deffn {Scheme Procedure} read-string!/partial str [port_or_fdes [start [end]]] @deffnx {C Function} scm_read_string_x_partial (str, port_or_fdes, start, end) Read characters from a port or file descriptor into a @@ -3580,6 +4009,7 @@ end-of-file check. @end deffn write-string/partial +@c snarfed from /home/ghouston/guile/guile-core/libguile/rw.c:215 @deffn {Scheme Procedure} write-string/partial str [port_or_fdes [start [end]]] @deffnx {C Function} scm_write_string_partial (str, port_or_fdes, start, end) Write characters from a string @var{str} to a port or file @@ -3626,6 +4056,7 @@ return 0 immediately if the request size is 0 bytes. @end deffn sigaction +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:182 @deffn {Scheme Procedure} sigaction signum [handler [flags]] @deffnx {C Function} scm_sigaction (signum, handler, flags) Install or report the signal handler for a specified signal. @@ -3657,6 +4088,7 @@ structures. @end deffn restore-signals +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:345 @deffn {Scheme Procedure} restore-signals @deffnx {C Function} scm_restore_signals () Return all signal handlers to the values they had before any call to @@ -3664,6 +4096,7 @@ Return all signal handlers to the values they had before any call to @end deffn alarm +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:384 @deffn {Scheme Procedure} alarm i @deffnx {C Function} scm_alarm (i) Set a timer to raise a @code{SIGALRM} signal after the specified @@ -3678,6 +4111,7 @@ no previous alarm, the return value is zero. @end deffn setitimer +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:414 @deffn {Scheme Procedure} setitimer which_timer interval_seconds interval_microseconds value_seconds value_microseconds @deffnx {C Function} scm_setitimer (which_timer, interval_seconds, interval_microseconds, value_seconds, value_microseconds) Set the timer specified by @var{which_timer} according to the given @@ -3698,6 +4132,7 @@ the seconds and microseconds of the timer @code{it_value}. @end deffn getitimer +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:455 @deffn {Scheme Procedure} getitimer which_timer @deffnx {C Function} scm_getitimer (which_timer) Return information about the timer specified by @var{which_timer} @@ -3714,6 +4149,7 @@ the seconds and microseconds of the timer @code{it_value}. @end deffn pause +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:482 @deffn {Scheme Procedure} pause @deffnx {C Function} scm_pause () Pause the current process (thread?) until a signal arrives whose @@ -3722,6 +4158,7 @@ handler procedure. The return value is unspecified. @end deffn sleep +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:495 @deffn {Scheme Procedure} sleep i @deffnx {C Function} scm_sleep (i) Wait for the given number of seconds (an integer) or until a signal @@ -3730,6 +4167,7 @@ of seconds remaining otherwise. @end deffn usleep +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:513 @deffn {Scheme Procedure} usleep i @deffnx {C Function} scm_usleep (i) Sleep for I microseconds. @code{usleep} is not available on @@ -3737,6 +4175,7 @@ all platforms. @end deffn raise +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:542 @deffn {Scheme Procedure} raise sig @deffnx {C Function} scm_raise (sig) Sends a specified signal @var{sig} to the current process, where @@ -3744,6 +4183,7 @@ Sends a specified signal @var{sig} to the current process, where @end deffn system +@c snarfed from /home/ghouston/guile/guile-core/libguile/simpos.c:76 @deffn {Scheme Procedure} system [cmd] @deffnx {C Function} scm_system (cmd) Execute @var{cmd} using the operating system's "command @@ -3757,6 +4197,7 @@ indicating whether the command processor is available. @end deffn getenv +@c snarfed from /home/ghouston/guile/guile-core/libguile/simpos.c:103 @deffn {Scheme Procedure} getenv nam @deffnx {C Function} scm_getenv (nam) Looks up the string @var{name} in the current environment. The return @@ -3765,6 +4206,7 @@ found, in which case the string @code{VALUE} is returned. @end deffn primitive-exit +@c snarfed from /home/ghouston/guile/guile-core/libguile/simpos.c:118 @deffn {Scheme Procedure} primitive-exit [status] @deffnx {C Function} scm_primitive_exit (status) Terminate the current process without unwinding the Scheme stack. @@ -3773,6 +4215,7 @@ is @var{status} if supplied, otherwise zero. @end deffn restricted-vector-sort! +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:422 @deffn {Scheme Procedure} restricted-vector-sort! vec less startpos endpos @deffnx {C Function} scm_restricted_vector_sort_x (vec, less, startpos, endpos) Sort the vector @var{vec}, using @var{less} for comparing @@ -3782,6 +4225,7 @@ is not specified. @end deffn sorted? +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:453 @deffn {Scheme Procedure} sorted? items less @deffnx {C Function} scm_sorted_p (items, less) Return @code{#t} iff @var{items} is a list or a vector such that @@ -3790,6 +4234,7 @@ applied to all elements i - 1 and i @end deffn merge +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:526 @deffn {Scheme Procedure} merge alist blist less @deffnx {C Function} scm_merge (alist, blist, less) Merge two already sorted lists into one. @@ -3802,6 +4247,7 @@ Note: this does _not_ accept vectors. @end deffn merge! +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:639 @deffn {Scheme Procedure} merge! alist blist less @deffnx {C Function} scm_merge_x (alist, blist, less) Takes two lists @var{alist} and @var{blist} such that @@ -3814,6 +4260,7 @@ Note: this does _not_ accept vectors. @end deffn sort! +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:715 @deffn {Scheme Procedure} sort! items less @deffnx {C Function} scm_sort_x (items, less) Sort the sequence @var{items}, which may be a list or a @@ -3824,6 +4271,7 @@ This is not a stable sort. @end deffn sort +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:749 @deffn {Scheme Procedure} sort items less @deffnx {C Function} scm_sort (items, less) Sort the sequence @var{items}, which may be a list or a @@ -3832,6 +4280,7 @@ elements. This is not a stable sort. @end deffn stable-sort! +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:845 @deffn {Scheme Procedure} stable-sort! items less @deffnx {C Function} scm_stable_sort_x (items, less) Sort the sequence @var{items}, which may be a list or a @@ -3842,6 +4291,7 @@ This is a stable sort. @end deffn stable-sort +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:885 @deffn {Scheme Procedure} stable-sort items less @deffnx {C Function} scm_stable_sort (items, less) Sort the sequence @var{items}, which may be a list or a @@ -3850,6 +4300,7 @@ This is a stable sort. @end deffn sort-list! +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:931 @deffn {Scheme Procedure} sort-list! items less @deffnx {C Function} scm_sort_list_x (items, less) Sort the list @var{items}, using @var{less} for comparing the @@ -3859,6 +4310,7 @@ This is a stable sort. @end deffn sort-list +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:945 @deffn {Scheme Procedure} sort-list items less @deffnx {C Function} scm_sort_list (items, less) Sort the list @var{items}, using @var{less} for comparing the @@ -3866,12 +4318,14 @@ list elements. This is a stable sort. @end deffn source-properties +@c snarfed from /home/ghouston/guile/guile-core/libguile/srcprop.c:178 @deffn {Scheme Procedure} source-properties obj @deffnx {C Function} scm_source_properties (obj) Return the source property association list of @var{obj}. @end deffn set-source-properties! +@c snarfed from /home/ghouston/guile/guile-core/libguile/srcprop.c:199 @deffn {Scheme Procedure} set-source-properties! obj plist @deffnx {C Function} scm_set_source_properties_x (obj, plist) Install the association list @var{plist} as the source property @@ -3879,6 +4333,7 @@ list for @var{obj}. @end deffn source-property +@c snarfed from /home/ghouston/guile/guile-core/libguile/srcprop.c:217 @deffn {Scheme Procedure} source-property obj key @deffnx {C Function} scm_source_property (obj, key) Return the source property specified by @var{key} from @@ -3886,6 +4341,7 @@ Return the source property specified by @var{key} from @end deffn set-source-property! +@c snarfed from /home/ghouston/guile/guile-core/libguile/srcprop.c:248 @deffn {Scheme Procedure} set-source-property! obj key datum @deffnx {C Function} scm_set_source_property_x (obj, key, datum) Set the source property of object @var{obj}, which is specified by @@ -3893,12 +4349,14 @@ Set the source property of object @var{obj}, which is specified by @end deffn stack? +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:411 @deffn {Scheme Procedure} stack? obj @deffnx {C Function} scm_stack_p (obj) Return @code{#t} if @var{obj} is a calling stack. @end deffn make-stack +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:442 @deffn {Scheme Procedure} make-stack obj . args @deffnx {C Function} scm_make_stack (obj, args) Create a new stack. If @var{obj} is @code{#t}, the current @@ -3932,30 +4390,35 @@ taken as 0. @end deffn stack-id +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:534 @deffn {Scheme Procedure} stack-id stack @deffnx {C Function} scm_stack_id (stack) Return the identifier given to @var{stack} by @code{start-stack}. @end deffn stack-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:575 @deffn {Scheme Procedure} stack-ref stack index @deffnx {C Function} scm_stack_ref (stack, index) Return the @var{index}'th frame from @var{stack}. @end deffn stack-length +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:591 @deffn {Scheme Procedure} stack-length stack @deffnx {C Function} scm_stack_length (stack) Return the length of @var{stack}. @end deffn frame? +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:604 @deffn {Scheme Procedure} frame? obj @deffnx {C Function} scm_frame_p (obj) Return @code{#t} if @var{obj} is a stack frame. @end deffn last-stack-frame +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:615 @deffn {Scheme Procedure} last-stack-frame obj @deffnx {C Function} scm_last_stack_frame (obj) Return a stack which consists of a single frame, which is the @@ -3964,18 +4427,21 @@ debug object or a continuation. @end deffn frame-number +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:657 @deffn {Scheme Procedure} frame-number frame @deffnx {C Function} scm_frame_number (frame) Return the frame number of @var{frame}. @end deffn frame-source +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:667 @deffn {Scheme Procedure} frame-source frame @deffnx {C Function} scm_frame_source (frame) Return the source of @var{frame}. @end deffn frame-procedure +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:678 @deffn {Scheme Procedure} frame-procedure frame @deffnx {C Function} scm_frame_procedure (frame) Return the procedure for @var{frame}, or @code{#f} if no @@ -3983,12 +4449,14 @@ procedure is associated with @var{frame}. @end deffn frame-arguments +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:690 @deffn {Scheme Procedure} frame-arguments frame @deffnx {C Function} scm_frame_arguments (frame) Return the arguments of @var{frame}. @end deffn frame-previous +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:701 @deffn {Scheme Procedure} frame-previous frame @deffnx {C Function} scm_frame_previous (frame) Return the previous frame of @var{frame}, or @code{#f} if @@ -3996,6 +4464,7 @@ Return the previous frame of @var{frame}, or @code{#f} if @end deffn frame-next +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:717 @deffn {Scheme Procedure} frame-next frame @deffnx {C Function} scm_frame_next (frame) Return the next frame of @var{frame}, or @code{#f} if @@ -4003,30 +4472,35 @@ Return the next frame of @var{frame}, or @code{#f} if @end deffn frame-real? +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:732 @deffn {Scheme Procedure} frame-real? frame @deffnx {C Function} scm_frame_real_p (frame) Return @code{#t} if @var{frame} is a real frame. @end deffn frame-procedure? +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:742 @deffn {Scheme Procedure} frame-procedure? frame @deffnx {C Function} scm_frame_procedure_p (frame) Return @code{#t} if a procedure is associated with @var{frame}. @end deffn frame-evaluating-args? +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:752 @deffn {Scheme Procedure} frame-evaluating-args? frame @deffnx {C Function} scm_frame_evaluating_args_p (frame) Return @code{#t} if @var{frame} contains evaluated arguments. @end deffn frame-overflow? +@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:762 @deffn {Scheme Procedure} frame-overflow? frame @deffnx {C Function} scm_frame_overflow_p (frame) Return @code{#t} if @var{frame} is an overflow frame. @end deffn get-internal-real-time +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:143 @deffn {Scheme Procedure} get-internal-real-time @deffnx {C Function} scm_get_internal_real_time () Return the number of time units since the interpreter was @@ -4034,6 +4508,7 @@ started. @end deffn times +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:188 @deffn {Scheme Procedure} times @deffnx {C Function} scm_times () Return an object with information about real and processor @@ -4060,6 +4535,7 @@ terminated child processes. @end deffn get-internal-run-time +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:220 @deffn {Scheme Procedure} get-internal-run-time @deffnx {C Function} scm_get_internal_run_time () Return the number of time units of processor time used by the @@ -4068,6 +4544,7 @@ included but subprocesses are not. @end deffn current-time +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:230 @deffn {Scheme Procedure} current-time @deffnx {C Function} scm_current_time () Return the number of seconds since 1970-01-01 00:00:00 UTC, @@ -4075,6 +4552,7 @@ excluding leap seconds. @end deffn gettimeofday +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:248 @deffn {Scheme Procedure} gettimeofday @deffnx {C Function} scm_gettimeofday () Return a pair containing the number of seconds and microseconds @@ -4084,6 +4562,7 @@ operating system. @end deffn localtime +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:347 @deffn {Scheme Procedure} localtime time [zone] @deffnx {C Function} scm_localtime (time, zone) Return an object representing the broken down components of @@ -4094,6 +4573,7 @@ optionally specified by @var{zone} (a string), otherwise the @end deffn gmtime +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:420 @deffn {Scheme Procedure} gmtime time @deffnx {C Function} scm_gmtime (time) Return an object representing the broken down components of @@ -4102,6 +4582,7 @@ Return an object representing the broken down components of @end deffn mktime +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:482 @deffn {Scheme Procedure} mktime sbd_time [zone] @deffnx {C Function} scm_mktime (sbd_time, zone) @var{bd-time} is an object representing broken down time and @code{zone} @@ -4115,6 +4596,7 @@ as @var{bd-time} but with normalized values. @end deffn tzset +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:556 @deffn {Scheme Procedure} tzset @deffnx {C Function} scm_tzset () Initialize the timezone from the TZ environment variable @@ -4124,6 +4606,7 @@ timezone. @end deffn strftime +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:573 @deffn {Scheme Procedure} strftime format stime @deffnx {C Function} scm_strftime (format, stime) Formats a time specification @var{time} using @var{template}. @var{time} @@ -4136,6 +4619,7 @@ is the formatted string. @end deffn strptime +@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:670 @deffn {Scheme Procedure} strptime format string @deffnx {C Function} scm_strptime (format, string) Performs the reverse action to @code{strftime}, parsing @@ -4151,17 +4635,20 @@ which were used for the conversion. @end deffn string? +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:61 @deffn {Scheme Procedure} string? obj @deffnx {C Function} scm_string_p (obj) Return @code{#t} if @var{obj} is a string, else @code{#f}. @end deffn list->string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:69 @deffn {Scheme Procedure} list->string implemented by the C function "scm_string" @end deffn string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:75 @deffn {Scheme Procedure} string . chrs @deffnx {Scheme Procedure} list->string chrs @deffnx {C Function} scm_string (chrs) @@ -4170,6 +4657,7 @@ Return a newly allocated string composed of the arguments, @end deffn make-string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:209 @deffn {Scheme Procedure} make-string k [chr] @deffnx {C Function} scm_make_string (k, chr) Return a newly allocated string of @@ -4179,12 +4667,14 @@ of the @var{string} are unspecified. @end deffn string-length +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:242 @deffn {Scheme Procedure} string-length string @deffnx {C Function} scm_string_length (string) Return the number of characters in @var{string}. @end deffn string-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:253 @deffn {Scheme Procedure} string-ref str k @deffnx {C Function} scm_string_ref (str, k) Return character @var{k} of @var{str} using zero-origin @@ -4192,6 +4682,7 @@ indexing. @var{k} must be a valid index of @var{str}. @end deffn string-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:270 @deffn {Scheme Procedure} string-set! str k chr @deffnx {C Function} scm_string_set_x (str, k, chr) Store @var{chr} in element @var{k} of @var{str} and return @@ -4200,6 +4691,7 @@ an unspecified value. @var{k} must be a valid index of @end deffn substring +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:289 @deffn {Scheme Procedure} substring str start [end] @deffnx {C Function} scm_substring (str, start, end) Return a newly allocated string formed from the characters @@ -4212,6 +4704,7 @@ exact integers satisfying: @end deffn string-append +@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:315 @deffn {Scheme Procedure} string-append . args @deffnx {C Function} scm_string_append (args) Return a newly allocated string whose characters form the @@ -4219,6 +4712,7 @@ concatenation of the given strings, @var{args}. @end deffn string-index +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:138 @deffn {Scheme Procedure} string-index str chr [frm [to]] @deffnx {C Function} scm_string_index (str, chr, frm, to) Return the index of the first occurrence of @var{chr} in @@ -4240,6 +4734,7 @@ procedure essentially implements the @code{index} or @end deffn string-rindex +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:168 @deffn {Scheme Procedure} string-rindex str chr [frm [to]] @deffnx {C Function} scm_string_rindex (str, chr, frm, to) Like @code{string-index}, but search from the right of the @@ -4260,6 +4755,7 @@ the C library. @end deffn substring-move! +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:188 @deffn {Scheme Procedure} substring-move! str1 start1 end1 str2 start2 @deffnx {C Function} scm_substring_move_x (str1, start1, end1, str2, start2) Copy the substring of @var{str1} bounded by @var{start1} and @var{end1} @@ -4268,6 +4764,7 @@ into @var{str2} beginning at position @var{start2}. @end deffn substring-fill! +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:224 @deffn {Scheme Procedure} substring-fill! str start end fill @deffnx {C Function} scm_substring_fill_x (str, start, end, fill) Change every character in @var{str} between @var{start} and @@ -4282,6 +4779,7 @@ y @end deffn string-null? +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:249 @deffn {Scheme Procedure} string-null? str @deffnx {C Function} scm_string_null_p (str) Return @code{#t} if @var{str}'s length is zero, and @@ -4294,6 +4792,7 @@ y @result{} "foo" @end deffn string->list +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:263 @deffn {Scheme Procedure} string->list str @deffnx {C Function} scm_string_to_list (str) Return a newly allocated list of the characters that make up @@ -4303,12 +4802,14 @@ concerned. @end deffn string-copy +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:292 @deffn {Scheme Procedure} string-copy str @deffnx {C Function} scm_string_copy (str) Return a newly allocated copy of the given @var{string}. @end deffn string-fill! +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:305 @deffn {Scheme Procedure} string-fill! str chr @deffnx {C Function} scm_string_fill_x (str, chr) Store @var{char} in every element of the given @var{string} and @@ -4316,6 +4817,7 @@ return an unspecified value. @end deffn string-upcase! +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:340 @deffn {Scheme Procedure} string-upcase! str @deffnx {C Function} scm_string_upcase_x (str) Destructively upcase every character in @var{str} and return @@ -4328,6 +4830,7 @@ y @result{} "ARRDEFG" @end deffn string-upcase +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:353 @deffn {Scheme Procedure} string-upcase str @deffnx {C Function} scm_string_upcase (str) Return a freshly allocated string containing the characters of @@ -4335,6 +4838,7 @@ Return a freshly allocated string containing the characters of @end deffn string-downcase! +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:385 @deffn {Scheme Procedure} string-downcase! str @deffnx {C Function} scm_string_downcase_x (str) Destructively downcase every character in @var{str} and return @@ -4347,6 +4851,7 @@ y @result{} "arrdefg" @end deffn string-downcase +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:398 @deffn {Scheme Procedure} string-downcase str @deffnx {C Function} scm_string_downcase (str) Return a freshly allocation string containing the characters in @@ -4354,6 +4859,7 @@ Return a freshly allocation string containing the characters in @end deffn string-capitalize! +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:443 @deffn {Scheme Procedure} string-capitalize! str @deffnx {C Function} scm_string_capitalize_x (str) Upcase the first character of every word in @var{str} @@ -4367,6 +4873,7 @@ y @result{} "Hello World" @end deffn string-capitalize +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:457 @deffn {Scheme Procedure} string-capitalize str @deffnx {C Function} scm_string_capitalize (str) Return a freshly allocated string with the characters in @@ -4375,6 +4882,7 @@ capitalized. @end deffn string-split +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:486 @deffn {Scheme Procedure} string-split str chr @deffnx {C Function} scm_string_split (str, chr) Split the string @var{str} into the a list of the substrings delimited @@ -4398,6 +4906,7 @@ result list. @end deffn string-ci->symbol +@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:521 @deffn {Scheme Procedure} string-ci->symbol str @deffnx {C Function} scm_string_ci_to_symbol (str) Return the symbol whose name is @var{str}. @var{str} is @@ -4406,6 +4915,7 @@ is currently reading symbols case-insensitively. @end deffn string=? +@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:62 @deffn {Scheme Procedure} string=? s1 s2 Lexicographic equality predicate; return @code{#t} if the two strings are the same length and contain the same characters in @@ -4418,6 +4928,7 @@ characters. @end deffn string-ci=? +@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:97 @deffn {Scheme Procedure} string-ci=? s1 s2 Case-insensitive string equality predicate; return @code{#t} if the two strings are the same length and their component @@ -4426,30 +4937,35 @@ return @code{#f}. @end deffn string? +@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:182 @deffn {Scheme Procedure} string>? s1 s2 Lexicographic ordering predicate; return @code{#t} if @var{s1} is lexicographically greater than @var{s2}. @end deffn string>=? +@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:196 @deffn {Scheme Procedure} string>=? s1 s2 Lexicographic ordering predicate; return @code{#t} if @var{s1} is lexicographically greater than or equal to @var{s2}. @end deffn string-ci? +@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:265 @deffn {Scheme Procedure} string-ci>? s1 s2 Case insensitive lexicographic ordering predicate; return @code{#t} if @var{s1} is lexicographically greater than @@ -4471,6 +4989,7 @@ Case insensitive lexicographic ordering predicate; return @end deffn string-ci>=? +@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:280 @deffn {Scheme Procedure} string-ci>=? s1 s2 Case insensitive lexicographic ordering predicate; return @code{#t} if @var{s1} is lexicographically greater than or @@ -4478,6 +4997,7 @@ equal to @var{s2} regardless of case. @end deffn object->string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:321 @deffn {Scheme Procedure} object->string obj [printer] @deffnx {C Function} scm_object_to_string (obj, printer) Return a Scheme string obtained by printing @var{obj}. @@ -4486,6 +5006,7 @@ argument @var{printer} (default: @code{write}). @end deffn call-with-output-string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:345 @deffn {Scheme Procedure} call-with-output-string proc @deffnx {C Function} scm_call_with_output_string (proc) Calls the one-argument procedure @var{proc} with a newly created output @@ -4494,6 +5015,7 @@ written into the port is returned. @end deffn call-with-input-string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:364 @deffn {Scheme Procedure} call-with-input-string string proc @deffnx {C Function} scm_call_with_input_string (string, proc) Calls the one-argument procedure @var{proc} with a newly @@ -4502,6 +5024,7 @@ read. The value yielded by the @var{proc} is returned. @end deffn open-input-string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:377 @deffn {Scheme Procedure} open-input-string str @deffnx {C Function} scm_open_input_string (str) Take a string and return an input port that delivers characters @@ -4511,6 +5034,7 @@ by the garbage collector if it becomes inaccessible. @end deffn open-output-string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:391 @deffn {Scheme Procedure} open-output-string @deffnx {C Function} scm_open_output_string () Return an output port that will accumulate characters for @@ -4521,6 +5045,7 @@ inaccessible. @end deffn get-output-string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:408 @deffn {Scheme Procedure} get-output-string port @deffnx {C Function} scm_get_output_string (port) Given an output port created by @code{open-output-string}, @@ -4529,6 +5054,7 @@ output to the port so far. @end deffn eval-string +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:467 @deffn {Scheme Procedure} eval-string string @deffnx {C Function} scm_eval_string (string) Evaluate @var{string} as the text representation of a Scheme @@ -4538,6 +5064,7 @@ procedure @code{interaction-environment}. @end deffn make-struct-layout +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:77 @deffn {Scheme Procedure} make-struct-layout fields @deffnx {C Function} scm_make_struct_layout (fields) Return a new structure layout object. @@ -4553,6 +5080,7 @@ indicate that the field is a tail-array. @end deffn struct? +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:244 @deffn {Scheme Procedure} struct? x @deffnx {C Function} scm_struct_p (x) Return @code{#t} iff @var{x} is a structure object, else @@ -4560,12 +5088,14 @@ Return @code{#t} iff @var{x} is a structure object, else @end deffn struct-vtable? +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:253 @deffn {Scheme Procedure} struct-vtable? x @deffnx {C Function} scm_struct_vtable_p (x) Return @code{#t} iff @var{x} is a vtable structure. @end deffn make-struct +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:434 @deffn {Scheme Procedure} make-struct vtable tail_array_size . init @deffnx {C Function} scm_make_struct (vtable, tail_array_size, init) Create a new structure. @@ -4596,6 +5126,7 @@ For more information, see the documentation for @code{make-vtable-vtable}. @end deffn make-vtable-vtable +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:519 @deffn {Scheme Procedure} make-vtable-vtable user_fields tail_array_size . init @deffnx {C Function} scm_make_vtable_vtable (user_fields, tail_array_size, init) Return a new, self-describing vtable structure. @@ -4657,6 +5188,7 @@ ball @result{} # @end deffn struct-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:560 @deffn {Scheme Procedure} struct-ref handle pos @deffnx {Scheme Procedure} struct-set! struct n value @deffnx {C Function} scm_struct_ref (handle, pos) @@ -4669,6 +5201,7 @@ integer value small enough to fit in one machine word. @end deffn struct-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:638 @deffn {Scheme Procedure} struct-set! handle pos val @deffnx {C Function} scm_struct_set_x (handle, pos, val) Set the slot of the structure @var{handle} with index @var{pos} @@ -4677,30 +5210,35 @@ to. @end deffn struct-vtable +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:708 @deffn {Scheme Procedure} struct-vtable handle @deffnx {C Function} scm_struct_vtable (handle) Return the vtable structure that describes the type of @var{struct}. @end deffn struct-vtable-tag +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:719 @deffn {Scheme Procedure} struct-vtable-tag handle @deffnx {C Function} scm_struct_vtable_tag (handle) Return the vtable tag of the structure @var{handle}. @end deffn struct-vtable-name +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:758 @deffn {Scheme Procedure} struct-vtable-name vtable @deffnx {C Function} scm_struct_vtable_name (vtable) Return the name of the vtable @var{vtable}. @end deffn set-struct-vtable-name! +@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:768 @deffn {Scheme Procedure} set-struct-vtable-name! vtable name @deffnx {C Function} scm_set_struct_vtable_name_x (vtable, name) Set the name of the vtable @var{vtable} to @var{name}. @end deffn symbol? +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:164 @deffn {Scheme Procedure} symbol? obj @deffnx {C Function} scm_symbol_p (obj) Return @code{#t} if @var{obj} is a symbol, otherwise return @@ -4708,6 +5246,7 @@ Return @code{#t} if @var{obj} is a symbol, otherwise return @end deffn symbol-interned? +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:174 @deffn {Scheme Procedure} symbol-interned? symbol @deffnx {C Function} scm_symbol_interned_p (symbol) Return @code{#t} if @var{symbol} is interned, otherwise return @@ -4715,12 +5254,14 @@ Return @code{#t} if @var{symbol} is interned, otherwise return @end deffn make-symbol +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:186 @deffn {Scheme Procedure} make-symbol name @deffnx {C Function} scm_make_symbol (name) Return a new uninterned symbol with the name @var{name}. The returned symbol is guaranteed to be unique and future calls to @code{string->symbol} will not return it. @end deffn symbol->string +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:222 @deffn {Scheme Procedure} symbol->string s @deffnx {C Function} scm_symbol_to_string (s) Return the name of @var{symbol} as a string. If the symbol was @@ -4749,6 +5290,7 @@ standard case is lower case: @end deffn string->symbol +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:255 @deffn {Scheme Procedure} string->symbol string @deffnx {C Function} scm_string_to_symbol (string) Return the symbol whose name is @var{string}. This procedure @@ -4774,6 +5316,7 @@ standard case is lower case: @end deffn gensym +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:277 @deffn {Scheme Procedure} gensym [prefix] @deffnx {C Function} scm_gensym (prefix) Create a new symbol with a name constructed from a prefix and @@ -4784,36 +5327,42 @@ resetting the counter. @end deffn symbol-hash +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:309 @deffn {Scheme Procedure} symbol-hash symbol @deffnx {C Function} scm_symbol_hash (symbol) Return a hash value for @var{symbol}. @end deffn symbol-fref +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:319 @deffn {Scheme Procedure} symbol-fref s @deffnx {C Function} scm_symbol_fref (s) Return the contents of @var{symbol}'s @dfn{function slot}. @end deffn symbol-pref +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:330 @deffn {Scheme Procedure} symbol-pref s @deffnx {C Function} scm_symbol_pref (s) Return the @dfn{property list} currently associated with @var{symbol}. @end deffn symbol-fset! +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:341 @deffn {Scheme Procedure} symbol-fset! s val @deffnx {C Function} scm_symbol_fset_x (s, val) Change the binding of @var{symbol}'s function slot. @end deffn symbol-pset! +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:353 @deffn {Scheme Procedure} symbol-pset! s val @deffnx {C Function} scm_symbol_pset_x (s, val) Change the binding of @var{symbol}'s property slot. @end deffn catch +@c snarfed from /home/ghouston/guile/guile-core/libguile/throw.c:534 @deffn {Scheme Procedure} catch key thunk handler @deffnx {C Function} scm_catch (key, thunk, handler) Invoke @var{thunk} in the dynamic context of @var{handler} for @@ -4837,6 +5386,7 @@ match this call to @code{catch}. @end deffn lazy-catch +@c snarfed from /home/ghouston/guile/guile-core/libguile/throw.c:562 @deffn {Scheme Procedure} lazy-catch key thunk handler @deffnx {C Function} scm_lazy_catch (key, thunk, handler) This behaves exactly like @code{catch}, except that it does @@ -4846,6 +5396,7 @@ it must throw to another catch, or otherwise exit non-locally. @end deffn throw +@c snarfed from /home/ghouston/guile/guile-core/libguile/throw.c:595 @deffn {Scheme Procedure} throw key . args @deffnx {C Function} scm_throw (key, args) Invoke the catch form matching @var{key}, passing @var{args} to the @@ -4858,6 +5409,7 @@ If there is no handler at all, Guile prints an error and then exits. @end deffn values +@c snarfed from /home/ghouston/guile/guile-core/libguile/values.c:77 @deffn {Scheme Procedure} values . args @deffnx {C Function} scm_values (args) Delivers all of its arguments to its continuation. Except for @@ -4868,18 +5420,21 @@ were not created by @code{call-with-values} is unspecified. @end deffn make-variable +@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:76 @deffn {Scheme Procedure} make-variable init @deffnx {C Function} scm_make_variable (init) Return a variable initialized to value @var{init}. @end deffn make-undefined-variable +@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:86 @deffn {Scheme Procedure} make-undefined-variable @deffnx {C Function} scm_make_undefined_variable () Return a variable that is initially unbound. @end deffn variable? +@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:97 @deffn {Scheme Procedure} variable? obj @deffnx {C Function} scm_variable_p (obj) Return @code{#t} iff @var{obj} is a variable object, else @@ -4887,6 +5442,7 @@ return @code{#f}. @end deffn variable-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:109 @deffn {Scheme Procedure} variable-ref var @deffnx {C Function} scm_variable_ref (var) Dereference @var{var} and return its value. @@ -4895,6 +5451,7 @@ and @code{make-undefined-variable}. @end deffn variable-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:125 @deffn {Scheme Procedure} variable-set! var val @deffnx {C Function} scm_variable_set_x (var, val) Set the value of the variable @var{var} to @var{val}. @@ -4903,6 +5460,7 @@ value. Return an unspecified value. @end deffn variable-bound? +@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:137 @deffn {Scheme Procedure} variable-bound? var @deffnx {C Function} scm_variable_bound_p (var) Return @code{#t} iff @var{var} is bound to a value. @@ -4910,6 +5468,7 @@ Throws an error if @var{var} is not a variable object. @end deffn vector? +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:59 @deffn {Scheme Procedure} vector? obj @deffnx {C Function} scm_vector_p (obj) Return @code{#t} if @var{obj} is a vector, otherwise return @@ -4917,11 +5476,13 @@ Return @code{#t} if @var{obj} is a vector, otherwise return @end deffn list->vector +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:76 @deffn {Scheme Procedure} list->vector implemented by the C function "scm_vector" @end deffn vector +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:93 @deffn {Scheme Procedure} vector . l @deffnx {Scheme Procedure} list->vector l @deffnx {C Function} scm_vector (l) @@ -4934,6 +5495,7 @@ given arguments. Analogous to @code{list}. @end deffn make-vector +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:179 @deffn {Scheme Procedure} make-vector k [fill] @deffnx {C Function} scm_make_vector (k, fill) Return a newly allocated vector of @var{k} elements. If a @@ -4943,6 +5505,7 @@ unspecified. @end deffn vector->list +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:233 @deffn {Scheme Procedure} vector->list v @deffnx {C Function} scm_vector_to_list (v) Return a newly allocated list composed of the elements of @var{v}. @@ -4954,6 +5517,7 @@ Return a newly allocated list composed of the elements of @var{v}. @end deffn vector-fill! +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:250 @deffn {Scheme Procedure} vector-fill! v fill @deffnx {C Function} scm_vector_fill_x (v, fill) Store @var{fill} in every position of @var{vector}. The value @@ -4961,6 +5525,7 @@ returned by @code{vector-fill!} is unspecified. @end deffn vector-move-left! +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:283 @deffn {Scheme Procedure} vector-move-left! vec1 start1 end1 vec2 start2 @deffnx {C Function} scm_vector_move_left_x (vec1, start1, end1, vec2, start2) Copy elements from @var{vec1}, positions @var{start1} to @var{end1}, @@ -4974,6 +5539,7 @@ same vector, @code{vector-move-left!} is usually appropriate when @end deffn vector-move-right! +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:312 @deffn {Scheme Procedure} vector-move-right! vec1 start1 end1 vec2 start2 @deffnx {C Function} scm_vector_move_right_x (vec1, start1, end1, vec2, start2) Copy elements from @var{vec1}, positions @var{start1} to @var{end1}, @@ -4987,6 +5553,7 @@ same vector, @code{vector-move-right!} is usually appropriate when @end deffn major-version +@c snarfed from /home/ghouston/guile/guile-core/libguile/version.c:59 @deffn {Scheme Procedure} major-version @deffnx {C Function} scm_major_version () Return a string containing Guile's major version number. @@ -4994,6 +5561,7 @@ E.g., the 1 in "1.6.5". @end deffn minor-version +@c snarfed from /home/ghouston/guile/guile-core/libguile/version.c:72 @deffn {Scheme Procedure} minor-version @deffnx {C Function} scm_minor_version () Return a string containing Guile's minor version number. @@ -5001,6 +5569,7 @@ E.g., the 6 in "1.6.5". @end deffn micro-version +@c snarfed from /home/ghouston/guile/guile-core/libguile/version.c:85 @deffn {Scheme Procedure} micro-version @deffnx {C Function} scm_micro_version () Return a string containing Guile's micro version number. @@ -5008,6 +5577,7 @@ E.g., the 5 in "1.6.5". @end deffn version +@c snarfed from /home/ghouston/guile/guile-core/libguile/version.c:107 @deffn {Scheme Procedure} version @deffnx {Scheme Procedure} major-version @deffnx {Scheme Procedure} minor-version @@ -5025,6 +5595,7 @@ or micro version number, respectively. @end deffn make-soft-port +@c snarfed from /home/ghouston/guile/guile-core/libguile/vports.c:185 @deffn {Scheme Procedure} make-soft-port pv modes @deffnx {C Function} scm_make_soft_port (pv, modes) Return a port capable of receiving or delivering characters as @@ -5071,6 +5642,7 @@ For example: @end deffn make-weak-vector +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:116 @deffn {Scheme Procedure} make-weak-vector size [fill] @deffnx {C Function} scm_make_weak_vector (size, fill) Return a weak vector with @var{size} elements. If the optional @@ -5080,11 +5652,13 @@ empty list. @end deffn list->weak-vector +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:124 @deffn {Scheme Procedure} list->weak-vector implemented by the C function "scm_weak_vector" @end deffn weak-vector +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:132 @deffn {Scheme Procedure} weak-vector . l @deffnx {Scheme Procedure} list->weak-vector l @deffnx {C Function} scm_weak_vector (l) @@ -5095,6 +5669,7 @@ the same way @code{list->vector} would. @end deffn weak-vector? +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:160 @deffn {Scheme Procedure} weak-vector? obj @deffnx {C Function} scm_weak_vector_p (obj) Return @code{#t} if @var{obj} is a weak vector. Note that all @@ -5102,6 +5677,7 @@ weak hashes are also weak vectors. @end deffn make-weak-key-hash-table +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:178 @deffn {Scheme Procedure} make-weak-key-hash-table size @deffnx {Scheme Procedure} make-weak-value-hash-table size @deffnx {Scheme Procedure} make-doubly-weak-hash-table size @@ -5115,6 +5691,7 @@ would modify regular hash tables. (@pxref{Hash Tables}) @end deffn make-weak-value-hash-table +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:189 @deffn {Scheme Procedure} make-weak-value-hash-table size @deffnx {C Function} scm_make_weak_value_hash_table (size) Return a hash table with weak values with @var{size} buckets. @@ -5122,6 +5699,7 @@ Return a hash table with weak values with @var{size} buckets. @end deffn make-doubly-weak-hash-table +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:200 @deffn {Scheme Procedure} make-doubly-weak-hash-table size @deffnx {C Function} scm_make_doubly_weak_hash_table (size) Return a hash table with weak keys and values with @var{size} @@ -5129,6 +5707,7 @@ buckets. (@pxref{Hash Tables}) @end deffn weak-key-hash-table? +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:214 @deffn {Scheme Procedure} weak-key-hash-table? obj @deffnx {Scheme Procedure} weak-value-hash-table? obj @deffnx {Scheme Procedure} doubly-weak-hash-table? obj @@ -5139,91 +5718,21 @@ nor a weak value hash table. @end deffn weak-value-hash-table? +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:224 @deffn {Scheme Procedure} weak-value-hash-table? obj @deffnx {C Function} scm_weak_value_hash_table_p (obj) Return @code{#t} if @var{obj} is a weak value hash table. @end deffn doubly-weak-hash-table? +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:234 @deffn {Scheme Procedure} doubly-weak-hash-table? obj @deffnx {C Function} scm_doubly_weak_hash_table_p (obj) Return @code{#t} if @var{obj} is a doubly weak hash table. @end deffn - regexp? -@deffn {Scheme Procedure} regexp? obj -@deffnx {C Function} scm_regexp_p (obj) -Return @code{#t} if @var{obj} is a compiled regular expression, -or @code{#f} otherwise. -@end deffn - - make-regexp -@deffn {Scheme Procedure} make-regexp pat . flags -@deffnx {C Function} scm_make_regexp (pat, flags) -Compile the regular expression described by @var{pat}, and -return the compiled regexp structure. If @var{pat} does not -describe a legal regular expression, @code{make-regexp} throws -a @code{regular-expression-syntax} error. - -The @var{flags} arguments change the behavior of the compiled -regular expression. The following flags may be supplied: - -@table @code -@item regexp/icase -Consider uppercase and lowercase letters to be the same when -matching. -@item regexp/newline -If a newline appears in the target string, then permit the -@samp{^} and @samp{$} operators to match immediately after or -immediately before the newline, respectively. Also, the -@samp{.} and @samp{[^...]} operators will never match a newline -character. The intent of this flag is to treat the target -string as a buffer containing many lines of text, and the -regular expression as a pattern that may match a single one of -those lines. -@item regexp/basic -Compile a basic (``obsolete'') regexp instead of the extended -(``modern'') regexps that are the default. Basic regexps do -not consider @samp{|}, @samp{+} or @samp{?} to be special -characters, and require the @samp{@{...@}} and @samp{(...)} -metacharacters to be backslash-escaped (@pxref{Backslash -Escapes}). There are several other differences between basic -and extended regular expressions, but these are the most -significant. -@item regexp/extended -Compile an extended regular expression rather than a basic -regexp. This is the default behavior; this flag will not -usually be needed. If a call to @code{make-regexp} includes -both @code{regexp/basic} and @code{regexp/extended} flags, the -one which comes last will override the earlier one. -@end table -@end deffn - - regexp-exec -@deffn {Scheme Procedure} regexp-exec rx str [start [flags]] -@deffnx {C Function} scm_regexp_exec (rx, str, start, flags) -Match the compiled regular expression @var{rx} against -@code{str}. If the optional integer @var{start} argument is -provided, begin matching from that position in the string. -Return a match structure describing the results of the match, -or @code{#f} if no match could be found. - -The @var{flags} arguments change the matching behavior. -The following flags may be supplied: - -@table @code -@item regexp/notbol -Operator @samp{^} always fails (unless @code{regexp/newline} -is used). Use this when the beginning of the string should -not be considered the beginning of a line. -@item regexp/noteol -Operator @samp{$} always fails (unless @code{regexp/newline} -is used). Use this when the end of the string should not be -considered the end of a line. -@end table -@end deffn - array-fill! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:462 @deffn {Scheme Procedure} array-fill! ra fill @deffnx {C Function} scm_array_fill_x (ra, fill) Store @var{fill} in every element of @var{array}. The value returned @@ -5231,11 +5740,13 @@ is unspecified. @end deffn array-copy-in-order! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:827 @deffn {Scheme Procedure} array-copy-in-order! implemented by the C function "scm_array_copy_x" @end deffn array-copy! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:836 @deffn {Scheme Procedure} array-copy! src dst @deffnx {Scheme Procedure} array-copy-in-order! src dst @deffnx {C Function} scm_array_copy_x (src, dst) @@ -5246,11 +5757,13 @@ dimension. The order is unspecified. @end deffn array-map-in-order! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1510 @deffn {Scheme Procedure} array-map-in-order! implemented by the C function "scm_array_map_x" @end deffn array-map! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1521 @deffn {Scheme Procedure} array-map! ra0 proc . lra @deffnx {Scheme Procedure} array-map-in-order! ra0 proc . lra @deffnx {C Function} scm_array_map_x (ra0, proc, lra) @@ -5263,6 +5776,7 @@ unspecified. The order of application is unspecified. @end deffn array-for-each +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1668 @deffn {Scheme Procedure} array-for-each proc ra0 . lra @deffnx {C Function} scm_array_for_each (proc, ra0, lra) Apply @var{proc} to each tuple of elements of @var{array0} @dots{} @@ -5270,6 +5784,7 @@ in row-major order. The value returned is unspecified. @end deffn array-index-map! +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1696 @deffn {Scheme Procedure} array-index-map! ra proc @deffnx {C Function} scm_array_index_map_x (ra, proc) Apply @var{proc} to the indices of each element of @var{array} in @@ -5293,12 +5808,14 @@ Another example: @end deffn uniform-vector-length +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:250 @deffn {Scheme Procedure} uniform-vector-length v @deffnx {C Function} scm_uniform_vector_length (v) Return the number of elements in @var{uve}. @end deffn array? +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:284 @deffn {Scheme Procedure} array? v [prot] @deffnx {C Function} scm_array_p (v, prot) Return @code{#t} if the @var{obj} is an array, and @code{#f} if @@ -5307,6 +5824,7 @@ and is described elsewhere. @end deffn array-rank +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:355 @deffn {Scheme Procedure} array-rank ra @deffnx {C Function} scm_array_rank (ra) Return the number of dimensions of @var{obj}. If @var{obj} is @@ -5314,6 +5832,7 @@ not an array, @code{0} is returned. @end deffn array-dimensions +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:393 @deffn {Scheme Procedure} array-dimensions ra @deffnx {C Function} scm_array_dimensions (ra) @code{Array-dimensions} is similar to @code{array-shape} but replaces @@ -5324,24 +5843,28 @@ elements with a @code{0} minimum with one greater than the maximum. So: @end deffn shared-array-root +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:440 @deffn {Scheme Procedure} shared-array-root ra @deffnx {C Function} scm_shared_array_root (ra) Return the root vector of a shared array. @end deffn shared-array-offset +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:451 @deffn {Scheme Procedure} shared-array-offset ra @deffnx {C Function} scm_shared_array_offset (ra) Return the root vector index of the first element in the array. @end deffn shared-array-increments +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:462 @deffn {Scheme Procedure} shared-array-increments ra @deffnx {C Function} scm_shared_array_increments (ra) For each dimension, return the distance between elements in the root vector. @end deffn dimensions->uniform-array +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:581 @deffn {Scheme Procedure} dimensions->uniform-array dims prot [fill] @deffnx {Scheme Procedure} make-uniform-vector length prototype [fill] @deffnx {C Function} scm_dimensions_to_uniform_array (dims, prot, fill) @@ -5352,6 +5875,7 @@ fill the array, otherwise @var{prototype} is used. @end deffn make-shared-array +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:670 @deffn {Scheme Procedure} make-shared-array oldra mapfunc . dims @deffnx {C Function} scm_make_shared_array (oldra, mapfunc, dims) @code{make-shared-array} can be used to create shared subarrays of other @@ -5372,6 +5896,7 @@ it can be otherwise arbitrary. A simple example: @end deffn transpose-array +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:802 @deffn {Scheme Procedure} transpose-array ra . args @deffnx {C Function} scm_transpose_array (ra, args) Return an array sharing contents with @var{array}, but with @@ -5396,6 +5921,7 @@ have smaller rank than @var{array}. @end deffn enclose-array +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:911 @deffn {Scheme Procedure} enclose-array ra . axes @deffnx {C Function} scm_enclose_array (ra, axes) @var{dim0}, @var{dim1} @dots{} should be nonnegative integers less than @@ -5422,6 +5948,7 @@ examples: @end deffn array-in-bounds? +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:995 @deffn {Scheme Procedure} array-in-bounds? v . args @deffnx {C Function} scm_array_in_bounds_p (v, args) Return @code{#t} if its arguments would be acceptable to @@ -5429,11 +5956,13 @@ Return @code{#t} if its arguments would be acceptable to @end deffn array-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1074 @deffn {Scheme Procedure} array-ref implemented by the C function "scm_uniform_vector_ref" @end deffn uniform-vector-ref +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1081 @deffn {Scheme Procedure} uniform-vector-ref v args @deffnx {Scheme Procedure} array-ref v . args @deffnx {C Function} scm_uniform_vector_ref (v, args) @@ -5442,11 +5971,13 @@ Return the element at the @code{(index1, index2)} element in @end deffn uniform-array-set1! +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1250 @deffn {Scheme Procedure} uniform-array-set1! implemented by the C function "scm_array_set_x" @end deffn array-set! +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1259 @deffn {Scheme Procedure} array-set! v obj . args @deffnx {Scheme Procedure} uniform-array-set1! v obj args @deffnx {C Function} scm_array_set_x (v, obj, args) @@ -5455,6 +5986,7 @@ Set the element at the @code{(index1, index2)} element in @var{array} to @end deffn array-contents +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1374 @deffn {Scheme Procedure} array-contents ra [strict] @deffnx {C Function} scm_array_contents (ra, strict) If @var{array} may be @dfn{unrolled} into a one dimensional shared array @@ -5470,6 +6002,7 @@ memory. @end deffn uniform-array-read! +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1488 @deffn {Scheme Procedure} uniform-array-read! ra [port_or_fd [start [end]]] @deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] [start] [end] @deffnx {C Function} scm_uniform_array_read_x (ra, port_or_fd, start, end) @@ -5490,6 +6023,7 @@ returned by @code{(current-input-port)}. @end deffn uniform-array-write +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1653 @deffn {Scheme Procedure} uniform-array-write v [port_or_fd [start [end]]] @deffnx {Scheme Procedure} uniform-vector-write uve [port-or-fdes] [start] [end] @deffnx {C Function} scm_uniform_array_write (v, port_or_fd, start, end) @@ -5507,6 +6041,7 @@ omitted, in which case it defaults to the value returned by @end deffn bit-count +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1780 @deffn {Scheme Procedure} bit-count b bitvector @deffnx {C Function} scm_bit_count (b, bitvector) Return the number of occurrences of the boolean @var{b} in @@ -5514,6 +6049,7 @@ Return the number of occurrences of the boolean @var{b} in @end deffn bit-position +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1819 @deffn {Scheme Procedure} bit-position item v k @deffnx {C Function} scm_bit_position (item, v, k) Return the minimum index of an occurrence of @var{bool} in @@ -5522,6 +6058,7 @@ within the specified range @code{#f} is returned. @end deffn bit-set*! +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1887 @deffn {Scheme Procedure} bit-set*! v kv obj @deffnx {C Function} scm_bit_set_star_x (v, kv, obj) If uve is a bit-vector @var{bv} and uve must be of the same @@ -5536,6 +6073,7 @@ of @var{bv} corresponding to the indexes in uve are set to @end deffn bit-count* +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1941 @deffn {Scheme Procedure} bit-count* v kv obj @deffnx {C Function} scm_bit_count_star (v, kv, obj) Return @@ -5546,12 +6084,14 @@ Return @end deffn bit-invert! +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2005 @deffn {Scheme Procedure} bit-invert! v @deffnx {C Function} scm_bit_invert_x (v) Modify @var{bv} by replacing each element with its negation. @end deffn array->list +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2084 @deffn {Scheme Procedure} array->list v @deffnx {C Function} scm_array_to_list (v) Return a list consisting of all the elements, in order, of @@ -5559,6 +6099,7 @@ Return a list consisting of all the elements, in order, of @end deffn list->uniform-array +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2185 @deffn {Scheme Procedure} list->uniform-array ndim prot lst @deffnx {Scheme Procedure} list->uniform-vector prot lst @deffnx {C Function} scm_list_to_uniform_array (ndim, prot, lst) @@ -5569,6 +6110,7 @@ done. @end deffn array-prototype +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2536 @deffn {Scheme Procedure} array-prototype ra @deffnx {C Function} scm_array_prototype (ra) Return an object that would produce an array of the same type @@ -5577,6 +6119,7 @@ as @var{array}, if used as the @var{prototype} for @end deffn chown +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:214 @deffn {Scheme Procedure} chown object owner group @deffnx {C Function} scm_chown (object, owner, group) Change the ownership and group of the file referred to by @var{object} to @@ -5594,6 +6137,7 @@ as @code{-1}, then that ID is not changed. @end deffn chmod +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:254 @deffn {Scheme Procedure} chmod object mode @deffnx {C Function} scm_chmod (object, mode) Changes the permissions of the file referred to by @var{obj}. @@ -5606,6 +6150,7 @@ The return value is unspecified. @end deffn umask +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:287 @deffn {Scheme Procedure} umask [mode] @deffnx {C Function} scm_umask (mode) If @var{mode} is omitted, returns a decimal number representing the current @@ -5616,6 +6161,7 @@ E.g., @code{(umask #o022)} sets the mask to octal 22, decimal 18. @end deffn open-fdes +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:310 @deffn {Scheme Procedure} open-fdes path flags [mode] @deffnx {C Function} scm_open_fdes (path, flags, mode) Similar to @code{open} but return a file descriptor instead of @@ -5623,6 +6169,7 @@ a port. @end deffn open +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:352 @deffn {Scheme Procedure} open path flags [mode] @deffnx {C Function} scm_open (path, flags, mode) Open the file named by @var{path} for reading and/or writing. @@ -5655,6 +6202,7 @@ for additional flags. @end deffn close +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:390 @deffn {Scheme Procedure} close fd_or_port @deffnx {C Function} scm_close (fd_or_port) Similar to close-port (@pxref{Closing, close-port}), @@ -5665,6 +6213,7 @@ their revealed counts set to zero. @end deffn close-fdes +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:418 @deffn {Scheme Procedure} close-fdes fd @deffnx {C Function} scm_close_fdes (fd) A simple wrapper for the @code{close} system call. @@ -5675,6 +6224,7 @@ The return value is unspecified. @end deffn stat +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:621 @deffn {Scheme Procedure} stat object @deffnx {C Function} scm_stat (object) Return an object containing various information about the file @@ -5736,6 +6286,7 @@ An integer representing the access permission bits. @end deffn link +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:684 @deffn {Scheme Procedure} link oldpath newpath @deffnx {C Function} scm_link (oldpath, newpath) Creates a new name @var{newpath} in the file system for the @@ -5745,6 +6296,7 @@ system. @end deffn rename-file +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:705 @deffn {Scheme Procedure} rename-file oldname newname @deffnx {C Function} scm_rename (oldname, newname) Renames the file specified by @var{oldname} to @var{newname}. @@ -5752,12 +6304,14 @@ The return value is unspecified. @end deffn delete-file +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:732 @deffn {Scheme Procedure} delete-file str @deffnx {C Function} scm_delete_file (str) Deletes (or "unlinks") the file specified by @var{path}. @end deffn mkdir +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:750 @deffn {Scheme Procedure} mkdir path [mode] @deffnx {C Function} scm_mkdir (path, mode) Create a new directory named by @var{path}. If @var{mode} is omitted @@ -5767,6 +6321,7 @@ umask. Otherwise they are set to the decimal value specified with @end deffn rmdir +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:778 @deffn {Scheme Procedure} rmdir path @deffnx {C Function} scm_rmdir (path) Remove the existing directory named by @var{path}. The directory must @@ -5774,6 +6329,7 @@ be empty for this to succeed. The return value is unspecified. @end deffn directory-stream? +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:803 @deffn {Scheme Procedure} directory-stream? obj @deffnx {C Function} scm_directory_stream_p (obj) Return a boolean indicating whether @var{object} is a directory @@ -5781,6 +6337,7 @@ stream as returned by @code{opendir}. @end deffn opendir +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:814 @deffn {Scheme Procedure} opendir dirname @deffnx {C Function} scm_opendir (dirname) Open the directory specified by @var{path} and return a directory @@ -5788,6 +6345,7 @@ stream. @end deffn readdir +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:831 @deffn {Scheme Procedure} readdir port @deffnx {C Function} scm_readdir (port) Return (as a string) the next directory entry from the directory stream @@ -5796,6 +6354,7 @@ end of file object is returned. @end deffn rewinddir +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:854 @deffn {Scheme Procedure} rewinddir port @deffnx {C Function} scm_rewinddir (port) Reset the directory port @var{stream} so that the next call to @@ -5803,6 +6362,7 @@ Reset the directory port @var{stream} so that the next call to @end deffn closedir +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:871 @deffn {Scheme Procedure} closedir port @deffnx {C Function} scm_closedir (port) Close the directory stream @var{stream}. @@ -5810,6 +6370,7 @@ The return value is unspecified. @end deffn chdir +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:921 @deffn {Scheme Procedure} chdir str @deffnx {C Function} scm_chdir (str) Change the current working directory to @var{path}. @@ -5817,12 +6378,14 @@ The return value is unspecified. @end deffn getcwd +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:937 @deffn {Scheme Procedure} getcwd @deffnx {C Function} scm_getcwd () Return the name of the current working directory. @end deffn select +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1133 @deffn {Scheme Procedure} select reads writes excepts [secs [usecs]] @deffnx {C Function} scm_select (reads, writes, excepts, secs, usecs) This procedure has a variety of uses: waiting for the ability @@ -5857,6 +6420,7 @@ An additional @code{select!} interface is provided. @end deffn fcntl +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1279 @deffn {Scheme Procedure} fcntl object cmd [value] @deffnx {C Function} scm_fcntl (object, cmd, value) Apply @var{command} to the specified file descriptor or the underlying @@ -5887,6 +6451,7 @@ The value used to indicate the "close on exec" flag with @code{F_GETFL} or @end deffn fsync +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1316 @deffn {Scheme Procedure} fsync object @deffnx {C Function} scm_fsync (object) Copies any unwritten data for the specified output file descriptor to disk. @@ -5896,6 +6461,7 @@ The return value is unspecified. @end deffn symlink +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1343 @deffn {Scheme Procedure} symlink oldpath newpath @deffnx {C Function} scm_symlink (oldpath, newpath) Create a symbolic link named @var{path-to} with the value (i.e., pointing to) @@ -5903,6 +6469,7 @@ Create a symbolic link named @var{path-to} with the value (i.e., pointing to) @end deffn readlink +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1362 @deffn {Scheme Procedure} readlink path @deffnx {C Function} scm_readlink (path) Return the value of the symbolic link named by @var{path} (a @@ -5910,6 +6477,7 @@ string), i.e., the file that the link points to. @end deffn lstat +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1391 @deffn {Scheme Procedure} lstat str @deffnx {C Function} scm_lstat (str) Similar to @code{stat}, but does not follow symbolic links, i.e., @@ -5918,6 +6486,7 @@ file it points to. @var{path} must be a string. @end deffn copy-file +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1415 @deffn {Scheme Procedure} copy-file oldfile newfile @deffnx {C Function} scm_copy_file (oldfile, newfile) Copy the file specified by @var{path-from} to @var{path-to}. @@ -5925,6 +6494,7 @@ The return value is unspecified. @end deffn dirname +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1460 @deffn {Scheme Procedure} dirname filename @deffnx {C Function} scm_dirname (filename) Return the directory name component of the file name @@ -5933,6 +6503,7 @@ component, @code{.} is returned. @end deffn basename +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1503 @deffn {Scheme Procedure} basename filename [suffix] @deffnx {C Function} scm_basename (filename, suffix) Return the base name of the file name @var{filename}. The @@ -5942,6 +6513,7 @@ If @var{suffix} is provided, and is equal to the end of @end deffn pipe +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:202 @deffn {Scheme Procedure} pipe @deffnx {C Function} scm_pipe () Return a newly created pipe: a pair of ports which are linked @@ -5960,6 +6532,7 @@ from the input port. @end deffn getgroups +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:223 @deffn {Scheme Procedure} getgroups @deffnx {C Function} scm_getgroups () Return a vector of integers representing the current @@ -5967,6 +6540,7 @@ supplementary group IDs. @end deffn getpw +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:254 @deffn {Scheme Procedure} getpw [user] @deffnx {C Function} scm_getpwuid (user) Look up an entry in the user database. @var{obj} can be an integer, @@ -5975,6 +6549,7 @@ or getpwent respectively. @end deffn setpw +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:307 @deffn {Scheme Procedure} setpw [arg] @deffnx {C Function} scm_setpwent (arg) If called with a true argument, initialize or reset the password data @@ -5983,6 +6558,7 @@ stream. Otherwise, close the stream. The @code{setpwent} and @end deffn getgr +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:326 @deffn {Scheme Procedure} getgr [name] @deffnx {C Function} scm_getgrgid (name) Look up an entry in the group database. @var{obj} can be an integer, @@ -5991,6 +6567,7 @@ or getgrent respectively. @end deffn setgr +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:366 @deffn {Scheme Procedure} setgr [arg] @deffnx {C Function} scm_setgrent (arg) If called with a true argument, initialize or reset the group data @@ -5999,6 +6576,7 @@ stream. Otherwise, close the stream. The @code{setgrent} and @end deffn kill +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:402 @deffn {Scheme Procedure} kill pid sig @deffnx {C Function} scm_kill (pid, sig) Sends a signal to the specified process or group of processes. @@ -6031,6 +6609,7 @@ Interrupt signal. @end deffn waitpid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:455 @deffn {Scheme Procedure} waitpid pid [options] @deffnx {C Function} scm_waitpid (pid, options) This procedure collects status information from a child process which @@ -6077,6 +6656,7 @@ The integer status value. @end deffn status:exit-val +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:483 @deffn {Scheme Procedure} status:exit-val status @deffnx {C Function} scm_status_exit_val (status) Return the exit status value, as would be set if a process @@ -6085,6 +6665,7 @@ if any, otherwise @code{#f}. @end deffn status:term-sig +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:503 @deffn {Scheme Procedure} status:term-sig status @deffnx {C Function} scm_status_term_sig (status) Return the signal number which terminated the process, if any, @@ -6092,6 +6673,7 @@ otherwise @code{#f}. @end deffn status:stop-sig +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:521 @deffn {Scheme Procedure} status:stop-sig status @deffnx {C Function} scm_status_stop_sig (status) Return the signal number which stopped the process, if any, @@ -6099,6 +6681,7 @@ otherwise @code{#f}. @end deffn getppid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:541 @deffn {Scheme Procedure} getppid @deffnx {C Function} scm_getppid () Return an integer representing the process ID of the parent @@ -6106,18 +6689,21 @@ process. @end deffn getuid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:553 @deffn {Scheme Procedure} getuid @deffnx {C Function} scm_getuid () Return an integer representing the current real user ID. @end deffn getgid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:564 @deffn {Scheme Procedure} getgid @deffnx {C Function} scm_getgid () Return an integer representing the current real group ID. @end deffn geteuid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:578 @deffn {Scheme Procedure} geteuid @deffnx {C Function} scm_geteuid () Return an integer representing the current effective user ID. @@ -6127,6 +6713,7 @@ system supports effective IDs. @end deffn getegid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:595 @deffn {Scheme Procedure} getegid @deffnx {C Function} scm_getegid () Return an integer representing the current effective group ID. @@ -6136,6 +6723,7 @@ system supports effective IDs. @end deffn setuid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:611 @deffn {Scheme Procedure} setuid id @deffnx {C Function} scm_setuid (id) Sets both the real and effective user IDs to the integer @var{id}, provided @@ -6144,6 +6732,7 @@ The return value is unspecified. @end deffn setgid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:625 @deffn {Scheme Procedure} setgid id @deffnx {C Function} scm_setgid (id) Sets both the real and effective group IDs to the integer @var{id}, provided @@ -6152,6 +6741,7 @@ The return value is unspecified. @end deffn seteuid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:641 @deffn {Scheme Procedure} seteuid id @deffnx {C Function} scm_seteuid (id) Sets the effective user ID to the integer @var{id}, provided the process @@ -6162,6 +6752,7 @@ The return value is unspecified. @end deffn setegid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:667 @deffn {Scheme Procedure} setegid id @deffnx {C Function} scm_setegid (id) Sets the effective group ID to the integer @var{id}, provided the process @@ -6172,6 +6763,7 @@ The return value is unspecified. @end deffn getpgrp +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:691 @deffn {Scheme Procedure} getpgrp @deffnx {C Function} scm_getpgrp () Return an integer representing the current process group ID. @@ -6179,6 +6771,7 @@ This is the POSIX definition, not BSD. @end deffn setpgid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:709 @deffn {Scheme Procedure} setpgid pid pgid @deffnx {C Function} scm_setpgid (pid, pgid) Move the process @var{pid} into the process group @var{pgid}. @var{pid} or @@ -6189,6 +6782,7 @@ The return value is unspecified. @end deffn setsid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:728 @deffn {Scheme Procedure} setsid @deffnx {C Function} scm_setsid () Creates a new session. The current process becomes the session leader @@ -6198,6 +6792,7 @@ The return value is an integer representing the new process group ID. @end deffn ttyname +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:743 @deffn {Scheme Procedure} ttyname port @deffnx {C Function} scm_ttyname (port) Return a string with the name of the serial terminal device @@ -6205,6 +6800,7 @@ underlying @var{port}. @end deffn ctermid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:767 @deffn {Scheme Procedure} ctermid @deffnx {C Function} scm_ctermid () Return a string containing the file name of the controlling @@ -6212,6 +6808,7 @@ terminal for the current process. @end deffn tcgetpgrp +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:790 @deffn {Scheme Procedure} tcgetpgrp port @deffnx {C Function} scm_tcgetpgrp (port) Return the process group ID of the foreground process group @@ -6227,6 +6824,7 @@ foreground. @end deffn tcsetpgrp +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:814 @deffn {Scheme Procedure} tcsetpgrp port pgid @deffnx {C Function} scm_tcsetpgrp (port, pgid) Set the foreground process group ID for the terminal used by the file @@ -6237,6 +6835,7 @@ controlling terminal. The return value is unspecified. @end deffn execl +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:869 @deffn {Scheme Procedure} execl filename . args @deffnx {C Function} scm_execl (filename, args) Executes the file named by @var{path} as a new process image. @@ -6253,6 +6852,7 @@ call, but we call it @code{execl} because of its Scheme calling interface. @end deffn execlp +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:889 @deffn {Scheme Procedure} execlp filename . args @deffnx {C Function} scm_execlp (filename, args) Similar to @code{execl}, however if @@ -6265,6 +6865,7 @@ call, but we call it @code{execlp} because of its Scheme calling interface. @end deffn execle +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:939 @deffn {Scheme Procedure} execle filename env . args @deffnx {C Function} scm_execle (filename, env, args) Similar to @code{execl}, but the environment of the new process is @@ -6276,6 +6877,7 @@ call, but we call it @code{execle} because of its Scheme calling interface. @end deffn primitive-fork +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:963 @deffn {Scheme Procedure} primitive-fork @deffnx {C Function} scm_fork () Creates a new "child" process by duplicating the current "parent" process. @@ -6287,6 +6889,7 @@ with the scsh fork. @end deffn uname +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:983 @deffn {Scheme Procedure} uname @deffnx {C Function} scm_uname () Return an object with some information about the computer @@ -6294,6 +6897,7 @@ system the program is running on. @end deffn environ +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1013 @deffn {Scheme Procedure} environ [env] @deffnx {C Function} scm_environ (env) If @var{env} is omitted, return the current environment (in the @@ -6306,6 +6910,7 @@ then the return value is unspecified. @end deffn tmpnam +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1051 @deffn {Scheme Procedure} tmpnam @deffnx {C Function} scm_tmpnam () Return a name in the file system that does not match any @@ -6316,6 +6921,7 @@ Care should be taken if opening the file, e.g., use the @end deffn mkstemp! +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1077 @deffn {Scheme Procedure} mkstemp! tmpl @deffnx {C Function} scm_mkstemp (tmpl) Create a new unique file in the file system and returns a new @@ -6326,6 +6932,7 @@ place to return the name of the temporary file. @end deffn utime +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1102 @deffn {Scheme Procedure} utime pathname [actime [modtime]] @deffnx {C Function} scm_utime (pathname, actime, modtime) @code{utime} sets the access and modification times for the @@ -6341,6 +6948,7 @@ modification time to the current time. @end deffn access? +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1150 @deffn {Scheme Procedure} access? path how @deffnx {C Function} scm_access (path, how) Return @code{#t} if @var{path} corresponds to an existing file @@ -6369,12 +6977,14 @@ test for existence of the file. @end deffn getpid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1164 @deffn {Scheme Procedure} getpid @deffnx {C Function} scm_getpid () Return an integer representing the current process ID. @end deffn putenv +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1181 @deffn {Scheme Procedure} putenv str @deffnx {C Function} scm_putenv (str) Modifies the environment of the current process, which is @@ -6391,6 +7001,7 @@ The return value is unspecified. @end deffn setlocale +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1223 @deffn {Scheme Procedure} setlocale category [locale] @deffnx {C Function} scm_setlocale (category, locale) If @var{locale} is omitted, return the current value of the @@ -6405,6 +7016,7 @@ the locale will be set using environment variables. @end deffn mknod +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1263 @deffn {Scheme Procedure} mknod path type perms dev @deffnx {C Function} scm_mknod (path, type, perms, dev) Creates a new special file, such as a file corresponding to a device. @@ -6425,6 +7037,7 @@ The return value is unspecified. @end deffn nice +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1309 @deffn {Scheme Procedure} nice incr @deffnx {C Function} scm_nice (incr) Increment the priority of the current process by @var{incr}. A higher @@ -6433,6 +7046,7 @@ The return value is unspecified. @end deffn sync +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1324 @deffn {Scheme Procedure} sync @deffnx {C Function} scm_sync () Flush the operating system disk buffers. @@ -6440,6 +7054,7 @@ The return value is unspecified. @end deffn crypt +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1337 @deffn {Scheme Procedure} crypt key salt @deffnx {C Function} scm_crypt (key, salt) Encrypt @var{key} using @var{salt} as the salt value to the @@ -6447,6 +7062,7 @@ crypt(3) library call. @end deffn chroot +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1358 @deffn {Scheme Procedure} chroot path @deffnx {C Function} scm_chroot (path) Change the root directory to that specified in @var{path}. @@ -6457,6 +7073,7 @@ root directory. @end deffn getlogin +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1390 @deffn {Scheme Procedure} getlogin @deffnx {C Function} scm_getlogin () Return a string containing the name of the user logged in on @@ -6465,6 +7082,7 @@ information cannot be obtained. @end deffn cuserid +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1408 @deffn {Scheme Procedure} cuserid @deffnx {C Function} scm_cuserid () Return a string containing a user name associated with the @@ -6473,6 +7091,7 @@ information cannot be obtained. @end deffn getpriority +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1433 @deffn {Scheme Procedure} getpriority which who @deffnx {C Function} scm_getpriority (which, who) Return the scheduling priority of the process, process group @@ -6488,6 +7107,7 @@ specified processes. @end deffn setpriority +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1467 @deffn {Scheme Procedure} setpriority which who prio @deffnx {C Function} scm_setpriority (which, who, prio) Set the scheduling priority of the process, process group @@ -6506,6 +7126,7 @@ The return value is not specified. @end deffn getpass +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1492 @deffn {Scheme Procedure} getpass prompt @deffnx {C Function} scm_getpass (prompt) Display @var{prompt} to the standard error output and read @@ -6518,6 +7139,7 @@ characters is disabled. @end deffn flock +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1596 @deffn {Scheme Procedure} flock file operation @deffnx {C Function} scm_flock (file, operation) Apply or remove an advisory lock on an open file. @@ -6540,6 +7162,7 @@ file descriptor or an open file descriptor port. @end deffn sethostname +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1622 @deffn {Scheme Procedure} sethostname name @deffnx {C Function} scm_sethostname (name) Set the host name of the current processor to @var{name}. May @@ -6548,12 +7171,14 @@ specified. @end deffn gethostname +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1637 @deffn {Scheme Procedure} gethostname @deffnx {C Function} scm_gethostname () Return the host name of the current processor. @end deffn gethost +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:154 @deffn {Scheme Procedure} gethost [host] @deffnx {Scheme Procedure} gethostbyname hostname @deffnx {Scheme Procedure} gethostbyaddr address @@ -6570,6 +7195,7 @@ Unusual conditions may result in errors thrown to the @end deffn getnet +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:233 @deffn {Scheme Procedure} getnet [net] @deffnx {Scheme Procedure} getnetbyname net-name @deffnx {Scheme Procedure} getnetbyaddr net-number @@ -6582,6 +7208,7 @@ given. @end deffn getproto +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:282 @deffn {Scheme Procedure} getproto [protocol] @deffnx {Scheme Procedure} getprotobyname name @deffnx {Scheme Procedure} getprotobynumber number @@ -6593,6 +7220,7 @@ argument. @code{getproto} will accept either type, behaving like @end deffn getserv +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:348 @deffn {Scheme Procedure} getserv [name [protocol]] @deffnx {Scheme Procedure} getservbyname name protocol @deffnx {Scheme Procedure} getservbyport port protocol @@ -6608,6 +7236,7 @@ as its first argument; if given no arguments, it behaves like @end deffn sethost +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:385 @deffn {Scheme Procedure} sethost [stayopen] @deffnx {C Function} scm_sethost (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endhostent}. @@ -6615,6 +7244,7 @@ Otherwise it is equivalent to @code{sethostent stayopen}. @end deffn setnet +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:401 @deffn {Scheme Procedure} setnet [stayopen] @deffnx {C Function} scm_setnet (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endnetent}. @@ -6622,6 +7252,7 @@ Otherwise it is equivalent to @code{setnetent stayopen}. @end deffn setproto +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:417 @deffn {Scheme Procedure} setproto [stayopen] @deffnx {C Function} scm_setproto (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endprotoent}. @@ -6629,6 +7260,7 @@ Otherwise it is equivalent to @code{setprotoent stayopen}. @end deffn setserv +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:433 @deffn {Scheme Procedure} setserv [stayopen] @deffnx {C Function} scm_setserv (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endservent}. @@ -6636,6 +7268,7 @@ Otherwise it is equivalent to @code{setservent stayopen}. @end deffn htons +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:109 @deffn {Scheme Procedure} htons value @deffnx {C Function} scm_htons (value) Convert a 16 bit quantity from host to network byte ordering. @@ -6644,6 +7277,7 @@ and returned as a new integer. @end deffn ntohs +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:126 @deffn {Scheme Procedure} ntohs value @deffnx {C Function} scm_ntohs (value) Convert a 16 bit quantity from network to host byte ordering. @@ -6652,6 +7286,7 @@ and returned as a new integer. @end deffn htonl +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:143 @deffn {Scheme Procedure} htonl value @deffnx {C Function} scm_htonl (value) Convert a 32 bit quantity from host to network byte ordering. @@ -6660,6 +7295,7 @@ and returned as a new integer. @end deffn ntohl +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:156 @deffn {Scheme Procedure} ntohl value @deffnx {C Function} scm_ntohl (value) Convert a 32 bit quantity from network to host byte ordering. @@ -6668,6 +7304,7 @@ and returned as a new integer. @end deffn inet-aton +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:176 @deffn {Scheme Procedure} inet-aton address @deffnx {C Function} scm_inet_aton (address) Convert an IPv4 Internet address from printable string @@ -6679,6 +7316,7 @@ Convert an IPv4 Internet address from printable string @end deffn inet-ntoa +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:195 @deffn {Scheme Procedure} inet-ntoa inetid @deffnx {C Function} scm_inet_ntoa (inetid) Convert an IPv4 Internet address to a printable @@ -6690,6 +7328,7 @@ Convert an IPv4 Internet address to a printable @end deffn inet-netof +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:215 @deffn {Scheme Procedure} inet-netof address @deffnx {C Function} scm_inet_netof (address) Return the network number part of the given IPv4 @@ -6701,6 +7340,7 @@ Internet address. E.g., @end deffn inet-lnaof +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:233 @deffn {Scheme Procedure} inet-lnaof address @deffnx {C Function} scm_lnaof (address) Return the local-address-with-network part of the given @@ -6713,6 +7353,7 @@ E.g., @end deffn inet-makeaddr +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:251 @deffn {Scheme Procedure} inet-makeaddr net lna @deffnx {C Function} scm_inet_makeaddr (net, lna) Make an IPv4 Internet address by combining the network number @@ -6725,6 +7366,7 @@ Make an IPv4 Internet address by combining the network number @end deffn inet-pton +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:369 @deffn {Scheme Procedure} inet-pton family address @deffnx {C Function} scm_inet_pton (family, address) Convert a string containing a printable network address to @@ -6740,6 +7382,7 @@ the result is an integer with normal host byte ordering. @end deffn inet-ntop +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:404 @deffn {Scheme Procedure} inet-ntop family address @deffnx {C Function} scm_inet_ntop (family, address) Convert a network address into a printable string. @@ -6755,6 +7398,7 @@ ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff @end deffn socket +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:449 @deffn {Scheme Procedure} socket family style proto @deffnx {C Function} scm_socket (family, style, proto) Return a new socket port of the type specified by @var{family}, @@ -6773,6 +7417,7 @@ has been connected to another socket. @end deffn socketpair +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:471 @deffn {Scheme Procedure} socketpair family style proto @deffnx {C Function} scm_socketpair (family, style, proto) Return a pair of connected (but unnamed) socket ports of the @@ -6783,6 +7428,7 @@ family. Zero is likely to be the only meaningful value for @end deffn getsockopt +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:500 @deffn {Scheme Procedure} getsockopt sock level optname @deffnx {C Function} scm_getsockopt (sock, level, optname) Return the value of a particular socket option for the socket @@ -6797,6 +7443,7 @@ returns a pair of integers. @end deffn setsockopt +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:568 @deffn {Scheme Procedure} setsockopt sock level optname value @deffnx {C Function} scm_setsockopt (sock, level, optname, value) Set the value of a particular socket option for the socket @@ -6813,6 +7460,7 @@ The return value is unspecified. @end deffn shutdown +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:672 @deffn {Scheme Procedure} shutdown sock how @deffnx {C Function} scm_shutdown (sock, how) Sockets can be closed simply by using @code{close-port}. The @@ -6835,6 +7483,7 @@ The return value is unspecified. @end deffn connect +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:816 @deffn {Scheme Procedure} connect sock fam address . args @deffnx {C Function} scm_connect (sock, fam, address, args) Initiate a connection from a socket using a specified address @@ -6861,6 +7510,7 @@ The return value is unspecified. @end deffn bind +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:876 @deffn {Scheme Procedure} bind sock fam address . args @deffnx {C Function} scm_bind (sock, fam, address, args) Assign an address to the socket port @var{sock}. @@ -6909,6 +7559,7 @@ The return value is unspecified. @end deffn listen +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:910 @deffn {Scheme Procedure} listen sock backlog @deffnx {C Function} scm_listen (sock, backlog) Enable @var{sock} to accept connection @@ -6922,6 +7573,7 @@ The return value is unspecified. @end deffn accept +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1015 @deffn {Scheme Procedure} accept sock @deffnx {C Function} scm_accept (sock) Accept a connection on a bound, listening socket. @@ -6941,6 +7593,7 @@ connection and will continue to accept new requests. @end deffn getsockname +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1042 @deffn {Scheme Procedure} getsockname sock @deffnx {C Function} scm_getsockname (sock) Return the address of @var{sock}, in the same form as the @@ -6949,6 +7602,7 @@ of a socket in the @code{AF_FILE} namespace cannot be read. @end deffn getpeername +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1064 @deffn {Scheme Procedure} getpeername sock @deffnx {C Function} scm_getpeername (sock) Return the address that @var{sock} @@ -6958,6 +7612,7 @@ is connected to, in the same form as the object returned by @end deffn recv! +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1099 @deffn {Scheme Procedure} recv! sock buf [flags] @deffnx {C Function} scm_recv (sock, buf, flags) Receive data from a socket port. @@ -6983,6 +7638,7 @@ any unread buffered port data is ignored. @end deffn send +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1132 @deffn {Scheme Procedure} send sock message [flags] @deffnx {C Function} scm_send (sock, message, flags) Transmit the string @var{message} on a socket port @var{sock}. @@ -7001,6 +7657,7 @@ any unflushed buffered port data is ignored. @end deffn recvfrom! +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1172 @deffn {Scheme Procedure} recvfrom! sock str [flags [start [end]]] @deffnx {C Function} scm_recvfrom (sock, str, flags, start, end) Return data from the socket port @var{sock} and also @@ -7029,6 +7686,7 @@ descriptor: any unread buffered port data is ignored. @end deffn sendto +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1230 @deffn {Scheme Procedure} sendto sock message fam address . args_and_flags @deffnx {C Function} scm_sendto (sock, message, fam, address, args_and_flags) Transmit the string @var{message} on the socket port @@ -7051,52 +7709,138 @@ file descriptor: any unflushed buffered port data is ignored. @end deffn + regexp? +@c snarfed from /home/ghouston/guile/guile-core/libguile/regex-posix.c:137 +@deffn {Scheme Procedure} regexp? obj +@deffnx {C Function} scm_regexp_p (obj) +Return @code{#t} if @var{obj} is a compiled regular expression, +or @code{#f} otherwise. +@end deffn + + make-regexp +@c snarfed from /home/ghouston/guile/guile-core/libguile/regex-posix.c:182 +@deffn {Scheme Procedure} make-regexp pat . flags +@deffnx {C Function} scm_make_regexp (pat, flags) +Compile the regular expression described by @var{pat}, and +return the compiled regexp structure. If @var{pat} does not +describe a legal regular expression, @code{make-regexp} throws +a @code{regular-expression-syntax} error. + +The @var{flags} arguments change the behavior of the compiled +regular expression. The following flags may be supplied: + +@table @code +@item regexp/icase +Consider uppercase and lowercase letters to be the same when +matching. +@item regexp/newline +If a newline appears in the target string, then permit the +@samp{^} and @samp{$} operators to match immediately after or +immediately before the newline, respectively. Also, the +@samp{.} and @samp{[^...]} operators will never match a newline +character. The intent of this flag is to treat the target +string as a buffer containing many lines of text, and the +regular expression as a pattern that may match a single one of +those lines. +@item regexp/basic +Compile a basic (``obsolete'') regexp instead of the extended +(``modern'') regexps that are the default. Basic regexps do +not consider @samp{|}, @samp{+} or @samp{?} to be special +characters, and require the @samp{@{...@}} and @samp{(...)} +metacharacters to be backslash-escaped (@pxref{Backslash +Escapes}). There are several other differences between basic +and extended regular expressions, but these are the most +significant. +@item regexp/extended +Compile an extended regular expression rather than a basic +regexp. This is the default behavior; this flag will not +usually be needed. If a call to @code{make-regexp} includes +both @code{regexp/basic} and @code{regexp/extended} flags, the +one which comes last will override the earlier one. +@end table +@end deffn + + regexp-exec +@c snarfed from /home/ghouston/guile/guile-core/libguile/regex-posix.c:243 +@deffn {Scheme Procedure} regexp-exec rx str [start [flags]] +@deffnx {C Function} scm_regexp_exec (rx, str, start, flags) +Match the compiled regular expression @var{rx} against +@code{str}. If the optional integer @var{start} argument is +provided, begin matching from that position in the string. +Return a match structure describing the results of the match, +or @code{#f} if no match could be found. + +The @var{flags} arguments change the matching behavior. +The following flags may be supplied: + +@table @code +@item regexp/notbol +Operator @samp{^} always fails (unless @code{regexp/newline} +is used). Use this when the beginning of the string should +not be considered the beginning of a line. +@item regexp/noteol +Operator @samp{$} always fails (unless @code{regexp/newline} +is used). Use this when the end of the string should not be +considered the end of a line. +@end table +@end deffn + single-active-thread? +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:79 @deffn {Scheme Procedure} single-active-thread? implemented by the C function "scm_single_thread_p" @end deffn yield +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:85 @deffn {Scheme Procedure} yield implemented by the C function "scm_yield" @end deffn call-with-new-thread +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:90 @deffn {Scheme Procedure} call-with-new-thread implemented by the C function "scm_call_with_new_thread" @end deffn join-thread +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:104 @deffn {Scheme Procedure} join-thread implemented by the C function "scm_join_thread" @end deffn make-mutex +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:109 @deffn {Scheme Procedure} make-mutex implemented by the C function "scm_make_mutex" @end deffn lock-mutex +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:112 @deffn {Scheme Procedure} lock-mutex implemented by the C function "scm_lock_mutex" @end deffn unlock-mutex +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:117 @deffn {Scheme Procedure} unlock-mutex implemented by the C function "scm_unlock_mutex" @end deffn make-condition-variable +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:123 @deffn {Scheme Procedure} make-condition-variable implemented by the C function "scm_make_condition_variable" @end deffn wait-condition-variable +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:125 @deffn {Scheme Procedure} wait-condition-variable implemented by the C function "scm_wait_condition_variable" @end deffn signal-condition-variable +@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:127 @deffn {Scheme Procedure} signal-condition-variable implemented by the C function "scm_signal_condition_variable" @end deffn diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index c1c39a46e..01d698795 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2002-07-10 Gary Houston + + * scheme-modules.texi (Compiled Code Modules): Removed description + of scm_register_module_xxx, which no longer exists. A description + of current techniques is needed. + 2002-05-09 Marius Vollmer * scheme-data.texi (Numbers): Added description of the new values diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index 032330973..9e3ddf894 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -76,8 +76,7 @@ module system. In 1996 Tom Lord implemented a full-featured module system for Guile which allows loading Scheme source files into a private name space. This system has -been in available since Guile version 1.4. -@c fixme: Actually, was it available before? 1.4 seems a bit late... +been in available since at least Guile version 1.1. For Guile version 1.5.0 and later, the system has been improved to have better integration from C code, more fine-grained user control over interfaces, and @@ -500,44 +499,46 @@ When using the low level procedures to do your dynamic linking, you have complete control over which library is loaded when and what gets done with it. -@deffn {Scheme Procedure} dynamic-link library -@deffnx {C Function} scm_dynamic_link (library) -Find the shared library denoted by @var{library} (a string) and link it -into the running Guile application. When everything works out, return a -Scheme object suitable for representing the linked object file. -Otherwise an error is thrown. How object files are searched is system -dependent. +@deffn {Scheme Procedure} dynamic-link filename +@deffnx {C Function} scm_dynamic_link (filename) +Find the shared object (shared library) denoted by +@var{filename} and link it into the running Guile +application. The returned +scheme object is a ``handle'' for the library which can +be passed to @code{dynamic-func}, @code{dynamic-call} etc. -Normally, @var{library} is just the name of some shared library file -that will be searched for in the places where shared libraries usually -reside, such as in @file{/usr/lib} and @file{/usr/local/lib}. +Searching for object files is system dependent. Normally, +if @var{filename} does have an explicit directory it will +be searched for in locations +such as @file{/usr/lib} and @file{/usr/local/lib}. @end deffn @deffn {Scheme Procedure} dynamic-object? obj @deffnx {C Function} scm_dynamic_object_p (obj) -Return @code{#t} if @var{obj} is a dynamic library handle, or @code{#f} -otherwise. +Return @code{#t} if @var{obj} is a dynamic object handle, +or @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} dynamic-unlink dobj @deffnx {C Function} scm_dynamic_unlink (dobj) -Unlink the indicated object file from the application. The -argument @var{dobj} must have been obtained by a call to -@code{dynamic-link}. After @code{dynamic-unlink} has been -called on @var{dobj}, its content is no longer accessible. +Unlink a dynamic object from the application, if possible. The +object must have been linked by @code{dynamic-link}, with +@var{dobj} the corresponding handle. After this procedure +is called, the handle can no longer be used to access the +object. @end deffn @deffn {Scheme Procedure} dynamic-func name dobj @deffnx {C Function} scm_dynamic_func (name, dobj) -Search the dynamic object @var{dobj} for the C function -indicated by the string @var{name} and return some Scheme -handle that can later be used with @code{dynamic-call} to -actually call the function. +Return a ``handle'' for the function @var{name} in the +shared object referred to by @var{dobj}. The handle +can be passed to @code{dynamic-call} to actually +call the function. -Regardless whether your C compiler prepends an underscore @samp{_} to -the global names in a program, you should @strong{not} include this -underscore in @var{function}. Guile knows whether the underscore is -needed or not and will add it when necessary. +Regardless whether your C compiler prepends an underscore +@samp{_} to the global names in a program, you should +@strong{not} include this underscore in @var{name} +since it will be added automatically when necessary. @end deffn @deffn {Scheme Procedure} dynamic-call func dobj @@ -583,7 +584,7 @@ converted to a Scheme number and returned from the call to When dynamic linking is disabled or not supported on your system, the above functions throw errors, but they are still available. -Here is a small example that works on GNU/Linux: +Here is a small example that may work on GNU/Linux: @smallexample (define libc-obj (dynamic-link "libc.so")) @@ -657,43 +658,6 @@ this current module. Therefore, all we need to do is to make sure that the right module is current when calling @code{gh_new_procedure} for our new primitives. -Unfortunately, there is not yet an easy way to access the module system -from C, so we are better off with a more indirect approach. Instead of -adding our primitives at initialization time we merely register with -Guile that we are ready to provide the contents of a certain module, -should it ever be needed. - -@deftypefun void scm_register_module_xxx (char *@var{name}, void (*@var{initfunc})(void)) -Register with Guile that @var{initfunc} will provide the contents of the -module @var{name}. - -The function @var{initfunc} should perform the usual initialization -actions for your new primitives, like calling @code{gh_new_procedure} or -including the file produced by the snarfer. When @var{initfunc} is -called, the current module is a newly created module with a name as -indicated by @var{name}. Each definition that is added to it will be -automatically exported. - -The string @var{name} indicates the hierarchical name of the new module. -It should consist of the individual components of the module name -separated by single spaces. That is, the Scheme module name @code{(foo -bar)}, which is a list, should be written as @code{"foo bar"} for the -@var{name} parameter. - -You can call @code{scm_register_module_xxx} at any time, even before -Guile has been initialized. This might be useful when you want to put -the call to it in some initialization code that is magically called -before main, like constructors for global C++ objects. - -An example for @code{scm_register_module_xxx} appears in the next section. -@end deftypefun - -Now, instead of calling the initialization function at program startup, -you should simply call @code{scm_register_module_xxx} and pass it the -initialization function. When the named module is later requested by -Scheme code with @code{use-modules} for example, Guile will notice that -it knows how to create this module and will call the initialization -function at the right time in the right context. @node Dynamic Linking and Compiled Code Modules @subsection Dynamic Linking and Compiled Code Modules @@ -774,49 +738,32 @@ Fun, isn't it? But we are only half way there. This is what As you can see, @code{j0} is contained in the root module, where all the other Guile primitives like @code{display}, etc live. In general, a primitive is put into whatever module is the @dfn{current module} at -the time @code{gh_new_procedure} is called. To put @code{j0} into its -own module named @samp{(math bessel)}, we need to make a call to -@code{scm_register_module_xxx}. Additionally, to have Guile perform -the dynamic linking automatically, we need to put @file{libbessel.so} -into a place where Guile can find it. The call to -@code{scm_register_module_xxx} should be contained in a specially -named @dfn{module init function}. Guile knows about this special name -and will call that function automatically after having linked in the -shared library. For our example, we add the following code to -@file{bessel.c}: +the time @code{gh_new_procedure} is called. + +A compiled module should have a specially named @dfn{module init +function}. Guile knows about this special name and will call that +function automatically after having linked in the shared library. For +our example, we add the following code to @file{bessel.c}: @smallexample void scm_init_math_bessel_module () @{ - scm_register_module_xxx ("math bessel", init_math_bessel); + /* contents currently unavailable. */ @} @end smallexample The general pattern for the name of a module init function is: @samp{scm_init_}, followed by the name of the module where the individual hierarchical components are concatenated with underscores, -followed by @samp{_module}. It should call -@code{scm_register_module_xxx} with the correct module name and the -appropriate initialization function. When that initialization function -will be called, a newly created module with the right name will be the -@emph{current module} so that all definitions that the initialization -functions makes will end up in the correct module. +followed by @samp{_module}. After @file{libbessel.so} has been rebuild, we need to place the shared -library into the right place. When Guile tries to autoload the -@samp{(math bessel)} module, it looks not only for a file called -@file{math/bessel.scm} in its @code{%load-path}, but also for -@file{math/libbessel.so}. So all we need to do is to create a directory -called @file{math} somewhere in Guile's @code{%load-path} and place -@file{libbessel.so} there. Normally, the current directory @file{.} is -in the @code{%load-path}, so we just use that for this example. +library into the right place. + +Once the module has been correctly installed, it should be possible to +use it like this: @smallexample -% mkdir maths -% cd maths -% ln -s ../libbessel.so . -% cd .. -% guile guile> (use-modules (math bessel)) guile> (j0 2) 0.223890779141236 @@ -826,18 +773,6 @@ guile> (apropos 'j0) That's it! -Note that we used a symlink to make @file{libbessel.so} appear in the -right spot. This is probably not a bad idea in general. The -directories that the @file{%load-path} normally contains are supposed to -contain only architecture independent files. They are not really the -right place for a shared library. You might want to install the -libraries somewhere below @samp{exec_prefix} and then symlink to them -from the architecture independent directory. This will at least work on -heterogenous systems where the architecture dependent stuff resides in -the same place on all machines (which seems like a good idea to me -anyway). - - @node Variables @section Variables @tpindex Variables From 9540b68f94669b25bd60b831ffd89688de3427f8 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Wed, 10 Jul 2002 22:25:55 +0000 Subject: [PATCH 052/306] * eq.c: include --- libguile/ChangeLog | 1 + libguile/eq.c | 8 +++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 278f26b90..f9cfd9b97 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,6 @@ 2002-07-10 Gary Houston + * eq.c: include * dynl.c: docstring editing. 2002-07-09 Gary Houston diff --git a/libguile/eq.c b/libguile/eq.c index 5dc73b6ed..bac72d051 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -39,8 +39,8 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ - + #include "libguile/_scm.h" #include "libguile/ramap.h" #include "libguile/stackchk.h" @@ -54,6 +54,12 @@ #include "libguile/validate.h" #include "libguile/eq.h" + +#ifdef HAVE_STRING_H +#include +#endif + + SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr, (SCM x, SCM y), "Return @code{#t} iff @var{x} references the same object as @var{y}.\n" From 4abbb327ee2490da4d6c64d28e690c60e70e72db Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 11 Jul 2002 23:20:16 +0000 Subject: [PATCH 053/306] Added Clinton Ebadi. --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index bd6c5cc3f..947c1e615 100644 --- a/THANKS +++ b/THANKS @@ -18,6 +18,7 @@ For fixes or providing information which led to a fix: Christopher Cramer Alexandre Duret-Lutz John W Eaton + Clinton Ebadi Aubrey Jaffer Eric Gillespie, Jr John Goerzen From c21935e6cd7e42acedf72025966352a8c5d0fb93 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 11 Jul 2002 23:20:45 +0000 Subject: [PATCH 054/306] *** empty log message *** --- libguile/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f9cfd9b97..13a49bfb3 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-07-10 Marius Vollmer + + * guile.c, iselect.h, net_db.c, posix.c, socket.c: No need to + check for Cygwin when including , this is already + check for by configure. Thus, revert change from 2002-07-07. + 2002-07-10 Gary Houston * eq.c: include From 7e7eb95b41dc5498e9f73957df753a91749ddb26 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 11 Jul 2002 23:21:25 +0000 Subject: [PATCH 055/306] Added 2002 to the copyright years. --- ice-9/slib.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ice-9/slib.scm b/ice-9/slib.scm index dc40c2ee0..cde54c339 100644 --- a/ice-9/slib.scm +++ b/ice-9/slib.scm @@ -1,6 +1,6 @@ ;;;; slib.scm --- definitions needed to get SLIB to work with Guile ;;;; -;;;; Copyright (C) 1997, 1998, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc. ;;;; ;;;; This file is part of GUILE. ;;;; From 4f6f9ae3d35a15a908242d851e403a207ffb8cc0 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Fri, 12 Jul 2002 17:46:15 +0000 Subject: [PATCH 056/306] * dynl.c: Don't define stub procedures if DYNAMIC_LINKING is not defined. They don't do anything useful, especially since the only case where DYNAMIC_LINKING is undefined seems to be when --with-modules=no is given to configure, which is basically requesting that the "dynamic linking module" be omitted. * Makefile.am (libguile_la_SOURCES): move dynl.c from libguile_la_SOURCES to EXTRA_libguile_la_SOURCES. * extensions.c (load_extension): check DYNAMIC_LINKING for scm_dynamic_call. * init.c (scm_init_guile_1): check DYNAMIC_LINKING for scm_init_dynamic_linking. * configure.in: check dynamic linking before modules. Add dynl.c if dynamic linking is available, i.e., unless --with-modules=no was given to configure. --- ChangeLog | 6 ++++++ configure.in | 46 +++++++++++++++++++++++-------------------- libguile/ChangeLog | 16 +++++++++++++++ libguile/Makefile.am | 4 ++-- libguile/dynl.c | 42 --------------------------------------- libguile/extensions.c | 2 ++ libguile/init.c | 2 ++ 7 files changed, 53 insertions(+), 65 deletions(-) diff --git a/ChangeLog b/ChangeLog index b7c6d3c8a..1ede0de4c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2002-07-12 Gary Houston + + * configure.in: check dynamic linking before modules. Add dynl.c + if dynamic linking is available, i.e., unless --with-modules=no + was given to configure. + 2002-07-09 Marius Vollmer * autogen.sh: Patch libltdl/ltdl.c to avoid a nasty bug in diff --git a/configure.in b/configure.in index 77ef36564..3c554ee5c 100644 --- a/configure.in +++ b/configure.in @@ -171,8 +171,33 @@ AM_PROG_LIBTOOL AC_CHECK_PROG(have_makeinfo, makeinfo, yes, no) AM_CONDITIONAL(HAVE_MAKEINFO, test "$have_makeinfo" = yes) +dnl Check for dynamic linking + +use_modules=yes +AC_ARG_WITH(modules, +[ --with-modules[=FILES] Add support for dynamic modules], +use_modules="$withval") +test -z "$use_modules" && use_modules=yes +DLPREOPEN= +if test "$use_modules" != no; then + AC_DEFINE(DYNAMIC_LINKING, 1, + [Define if you want support for dynamic linking.]) + if test "$use_modules" = yes; then + DLPREOPEN="-dlpreopen force" + else + DLPREOPEN="-export-dynamic" + for module in $use_modules; do + DLPREOPEN="$DLPREOPEN -dlopen $module" + done + fi +fi + dnl files which are destined for separate modules. +if test "$use_modules" != no; then + AC_LIBOBJ([dynl]) +fi + if test "$enable_arrays" = yes; then AC_LIBOBJ([ramap]) AC_LIBOBJ([unif]) @@ -280,27 +305,6 @@ if test "$MINGW32" = "yes" ; then fi AC_SUBST(EXTRA_DEFS) -dnl Check for dynamic linking - -use_modules=yes -AC_ARG_WITH(modules, -[ --with-modules[=FILES] Add support for dynamic modules], -use_modules="$withval") -test -z "$use_modules" && use_modules=yes -DLPREOPEN= -if test "$use_modules" != no; then - AC_DEFINE(DYNAMIC_LINKING, 1, - [Define if you want support for dynamic linking.]) - if test "$use_modules" = yes; then - DLPREOPEN="-dlpreopen force" - else - DLPREOPEN="-export-dynamic" - for module in $use_modules; do - DLPREOPEN="$DLPREOPEN -dlopen $module" - done - fi -fi - AC_SUBST(INCLTDL) AC_SUBST(LIBLTDL) AC_SUBST(DLPREOPEN) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 13a49bfb3..a8566b530 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,19 @@ +2002-07-12 Gary Houston + + * dynl.c: Don't define stub procedures if DYNAMIC_LINKING is not + defined. They don't do anything useful, especially since the + only case where DYNAMIC_LINKING is undefined seems to be + when --with-modules=no is given to configure, which is basically + requesting that the "dynamic linking module" be omitted. + + * Makefile.am (libguile_la_SOURCES): move dynl.c from + libguile_la_SOURCES to EXTRA_libguile_la_SOURCES. + + * extensions.c (load_extension): check DYNAMIC_LINKING for + scm_dynamic_call. + * init.c (scm_init_guile_1): check DYNAMIC_LINKING for + scm_init_dynamic_linking. + 2002-07-10 Marius Vollmer * guile.c, iselect.h, net_db.c, posix.c, socket.c: No need to diff --git a/libguile/Makefile.am b/libguile/Makefile.am index ec819d4a4..c8b16a572 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -61,7 +61,7 @@ guile_LDADD = libguile.la guile_LDFLAGS = @DLPREOPEN@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ - chars.c continuations.c convert.c debug.c deprecation.c dynl.c \ + chars.c continuations.c convert.c debug.c deprecation.c \ dynwind.c environments.c eq.c error.c eval.c evalext.c extensions.c \ feature.c fluids.c fports.c \ gc.c gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c gh_init.c \ @@ -113,7 +113,7 @@ BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h scmconfig.h \ EXTRA_libguile_la_SOURCES = _scm.h \ alloca.c inet_aton.c memmove.c putenv.c strerror.c \ - threads.c regex-posix.c \ + dynl.c threads.c regex-posix.c \ filesys.c posix.c net_db.c socket.c \ ramap.c unif.c debug-malloc.c mkstemp.c \ win32-uname.c win32-dirent.c win32-socket.c diff --git a/libguile/dynl.c b/libguile/dynl.c index 494b88dfe..4cc46d1e3 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -75,8 +75,6 @@ maybe_drag_in_eprintf () #include "libguile/lang.h" #include "libguile/validate.h" -#ifdef DYNAMIC_LINKING - #include "libltdl/ltdl.h" /* From the libtool manual: "Note that libltdl is not threadsafe, @@ -133,46 +131,6 @@ sysdep_dynl_init () lt_dlinit (); } -#else - -/* no dynamic linking available, throw errors. */ - -static void -sysdep_dynl_init (void) -{ -} - -static void -no_dynl_error (const char *subr) -{ - scm_misc_error (subr, "dynamic linking not available", SCM_EOL); -} - -static void * -sysdep_dynl_link (const char *filename, const char *subr) -{ - no_dynl_error (subr); - return NULL; -} - -static void -sysdep_dynl_unlink (void *handle, - const char *subr) -{ - no_dynl_error (subr); -} - -static void * -sysdep_dynl_func (const char *symbol, - void *handle, - const char *subr) -{ - no_dynl_error (subr); - return NULL; -} - -#endif - scm_t_bits scm_tc16_dynamic_obj; #define DYNL_FILENAME(x) (SCM_CELL_OBJECT_1 (x)) diff --git a/libguile/extensions.c b/libguile/extensions.c index 7fd311cce..c01194179 100644 --- a/libguile/extensions.c +++ b/libguile/extensions.c @@ -103,9 +103,11 @@ load_extension (SCM lib, SCM init) } } +#if defined (DYNAMIC_LINKING) /* Dynamically link the library. */ scm_dynamic_call (init, scm_dynamic_link (lib)); +#endif } void diff --git a/libguile/init.c b/libguile/init.c index e4567600c..0e8b6ff73 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -556,7 +556,9 @@ scm_init_guile_1 (SCM_STACKITEM *base) scm_init_simpos (); scm_init_load_path (); scm_init_standard_ports (); /* Requires fports */ +#ifdef DYNAMIC_LINKING scm_init_dynamic_linking (); +#endif #ifdef SCM_ENABLE_ELISP scm_init_lang (); #endif /* SCM_ENABLE_ELISP */ From 9f04540330e22cb91c7da6f7f8ac272ea050de57 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sat, 13 Jul 2002 08:18:35 +0000 Subject: [PATCH 057/306] * oop/goops.scm (define-class): Make sure that define-class will continue to work when mmacros are expanded before execution. * test-suite/tests/goops.test: Added tests for define-class. --- oop/ChangeLog | 5 +++++ oop/goops.scm | 28 +++++++++++----------------- test-suite/ChangeLog | 4 ++++ test-suite/tests/goops.test | 15 +++++++++++++++ 4 files changed, 35 insertions(+), 17 deletions(-) diff --git a/oop/ChangeLog b/oop/ChangeLog index 0bde849e4..23cf19f75 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,8 @@ +2002-07-13 Dirk Herrmann + + * goops.scm (define-class): Make sure that define-class will + continue to work when mmacros are expanded before execution. + 2002-07-08 Dirk Herrmann * goops.scm (define-generic, define-accessor): Make sure that diff --git a/oop/goops.scm b/oop/goops.scm index 6f7721d80..47c6b9464 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -235,23 +235,17 @@ `(begin ;; define accessors ,@(pre-definitions (slots exp) env) - - ,(if (defined? name env) - - ;; redefine an old class - `(define ,name - (let ((old ,name) - (new (class ,@(cddr exp) #:name ',name))) - (if (and (is-a? old ) - ;; Prevent redefinition of non-objects - (memq - (class-precedence-list old))) - (class-redefinition old new) - new))) - - ;; define a new class - `(define ,name - (class ,@(cddr exp) #:name ',name))))))))))) + ;; update the current-module + (let* ((class (class ,@(cddr exp) #:name ',name)) + (var (module-ensure-local-variable! + (current-module) ',name)) + (old (and (variable-bound? var) + (variable-ref var)))) + (if (and old + (is-a? old ) + (memq (class-precedence-list old))) + (variable-set! var (class-redefinition old class)) + (variable-set! var class))))))))))) (define standard-define-class define-class) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index abfc1b639..aaae53ea6 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2002-07-13 Dirk Herrmann + + * tests/goops.test: Added tests for define-class. + 2002-05-07 Marius Vollmer * tests/numbers.test (/): Expect divison by an inexact zero to diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index 9705b19bc..ac78e8488 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -98,3 +98,18 @@ (pass-if "direct superclass" (equal? (class-direct-supers ) (list ))))) + +(with-test-prefix "defining classes" + + (with-test-prefix "define-class" + + (pass-if "creating a new binding" + (eval '(define #f) (current-module)) + (eval '(undefine ) (current-module)) + (eval '(define-class ()) (current-module)) + (eval '(is-a? ) (current-module))) + + (pass-if "overwriting a binding to a non-class" + (eval '(define #f) (current-module)) + (eval '(define-class ()) (current-module)) + (eval '(is-a? ) (current-module))))) From 33e04d54927e23af94ded1d525b3a76ec3fb0b68 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sat, 13 Jul 2002 09:44:39 +0000 Subject: [PATCH 058/306] * oop/goops.scm (define-generic, define-accessor): Make sure that define-generic and define-accessor will continue to work when mmacros are expanded before execution. * test-suite/tests/goops.test: Added tests for define-generic and define-accessor. --- oop/ChangeLog | 6 +++++ oop/goops.scm | 29 +++++++++++--------- test-suite/ChangeLog | 5 ++++ test-suite/tests/goops.test | 54 +++++++++++++++++++++++++++++++++++++ 4 files changed, 81 insertions(+), 13 deletions(-) diff --git a/oop/ChangeLog b/oop/ChangeLog index 23cf19f75..f72fa4175 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,9 @@ +2002-07-13 Dirk Herrmann + + * goops.scm (define-generic, define-accessor): Make sure that + define-generic and define-accessor will continue to work when + mmacros are expanded before execution. + 2002-07-13 Dirk Herrmann * goops.scm (define-class): Make sure that define-class will diff --git a/oop/goops.scm b/oop/goops.scm index 47c6b9464..e9c50af88 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -360,12 +360,13 @@ (let ((name (cadr exp))) (cond ((not (symbol? name)) (goops-error "bad generic function name: ~S" name)) - ((and (top-level-env? env) - (defined? name env)) - `(define ,name - (if (is-a? ,name ) - (make #:name ',name) - (ensure-generic ,name ',name)))) + ((top-level-env? env) + `(let* ((var (module-ensure-local-variable! + (current-module) ',name)) + (old (and (variable-bound? var) (variable-ref var)))) + (if (or (not old) (is-a? old )) + (variable-set! var (make #:name ',name)) + (variable-set! var (ensure-generic old ',name))))) (else `(define ,name (make #:name ',name)))))))) @@ -391,13 +392,15 @@ (let ((name (cadr exp))) (cond ((not (symbol? name)) (goops-error "bad accessor name: ~S" name)) - ((and (top-level-env? env) - (defined? name env)) - `(define ,name - (if (and (is-a? ,name ) - (is-a? (setter ,name) )) - (make-accessor ',name) - (ensure-accessor ,name ',name)))) + ((top-level-env? env) + `(let* ((var (module-ensure-local-variable! + (current-module) ',name)) + (old (and (variable-bound? var) (variable-ref var)))) + (if (or (not old) + (and (is-a? old ) + (is-a? (setter old) ))) + (variable-set! var (make-accessor ',name)) + (variable-set! var (ensure-accessor old ',name))))) (else `(define ,name (make-accessor ',name)))))))) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index aaae53ea6..da61a418f 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2002-07-13 Dirk Herrmann + + * tests/goops.test: Added tests for define-generic and + define-accessor. + 2002-07-13 Dirk Herrmann * tests/goops.test: Added tests for define-class. diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index ac78e8488..08f1f58ac 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -113,3 +113,57 @@ (eval '(define #f) (current-module)) (eval '(define-class ()) (current-module)) (eval '(is-a? ) (current-module))))) + +(with-test-prefix "defining generics" + + (with-test-prefix "define-generic" + + (pass-if "creating a new top-level binding" + (eval '(define foo #f) (current-module)) + (eval '(undefine foo) (current-module)) + (eval '(define-generic foo) (current-module)) + (eval '(and (is-a? foo ) + (null? (generic-function-methods foo))) + (current-module))) + + (pass-if "overwriting a top-level binding to a non-generic" + (eval '(define (foo) #f) (current-module)) + (eval '(define-generic foo) (current-module)) + (eval '(and (is-a? foo ) + (= 1 (length (generic-function-methods foo)))) + (current-module))) + + (pass-if "overwriting a top-level binding to a generic" + (eval '(define (foo) #f) (current-module)) + (eval '(define-generic foo) (current-module)) + (eval '(define-generic foo) (current-module)) + (eval '(and (is-a? foo ) + (null? (generic-function-methods foo))) + (current-module))))) + +(with-test-prefix "defining accessors" + + (with-test-prefix "define-accessor" + + (pass-if "creating a new top-level binding" + (eval '(define foo #f) (current-module)) + (eval '(undefine foo) (current-module)) + (eval '(define-accessor foo) (current-module)) + (eval '(and (is-a? foo ) + (null? (generic-function-methods foo))) + (current-module))) + + (pass-if "overwriting a top-level binding to a non-accessor" + (eval '(define (foo) #f) (current-module)) + (eval '(define-accessor foo) (current-module)) + (eval '(and (is-a? foo ) + (= 1 (length (generic-function-methods foo)))) + (current-module))) + + (pass-if "overwriting a top-level binding to an accessor" + (eval '(define (foo) #f) (current-module)) + (eval '(define-accessor foo) (current-module)) + (eval '(define-accessor foo) (current-module)) + (eval '(and (is-a? foo ) + (null? (generic-function-methods foo))) + (current-module))))) From 4c5f8e8fe007d914a5bb4abb7cb9b938873eab5b Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 14 Jul 2002 15:43:24 +0000 Subject: [PATCH 059/306] Fix for 1001-local-eval-error-backtrace-segfaults. --- libguile/ChangeLog | 6 ++++++ libguile/eval.c | 4 +++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index a8566b530..a7b81f2c2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-07-13 Neil Jerram + + * eval.c (unmemocopy): Fix for + 1001-local-eval-error-backtrace-segfaults (unmemoization crash + with internal definitions and local-eval). + 2002-07-12 Gary Houston * dynl.c: Don't define stub procedures if DYNAMIC_LINKING is not diff --git a/libguile/eval.c b/libguile/eval.c index 172cc2e4d..68e0b78e6 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1472,7 +1472,9 @@ unmemocopy (SCM x, SCM env) z = scm_cons (n, SCM_UNSPECIFIED); ls = scm_cons (scm_sym_define, z); if (!SCM_NULLP (env)) - SCM_SETCAR (SCM_CAR (env), scm_cons (n, SCM_CAAR (env))); + env = scm_cons (scm_cons (scm_cons (n, SCM_CAAR (env)), + SCM_CDAR (env)), + SCM_CDR (env)); break; } case SCM_BIT8(SCM_MAKISYM (0)): From 3063e30a6dca1e0abc0b40d3c62f755a9155fccd Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Mon, 15 Jul 2002 20:39:53 +0000 Subject: [PATCH 060/306] * eval.c (SCM_CEVAL), macros.c (macro_print, scm_makmacro, scm_sym_macro, scm_macro_type), macros.h (scm_makmacro): Deprecated the special kind of built-in dynamic syntax transformer that was inaccurately named "macro". Note: The built-in syntax transformers that are named "mmacro" or "memoizing-macro" still exist, and it is these which come much closer to what one would call a macro. --- NEWS | 12 ++++++++++++ libguile/ChangeLog | 10 ++++++++++ libguile/eval.c | 5 +++-- libguile/macros.c | 19 +++++++++++++++++-- libguile/macros.h | 7 +++++-- 5 files changed, 47 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 4c73222bf..1655989ff 100644 --- a/NEWS +++ b/NEWS @@ -95,6 +95,12 @@ when evaluated and simply be ignored in a definition context. Use `substring-move!' instead. +** Deprecated: procedure->macro + +Change your code to use either procedure->memoizing-macro or, probably better, +to use r5rs macros. Also, be aware that macro expansion will not be done +during evaluation, but prior to evaluation. + * Changes to the C interface ** The struct scm_cell has been renamed to scm_t_cell @@ -159,6 +165,12 @@ instead. Use scm_c_source_property_breakpoint_p instead. +** Deprecated: scm_makmacro + +Change your code to use either scm_makmmacro or, probably better, to use r5rs +macros. Also, be aware that macro expansion will not be done during +evaluation, but prior to evaluation. + ** Removed from scm_root_state: def_inp, def_outp, def_errp, together with corresponding macros scm_def_inp, scm_def_outp and scm_def_errp. These were undocumented and unused copies of the standard ports at the diff --git a/libguile/ChangeLog b/libguile/ChangeLog index a7b81f2c2..5d3375721 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,13 @@ +2002-07-15 Dirk Herrmann + + * eval.c (SCM_CEVAL), macros.c (macro_print, scm_makmacro, + scm_sym_macro, scm_macro_type), macros.h (scm_makmacro): + Deprecated the special kind of built-in dynamic syntax transformer + that was inaccurately named "macro". Note: The built-in syntax + transformers that are named "mmacro" or "memoizing-macro" still + exist, and it is these which come much closer to what one would + call a macro. + 2002-07-13 Neil Jerram * eval.c (unmemocopy): Fix for diff --git a/libguile/eval.c b/libguile/eval.c index 68e0b78e6..8a07bfeb1 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -2290,8 +2290,7 @@ dispatch: SCM variable = SCM_CAR (x); if (SCM_ILOCP (variable)) location = scm_ilookup (variable, env); - else - if (SCM_VARIABLEP (variable)) + else if (SCM_VARIABLEP (variable)) location = SCM_VARIABLE_LOC (variable); else /* (SCM_SYMBOLP (variable)) is known to be true */ location = scm_lookupcar (x, env, 1); @@ -2754,6 +2753,7 @@ dispatch: SCM_ALLOW_INTS; PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto loop; +#if SCM_ENABLE_DEPRECATED == 1 case 1: x = arg1; if (SCM_NIMP (x)) @@ -2763,6 +2763,7 @@ dispatch: } else RETURN (arg1); +#endif case 0: RETURN (arg1); } diff --git a/libguile/macros.c b/libguile/macros.c index 590010a0e..467de2c02 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -72,8 +72,10 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate) if (SCM_MACRO_TYPE (macro) == 0) scm_puts ("syntax", port); - else if (SCM_MACRO_TYPE (macro) == 1) +#if SCM_ENABLE_DEPRECATED == 1 + if (SCM_MACRO_TYPE (macro) == 1) scm_puts ("macro", port); +#endif if (SCM_MACRO_TYPE (macro) == 2) scm_puts ("macro!", port); scm_putc (' ', port); @@ -110,6 +112,8 @@ SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0, #undef FUNC_NAME +#if SCM_ENABLE_DEPRECATED == 1 + SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0, (SCM code), "Return a @dfn{macro} which, when a symbol defined to this value\n" @@ -125,11 +129,18 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0, "@end lisp") #define FUNC_NAME s_scm_makmacro { + scm_c_issue_deprecation_warning + ("The function procedure->macro is deprecated, and so are" + " non-memoizing macros in general. Use memoizing macros" + " or r5rs macros instead."); + SCM_VALIDATE_PROC (1,code); SCM_RETURN_NEWSMOB (scm_tc16_macro | (1L << 16), SCM_UNPACK (code)); } #undef FUNC_NAME +#endif + SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0, (SCM code), @@ -161,7 +172,9 @@ SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0, SCM_SYMBOL (scm_sym_syntax, "syntax"); +#if SCM_ENABLE_DEPRECATED == 1 SCM_SYMBOL (scm_sym_macro, "macro"); +#endif SCM_SYMBOL (scm_sym_mmacro, "macro!"); SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, @@ -178,7 +191,9 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, switch (SCM_MACRO_TYPE (m)) { case 0: return scm_sym_syntax; +#if SCM_ENABLE_DEPRECATED == 1 case 1: return scm_sym_macro; +#endif case 2: return scm_sym_mmacro; default: scm_wrong_type_arg (FUNC_NAME, 1, m); } diff --git a/libguile/macros.h b/libguile/macros.h index 05f86ca9a..b41d4f234 100644 --- a/libguile/macros.h +++ b/libguile/macros.h @@ -3,7 +3,7 @@ #ifndef SCM_MACROS_H #define SCM_MACROS_H -/* Copyright (C) 1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001,2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -60,7 +60,6 @@ SCM_API scm_t_bits scm_tc16_macro; SCM_API SCM scm_makacro (SCM code); -SCM_API SCM scm_makmacro (SCM code); SCM_API SCM scm_makmmacro (SCM code); SCM_API SCM scm_macro_p (SCM obj); SCM_API SCM scm_macro_type (SCM m); @@ -71,6 +70,10 @@ SCM_API SCM scm_make_synt (const char *name, SCM (*fcn) ()); SCM_API void scm_init_macros (void); +#if SCM_ENABLE_DEPRECATED == 1 +SCM_API SCM scm_makmacro (SCM code); +#endif + #endif /* SCM_MACROS_H */ /* From c5d130619390fc3fd815011e69abe32fa8e13092 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 16 Jul 2002 20:57:34 +0000 Subject: [PATCH 061/306] Apply patch from M. Luedde on use of tail recursion to avoid stack overflow --- doc/tutorial/ChangeLog | 10 +++++++ doc/tutorial/guile-tut.texi | 60 +++++++++++++++++++++++++++++-------- 2 files changed, 58 insertions(+), 12 deletions(-) diff --git a/doc/tutorial/ChangeLog b/doc/tutorial/ChangeLog index eea1de221..b24d6004f 100644 --- a/doc/tutorial/ChangeLog +++ b/doc/tutorial/ChangeLog @@ -1,3 +1,13 @@ +2002-07-16 Neil Jerram + + * guile-tut.texi (Jump Start): Apply patch from M. Luedde on use + of tail recursion to avoid stack overflow (with minor editing). + +2002-07-14 Neil Jerram + + * guile-tut.texi (Jump Start): + (Jump Start): + 2001-11-18 Neil Jerram * guile-tut.texi (History of Guile and its motivations): Update diff --git a/doc/tutorial/guile-tut.texi b/doc/tutorial/guile-tut.texi index eb6345d86..e73f9b248 100644 --- a/doc/tutorial/guile-tut.texi +++ b/doc/tutorial/guile-tut.texi @@ -99,6 +99,7 @@ by the author. * Type Index:: @end menu + @node Jump Start @chapter Jump Start @@ -106,8 +107,8 @@ by the author. Before giving an overview of Guile, I present some simple commands and programs that you can type to get going immediately. -Start by invoking the Guile interpreter (usually you do this by just -typing @code{guile}). Then type (or paste) the following expressions at +Start by invoking the Guile interpreter. Usually you do this by just +typing @code{guile}. Then type (or paste) the following expressions at the prompt; the interpreter's response is preceded (in this manual) by @result{}. @@ -118,11 +119,26 @@ the prompt; the interpreter's response is preceded (in this manual) by (+ 20 35) @result{} 55 (define (recursive-factorial n) - (if (= n 0) - 1 - (* n (recursive-factorial (- n 1))))) + (if (zero? n) + 1 + (* n (recursive-factorial (- n 1))))) (recursive-factorial 5) @result{} 120 +(quit) +@end lisp + +In this example we did some simple arithmetic @code{(+ 20 35)} and got +the answer @code{55}. Then we coded the classic (and rather wasteful) +factorial algorithm and computed the factorial of @code{55}. Finally we +quit with @code{(quit)}. + +@cindex bignumbers +We can find out about some of Scheme's nice features by asking for the +factorial of some big number, say @code{500}. On some systems the +correct answer will be returned (I do not indicate calling and leaving +the guile session anymore). + +@lisp (recursive-factorial 500) @result{} 1220136825991110068701238785423046926253574342803192842192413588 3858453731538819976054964475022032818630136164771482035841633787 @@ -142,15 +158,35 @@ the prompt; the interpreter's response is preceded (in this manual) by 3896881639487469658817504506926365338175055478128640000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000 - @end lisp -In this example we did some simple arithmetic @code{(+ 20 35)} and got -the answer @code{55}. Then we coded the classic (and rather wasteful) -factorial algorithm, and got a glimpse of Scheme's nice -@emph{bignumbers} by asking for the factorial of 500. Then we quit -with @code{(quit)}. -@cindex bignumbers +The result is an example of Scheme's @emph{bignumbers}. However, there +are operating environments that provide (by default) too little stack +space. They will instead produce an error message like this: + +@lisp +(recursive-factorial 500) +@print{} +ERROR: Stack overflow +ABORT: (stack-overflow) +@end lisp + +Rather than enlarging the system's stack, we can implement the algorithm +such that it does not consume increasing stack space. This is called a +@emph{tail recursive} implementation. The following definition is tail +recursive and so should work on all systems. + +@lisp +(define (tail-recursive-factorial n) + (define (loop k l) + (if (zero? k) l + (loop (- k 1) (* k l)))) + (loop n 1)) + +(tail-recursive-factorial 500) +@result{} 1220136825991110068701238785423046926253574342803192842192413588 + ;; ... skipped +@end lisp This is the most basic use of Guile: a simple Scheme interpreter. In the rest of this tutorial I will show you how Guile has many facets: it From 3db03338199f4337178d6a07795f1c37b0c5107b Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 16 Jul 2002 22:25:49 +0000 Subject: [PATCH 062/306] New doc about stack overflow. --- doc/ref/ChangeLog | 5 +++++ doc/ref/scheme-options.texi | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 01d698795..8b8ff5a6b 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-07-16 Neil Jerram + + * scheme-options.texi (Debugger options): New subsection + describing stack overflow and what to do about it. + 2002-07-10 Gary Houston * scheme-modules.texi (Compiled Code Modules): Removed description diff --git a/doc/ref/scheme-options.texi b/doc/ref/scheme-options.texi index e67429a64..63b7a2c57 100644 --- a/doc/ref/scheme-options.texi +++ b/doc/ref/scheme-options.texi @@ -251,6 +251,40 @@ breakpoints no *Check for breakpoints. cheap yes *Flyweight representation of the stack at traps. @end smallexample +@subsection Stack overflow + +@cindex overflow, stack +@cindex stack overflow +Stack overflow errors are caused by a computation trying to use more +stack space than has been enabled by the @code{stack} option. They are +reported like this: + +@lisp +(non-tail-recursive-factorial 500) +@print{} +ERROR: Stack overflow +ABORT: (stack-overflow) +@end lisp + +If you get an error like this, you can either try rewriting your code to +use less stack space, or increase the maximum stack size. To increase +the maximum stack size, use @code{debug-set!}, for example: + +@lisp +(debug-set! stack 200000) +@result{} +(show-file-name #t stack 200000 debug backtrace depth 20 maxdepth 1000 frames 3 indent 10 width 79 procnames cheap) + +(non-tail-recursive-factorial 500) +@result{} +122013682599111006870123878542304692625357434@dots{} +@end lisp + +If you prefer to try rewriting your code, you may be able to save stack +space by making some of your procedures @dfn{tail recursive}. For a +description of what this means, see @ref{Proper tail +recursion,,,r5rs,The Revised^5 Report on Scheme}. + @node Examples of option use @section Examples of option use From 47f7fb362140c360f88981e675a0d71fa9b2158d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 17 Jul 2002 18:53:57 +0000 Subject: [PATCH 063/306] New. --- qt/arm.h | 0 qt/arm.s | 0 2 files changed, 0 insertions(+), 0 deletions(-) create mode 100644 qt/arm.h create mode 100644 qt/arm.s diff --git a/qt/arm.h b/qt/arm.h new file mode 100644 index 000000000..e69de29bb diff --git a/qt/arm.s b/qt/arm.s new file mode 100644 index 000000000..e69de29bb From 4923bb187ef9d22cb8479ace6e75f1a4bea38833 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 17 Jul 2002 18:54:57 +0000 Subject: [PATCH 064/306] Added configuration for ARM. --- guile-config/qthreads.m4 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/guile-config/qthreads.m4 b/guile-config/qthreads.m4 index e169f1cb5..8557620a5 100644 --- a/guile-config/qthreads.m4 +++ b/guile-config/qthreads.m4 @@ -127,6 +127,13 @@ AC_DEFUN([QTHREADS_CONFIGURE],[ qtmdc_c=md/null.c qtdmdb_s=md/axp_b.s ;; + arm*-*-*) + port_name=arm + qtmd_h=md/arm.h + qtmds_s=md/arm.s + qtmdc_c=md/null.c + qtdmdb_s= + ;; *) echo "Unknown configuration; threads package disabled" THREAD_PACKAGE="" From bb59ff52aff9af97dbfad423465051df2c367fa9 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 17 Jul 2002 18:55:20 +0000 Subject: [PATCH 065/306] *** empty log message *** --- guile-config/ChangeLog | 4 ++++ qt/ChangeLog | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/guile-config/ChangeLog b/guile-config/ChangeLog index d1c5e16d9..d938f4280 100644 --- a/guile-config/ChangeLog +++ b/guile-config/ChangeLog @@ -1,3 +1,7 @@ +2002-07-17 Marius Vollmer + + * qthreads.m4: Added configuration for ARM. + 2002-04-26 Marius Vollmer * Makefile.am (EXTRA_DIST): Added qthreads.m4. diff --git a/qt/ChangeLog b/qt/ChangeLog index da7c9509b..bc8f36856 100644 --- a/qt/ChangeLog +++ b/qt/ChangeLog @@ -1,3 +1,7 @@ +2002-07-17 Marius Vollmer + + * arm.s, arm.h: New. + 2002-02-24 Rob Browning * Makefile.am (libqthreads_la_LDFLAGS): use @LIBQTHREADS_INTERFACE@. From 0237895653e013fa727e08c877a39ce99350c5e5 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sat, 20 Jul 2002 01:21:36 +0000 Subject: [PATCH 066/306] * COPYING, README, Makefile.am, lib.scm, guile-benchmark: Copied from the test-suite directory, renamed and adapted for use with benchmarks. * benchmarks/logand.bm, benchmarks/continuations.bm, benchmarks/if.bm: Added as initial fairly stupid examples for benchmarks. --- benchmark-suite/COPYING | 340 ++++++++++++++++++++ benchmark-suite/ChangeLog | 13 + benchmark-suite/Makefile.am | 15 + benchmark-suite/README | 18 ++ benchmark-suite/benchmarks/continuations.bm | 5 + benchmark-suite/benchmarks/if.bm | 51 +++ benchmark-suite/benchmarks/logand.bm | 6 + benchmark-suite/guile-benchmark | 220 +++++++++++++ benchmark-suite/lib.scm | 268 +++++++++++++++ 9 files changed, 936 insertions(+) create mode 100644 benchmark-suite/COPYING create mode 100644 benchmark-suite/ChangeLog create mode 100644 benchmark-suite/Makefile.am create mode 100644 benchmark-suite/README create mode 100644 benchmark-suite/benchmarks/continuations.bm create mode 100644 benchmark-suite/benchmarks/if.bm create mode 100644 benchmark-suite/benchmarks/logand.bm create mode 100755 benchmark-suite/guile-benchmark create mode 100644 benchmark-suite/lib.scm diff --git a/benchmark-suite/COPYING b/benchmark-suite/COPYING new file mode 100644 index 000000000..eeb586b39 --- /dev/null +++ b/benchmark-suite/COPYING @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog new file mode 100644 index 000000000..0f9f90638 --- /dev/null +++ b/benchmark-suite/ChangeLog @@ -0,0 +1,13 @@ +2002-07-20 Dirk Herrmann + + * COPYING, README, Makefile.am, lib.scm, guile-benchmark: Copied + from the test-suite directory, renamed and adapted for use with + benchmarks. + + * benchmarks/logand.bm, benchmarks/continuations.bm, + benchmarks/if.bm: Added as initial fairly stupid examples for + benchmarks. + +2002-07-20 Dirk Herrmann + + * Log begins. diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am new file mode 100644 index 000000000..4bb81e49e --- /dev/null +++ b/benchmark-suite/Makefile.am @@ -0,0 +1,15 @@ +SCM_BENCHMARKS = benchmarks/foo.bm \ + benchmarks/bar.bm + +## SCM_BENCHMARKS_DIRS = benchmarks/dirfoo \ +## benchmarks/dirbar + +EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) + +## Automake should be able to handle the distribution of benchmarks/dirfoo +## etc without any help, but not all version can handle 'deep' +## directories. So we do it on our own. +dist-hook: + for d in $(SCM_BENCHMARKS_DIRS); do \ + cp -pR $(srcdir)/$$d $(distdir)/$$d; \ + done diff --git a/benchmark-suite/README b/benchmark-suite/README new file mode 100644 index 000000000..186a74351 --- /dev/null +++ b/benchmark-suite/README @@ -0,0 +1,18 @@ +This directory contains some benchmarks for Guile, and some generic +benchmarking support code. + +To run these benchmarks, you will need a version of Guile more recent +than 15 Feb 1999 --- the benchmarks use the (ice-9 and-let*) and +(ice-9 getopt-long) modules, which were added to Guile around then. + +For information about how to run the benchmark suite, read the usage +instructions in the comments at the top of the guile-benchmark script. + +You can reference the file `lib.scm' from your own code as the module +(benchmark-suite lib); it also has comments at the top and before each +function explaining what's going on. + +Please write more Guile benchmarks, and send them to bug-guile@gnu.org. +We'll merge them into the distribution. All benchmark suites must be +licensed for our use under the GPL, but I don't think we're going to +collect assignment papers for them. diff --git a/benchmark-suite/benchmarks/continuations.bm b/benchmark-suite/benchmarks/continuations.bm new file mode 100644 index 000000000..7c44300f7 --- /dev/null +++ b/benchmark-suite/benchmarks/continuations.bm @@ -0,0 +1,5 @@ +(define (callee continuation) + (continuation #t)) + +(benchmark "call/cc" 300 + (call-with-current-continuation callee)) diff --git a/benchmark-suite/benchmarks/if.bm b/benchmark-suite/benchmarks/if.bm new file mode 100644 index 000000000..30c22c9c3 --- /dev/null +++ b/benchmark-suite/benchmarks/if.bm @@ -0,0 +1,51 @@ +(with-benchmark-prefix "if--then-else" + + (benchmark "executing then" 330000 + (if (quote #t) #t #f)) + + (benchmark "executing else" 330000 + (if (quote #f) #t #f))) + +(with-benchmark-prefix "if--then" + + (benchmark "executing then" 330000 + (if (quote #t) #t)) + + (benchmark "executing else" 330000 + (if (quote #f) #t))) + +(with-benchmark-prefix "if--then-else" + + (let ((x #t)) + (benchmark "executing then" 330000 + (if x #t #f))) + + (let ((x #f)) + (benchmark "executing else" 330000 + (if x #t #f)))) + +(with-benchmark-prefix "if--then" + + (let ((x #t)) + (benchmark "executing then" 330000 + (if x #t))) + + (let ((x #f)) + (benchmark "executing else" 330000 + (if x #t)))) + +(with-benchmark-prefix "if--then-else" + + (benchmark "executing then" 330000 + (if #t #t #f)) + + (benchmark "executing else" 330000 + (if #f #t #f))) + +(with-benchmark-prefix "if--then" + + (benchmark "executing then" 330000 + (if #t #t)) + + (benchmark "executing else" 330000 + (if #f #t))) diff --git a/benchmark-suite/benchmarks/logand.bm b/benchmark-suite/benchmarks/logand.bm new file mode 100644 index 000000000..cdb05e88d --- /dev/null +++ b/benchmark-suite/benchmarks/logand.bm @@ -0,0 +1,6 @@ +(define bignum (1- (expt 2 128))) + +(let* ((i 0)) + (benchmark "bignum" 130000 + (logand i bignum) + (set! i (+ i 1)))) diff --git a/benchmark-suite/guile-benchmark b/benchmark-suite/guile-benchmark new file mode 100755 index 000000000..58f061749 --- /dev/null +++ b/benchmark-suite/guile-benchmark @@ -0,0 +1,220 @@ +#!../libguile/guile \ +-e main -s +!# + +;;;; guile-benchmark --- run the Guile benchmark suite +;;;; Adapted from code by Jim Blandy --- May 1999 +;;;; +;;;; Copyright (C) 2002 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +;;;; Boston, MA 02111-1307 USA + + +;;;; Usage: [guile -e main -s] guile-benchmark [OPTIONS] [BENCHMARK ...] +;;;; +;;;; Run benchmarks from the Guile benchmark suite. Report timing +;;;; results to the standard output, along with a summary of all +;;;; the results. Record each reported benchmark outcome in the log +;;;; file, `benchmarks.log'. +;;;; +;;;; Normally, guile-benchmark scans the benchmark directory, and +;;;; executes all files whose names end in `.bm'. (It assumes they contain +;;;; Scheme code.) However, you can have it execute specific benchmarks by +;;;; listing their filenames on the command line. +;;;; +;;;; The option `--benchmark-suite' can be given to specify the benchmark +;;;; directory. If no such option is given, the benchmark directory is +;;;; taken from the environment variable BENCHMARK_SUITE_DIR (if defined), +;;;; otherwise a default directory that is hardcoded in this file is +;;;; used (see "Installation" below). +;;;; +;;;; If present, the `--iteration-factor FACTOR' option tells +;;;; `guile-benchmark' to multiply the number of iterations given with +;;;; each single benchmark by the value of FACTOR. This allows to +;;;; reduce or increase the total time for benchmarking. +;;;; +;;;; If present, the `--log-file LOG' option tells `guile-benchmark' to put +;;;; the log output in a file named LOG. +;;;; +;;;; If present, the `--debug' option will enable a debugging mode. +;;;; +;;;; +;;;; Installation: +;;;; +;;;; If you change the #! line at the top of this script to point at +;;;; the Guile interpreter you want to run, you can call this script +;;;; as an executable instead of having to pass it as a parameter to +;;;; guile via "guile -e main -s guile-benchmark". Further, you can edit +;;;; the definition of default-benchmark-suite to point to the parent +;;;; directory of the `benchmarks' tree, which makes it unnecessary to set +;;;; the environment variable `BENCHMARK_SUITE_DIR'. +;;;; +;;;; +;;;; Shortcomings: +;;;; +;;;; At the moment, due to a simple-minded implementation, benchmark files +;;;; must live in the benchmark directory, and you must specify their names +;;;; relative to the top of the benchmark directory. If you want to send +;;;; me a patch that fixes this, but still leaves sane benchmark names in +;;;; the log file, that would be great. At the moment, all the benchmarks +;;;; I care about are in the benchmark directory, though. +;;;; +;;;; It would be nice if you could specify the Guile interpreter you +;;;; want to benchmark on the command line. As it stands, if you want to +;;;; change which Guile interpreter you're benchmarking, you need to edit +;;;; the #! line at the top of this file, which is stupid. + + +;;; User configurable settings: +(define default-benchmark-suite + (string-append (getenv "HOME") "/bogus-path/benchmark-suite")) + + +(use-modules (benchmark-suite lib) + (ice-9 getopt-long) + (ice-9 and-let-star) + (ice-9 rdelim)) + + +;;; Variables that will receive their actual values later. +(define benchmark-suite default-benchmark-suite) + +(define tmp-dir #f) + + +;;; General utilities, that probably should be in a library somewhere. + +;;; Enable debugging +(define (enable-debug-mode) + (write-line %load-path) + (set! %load-verbosely #t) + (debug-enable 'backtrace 'debug)) + +;;; Traverse the directory tree at ROOT, applying F to the name of +;;; each file in the tree, including ROOT itself. For a subdirectory +;;; SUB, if (F SUB) is true, we recurse into SUB. Do not follow +;;; symlinks. +(define (for-each-file f root) + + ;; A "hard directory" is a path that denotes a directory and is not a + ;; symlink. + (define (file-is-hard-directory? filename) + (eq? (stat:type (lstat filename)) 'directory)) + + (let visit ((root root)) + (let ((should-recur (f root))) + (if (and should-recur (file-is-hard-directory? root)) + (let ((dir (opendir root))) + (let loop () + (let ((entry (readdir dir))) + (cond + ((eof-object? entry) #f) + ((or (string=? entry ".") + (string=? entry "..") + (string=? entry "CVS") + (string=? entry "RCS")) + (loop)) + (else + (visit (string-append root "/" entry)) + (loop)))))))))) + + +;;; The benchmark driver. + + +;;; Localizing benchmark files and temporary data files. + +(define (data-file-name filename) + (in-vicinity tmp-dir filename)) + +(define (benchmark-file-name benchmark) + (in-vicinity benchmark-suite benchmark)) + +;;; Return a list of all the benchmark files in the benchmark tree. +(define (enumerate-benchmarks benchmark-dir) + (let ((root-len (+ 1 (string-length benchmark-dir))) + (benchmarks '())) + (for-each-file (lambda (file) + (if (has-suffix? file ".bm") + (let ((short-name + (substring file root-len))) + (set! benchmarks (cons short-name benchmarks)))) + #t) + benchmark-dir) + + ;; for-each-file presents the files in whatever order it finds + ;; them in the directory. We sort them here, so they'll always + ;; appear in the same order. This makes it easier to compare benchmark + ;; log files mechanically. + (sort benchmarks stringnumber (opt 'iteration-factor "1"))) + + ;; directory where temporary files are created. + (set! tmp-dir (getcwd)) + + (let* ((benchmarks + (let ((foo (opt '() '()))) + (if (null? foo) + (enumerate-benchmarks benchmark-suite) + foo))) + (log-file + (opt 'log-file "benchmarks.log"))) + + ;; Open the log file. + (let ((log-port (open-output-file log-file))) + + ;; Register some reporters. + (register-reporter (make-log-reporter log-port)) + (register-reporter user-reporter) + + ;; Run the benchmarks. + (for-each (lambda (benchmark) + (with-benchmark-prefix benchmark + (load (benchmark-file-name benchmark)))) + benchmarks) + (close-port log-port))))) + + +;;; Local Variables: +;;; mode: scheme +;;; End: diff --git a/benchmark-suite/lib.scm b/benchmark-suite/lib.scm new file mode 100644 index 000000000..2eb858228 --- /dev/null +++ b/benchmark-suite/lib.scm @@ -0,0 +1,268 @@ +;;;; benchmark-suite/lib.scm --- generic support for benchmarking +;;;; Copyright (C) 2002 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +;;;; Boston, MA 02111-1307 USA + +(define-module (benchmark-suite lib) + :export ( + + ;; Controlling the execution. + iteration-factor + scale-iterations + + ;; Running benchmarks. + run-benchmark + benchmark + + ;; Naming groups of benchmarks in a regular fashion. + with-benchmark-prefix with-benchmark-prefix* current-benchmark-prefix + format-benchmark-name + + ;; Reporting results in various ways. + register-reporter unregister-reporter reporter-registered? + make-log-reporter + full-reporter + user-reporter)) + +;;;; MISCELLANEOUS +;;;; + +;;; Scale the number of iterations according to the given scaling factor. +(define iteration-factor 1) +(define (scale-iterations iterations) + (let* ((i (inexact->exact (round (* iterations iteration-factor))))) + (if (< i 1) 1 i))) + +;;;; CORE FUNCTIONS +;;;; + +;;; The central routine for executing benchmarks. +;;; The idea is taken from Greg, the GNUstep regression test environment. +(define run-benchmark #f) +(let ((benchmark-running #f)) + (define (local-run-benchmark name iterations thunk) + (if benchmark-running + (error "Nested calls to run-benchmark are not permitted.") + (let ((benchmark-name (full-name name)) + (iterations (scale-iterations iterations))) + (set! benchmark-running #t) + (let ((before #f) (after #f) (gc-time #f)) + (gc) + (set! gc-time (gc-run-time)) + (set! before (times)) + (do ((i 0 (+ i 1))) + ((= i iterations)) + (thunk)) + (set! after (times)) + (set! gc-time (- (gc-run-time) gc-time)) + (report benchmark-name iterations before after gc-time)) + (set! benchmark-running #f)))) + (set! run-benchmark local-run-benchmark)) + +;;; A short form for benchmarks. +(defmacro benchmark (name iterations body . rest) + `(,run-benchmark ,name ,iterations (lambda () ,body ,@rest))) + + +;;;; BENCHMARK NAMES +;;;; + +;;;; Turn a benchmark name into a nice human-readable string. +(define (format-benchmark-name name) + (call-with-output-string + (lambda (port) + (let loop ((name name) + (separator "")) + (if (pair? name) + (begin + (display separator port) + (display (car name) port) + (loop (cdr name) ": "))))))) + +;;;; For a given benchmark-name, deliver the full name including all prefixes. +(define (full-name name) + (append (current-benchmark-prefix) (list name))) + +;;; A fluid containing the current benchmark prefix, as a list. +(define prefix-fluid (make-fluid)) +(fluid-set! prefix-fluid '()) +(define (current-benchmark-prefix) + (fluid-ref prefix-fluid)) + +;;; Postpend PREFIX to the current name prefix while evaluting THUNK. +;;; The name prefix is only changed within the dynamic scope of the +;;; call to with-benchmark-prefix*. Return the value returned by THUNK. +(define (with-benchmark-prefix* prefix thunk) + (with-fluids ((prefix-fluid + (append (fluid-ref prefix-fluid) (list prefix)))) + (thunk))) + +;;; (with-benchmark-prefix PREFIX BODY ...) +;;; Postpend PREFIX to the current name prefix while evaluating BODY ... +;;; The name prefix is only changed within the dynamic scope of the +;;; with-benchmark-prefix expression. Return the value returned by the last +;;; BODY expression. +(defmacro with-benchmark-prefix (prefix . body) + `(with-benchmark-prefix* ,prefix (lambda () ,@body))) + + +;;;; TIME CALCULATION +;;;; + +(define time-base + internal-time-units-per-second) + +(define frame-time/iteration + "") + +(define (total-time before after) + (- (tms:clock after) (tms:clock before))) + +(define (user-time before after) + (- (tms:utime after) (tms:utime before))) + +(define (system-time before after) + (- (tms:stime after) (tms:stime before))) + +(define (frame-time iterations) + (* iterations frame-time/iteration)) + +(define (benchmark-time iterations before after) + (- (user-time before after) (frame-time iterations))) + +(define (user-time\interpreter before after gc-time) + (- (user-time before after) gc-time)) + +(define (benchmark-time\interpreter iterations before after gc-time) + (- (benchmark-time iterations before after) gc-time)) + + +;;;; REPORTERS +;;;; + +;;; The global list of reporters. +(define reporters '()) + +;;; The default reporter, to be used only if no others exist. +(define default-reporter #f) + +;;; Add the procedure REPORTER to the current set of reporter functions. +;;; Signal an error if that reporter procedure object is already registered. +(define (register-reporter reporter) + (if (memq reporter reporters) + (error "register-reporter: reporter already registered: " reporter)) + (set! reporters (cons reporter reporters))) + +;;; Remove the procedure REPORTER from the current set of reporter +;;; functions. Signal an error if REPORTER is not currently registered. +(define (unregister-reporter reporter) + (if (memq reporter reporters) + (set! reporters (delq! reporter reporters)) + (error "unregister-reporter: reporter not registered: " reporter))) + +;;; Return true iff REPORTER is in the current set of reporter functions. +(define (reporter-registered? reporter) + (if (memq reporter reporters) #t #f)) + +;;; Send RESULT to all currently registered reporter functions. +(define (report . args) + (if (pair? reporters) + (for-each (lambda (reporter) (apply reporter args)) + reporters) + (apply default-reporter args))) + + +;;;; Some useful standard reporters: +;;;; Log reporters write all test results to a given log file. +;;;; Full reporters write all benchmark results to the standard output. +;;;; User reporters write some interesting results to the standard output. + +;;; Display a single benchmark result to the given port +(define (print-result port name iterations before after gc-time) + (let* ((name (format-benchmark-name name)) + (total-time (total-time before after)) + (user-time (user-time before after)) + (system-time (system-time before after)) + (frame-time (frame-time iterations)) + (benchmark-time (benchmark-time iterations before after)) + (user-time\interpreter (user-time\interpreter before after gc-time)) + (benchmark-time\interpreter + (benchmark-time\interpreter iterations before after gc-time))) + (write (list name iterations + "total:" (/ total-time time-base) + "user:" (/ user-time time-base) + "system:" (/ system-time time-base) + "frame:" (/ frame-time time-base) + "benchmark:" (/ benchmark-time time-base) + "user/interp:" (/ user-time\interpreter time-base) + "bench/interp:" (/ benchmark-time\interpreter time-base) + "gc:" (/ gc-time time-base)) + port) + (newline port))) + +;;; Return a reporter procedure which prints all results to the file +;;; FILE, in human-readable form. FILE may be a filename, or a port. +(define (make-log-reporter file) + (let ((port (if (output-port? file) file + (open-output-file file)))) + (lambda args + (apply print-result port args) + (force-output port)))) + +;;; A reporter that reports all results to the user. +(define (full-reporter . args) + (apply print-result (current-output-port) args)) + +;;; Display interesting results of a single benchmark to the given port +(define (print-user-result port name iterations before after gc-time) + (let* ((name (format-benchmark-name name)) + (user-time (user-time before after)) + (benchmark-time (benchmark-time iterations before after)) + (benchmark-time\interpreter + (benchmark-time\interpreter iterations before after gc-time))) + (write (list name iterations + "user:" (/ user-time time-base) + "benchmark:" (/ benchmark-time time-base) + "bench/interp:" (/ benchmark-time\interpreter time-base) + "gc:" (/ gc-time time-base)) + port) + (newline port))) + +;;; A reporter that reports interesting results to the user. +(define (user-reporter . args) + (apply print-user-result (current-output-port) args)) + + +;;;; Initialize the benchmarking system: +;;;; + +;;; First, make sure the benchmarking routines are compiled. +(define (null-reporter . args) #t) +(set! default-reporter null-reporter) +(benchmark "empty initialization benchmark" 2 #t) + +;;; Second, initialize the system constants +(define (initialization-reporter name iterations before after gc-time) + (let* ((frame-time (- (tms:utime after) (tms:utime before) gc-time 3))) + (set! frame-time/iteration (/ frame-time iterations)) + (display ";; frame time per iteration: " (current-output-port)) + (display (/ frame-time/iteration time-base) (current-output-port)) + (newline (current-output-port)))) +(set! default-reporter initialization-reporter) +(benchmark "empty initialization benchmark" 524288 #t) + +;;; Finally, set the default reporter +(set! default-reporter user-reporter) From dd897aafbd218685874256405f740a0e9e1e7303 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sat, 20 Jul 2002 01:30:36 +0000 Subject: [PATCH 067/306] * benchmark-guile.in: Copied from check-guile.in and adapted for use with benchmarks. * Makefile.am: Recurse into the benchmark-suite subdir. * configure.in: Added benchmarking files. --- ChangeLog | 9 +++++++++ Makefile.am | 2 +- benchmark-guile.in | 48 ++++++++++++++++++++++++++++++++++++++++++++++ configure.in | 3 +++ 4 files changed, 61 insertions(+), 1 deletion(-) create mode 100644 benchmark-guile.in diff --git a/ChangeLog b/ChangeLog index 1ede0de4c..d5b044ce6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2002-07-20 Dirk Herrmann + + * benchmark-guile.in: Copied from check-guile.in and adapted for + use with benchmarks. + + * Makefile.am: Recurse into the benchmark-suite subdir. + + * configure.in: Added benchmarking files. + 2002-07-12 Gary Houston * configure.in: check dynamic linking before modules. Add dynl.c diff --git a/Makefile.am b/Makefile.am index 2b40ebf19..d40a4b2e8 100644 --- a/Makefile.am +++ b/Makefile.am @@ -22,7 +22,7 @@ AUTOMAKE_OPTIONS = 1.5 SUBDIRS = oop qt libltdl libguile ice-9 guile-config guile-readline \ - scripts srfi doc examples test-suite lang am + scripts srfi doc examples test-suite benchmark-suite lang am bin_SCRIPTS = guile-tools diff --git a/benchmark-guile.in b/benchmark-guile.in new file mode 100644 index 000000000..af1ade616 --- /dev/null +++ b/benchmark-guile.in @@ -0,0 +1,48 @@ +#! /bin/sh +# Usage: benchmark-guile [-i GUILE-INTERPRETER] [GUILE-BENCHMARK-ARGS] +# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/pre-inst-guile. +# See ${top_srcdir}/benchmark-suite/guile-benchmark for documentation on GUILE-BENCHMARK-ARGS. +# +# Example invocations: +# ./benchmark-guile +# ./benchmark-guile numbers.bm +# ./benchmark-guile -i /usr/local/bin/guile +# ./benchmark-guile -i /usr/local/bin/guile numbers.bm + +set -e + +top_builddir=@top_builddir_absolute@ +top_srcdir=@top_srcdir_absolute@ + +BENCHMARK_SUITE_DIR=${top_srcdir}/benchmark-suite + +if [ x"$1" = x-i ] ; then + guile=$2 + shift + shift +else + guile=${top_builddir}/pre-inst-guile +fi + +GUILE_LOAD_PATH=$BENCHMARK_SUITE_DIR +export GUILE_LOAD_PATH + +if [ -f "$guile" -a -x "$guile" ] ; then + echo Benchmarking $guile ... "$@" + echo with GUILE_LOAD_PATH=$GUILE_LOAD_PATH +else + echo ERROR: Cannot execute $guile + exit 1 +fi + +# documentation searching ignores GUILE_LOAD_PATH. +if [ ! -f guile-procedures.txt ] ; then + @LN_S@ libguile/guile-procedures.txt . +fi + +exec $guile \ + -e main -s "$BENCHMARK_SUITE_DIR/guile-benchmark" \ + --benchmark-suite "$BENCHMARK_SUITE_DIR/benchmarks" \ + --log-file benchmark-guile.log "$@" + +# benchmark-guile ends here diff --git a/configure.in b/configure.in index 3c554ee5c..e052141cc 100644 --- a/configure.in +++ b/configure.in @@ -840,6 +840,8 @@ AC_CONFIG_FILES([ examples/safe/Makefile test-suite/Makefile check-guile + benchmark-suite/Makefile + benchmark-guile guile-tools pre-inst-guile]) @@ -849,6 +851,7 @@ AC_CONFIG_COMMANDS(default, libguile/guile-func-name-check \ libguile/guile-snarf-docs \ check-guile \ + benchmark-guile \ guile-tools \ pre-inst-guile]) From 34d19ef64368a8bac8a32f799b71dc05dd587654 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 20 Jul 2002 14:08:34 +0000 Subject: [PATCH 068/306] 2002-07-20 Han-Wen * *.c: add space after commas everywhere. * *.c: use SCM_VECTOR_SET everywhere, where a vector is written. Document cases where SCM_WRITABLE_VELTS() is used. * vectors.h (SCM_VELTS): prepare for write barrier, and let SCM_VELTS() return a const pointer (SCM_VECTOR_SET): add macro. * autogen.sh (mscripts): find and check version number of autoconf. Complain if 2.53 is not found. --- ChangeLog | 5 ++ autogen.sh | 22 +++++++- libguile/ChangeLog | 11 ++++ libguile/_scm.h | 4 +- libguile/async.c | 2 +- libguile/backtrace.c | 14 ++--- libguile/chars.c | 70 ++++++++++++------------- libguile/continuations.h | 2 +- libguile/convert.i.c | 10 ++-- libguile/debug.c | 20 ++++---- libguile/environments.c | 72 ++++++++++++++++++++------ libguile/error.c | 4 +- libguile/eval.c | 22 ++++---- libguile/evalext.c | 2 +- libguile/filesys.c | 81 +++++++++++++++-------------- libguile/fluids.c | 6 +-- libguile/gc.h | 19 +++++-- libguile/gh.h | 2 +- libguile/gh_data.c | 7 +-- libguile/goops.c | 46 +++++++++++------ libguile/hash.c | 2 +- libguile/hashtab.c | 26 +++++----- libguile/hooks.c | 6 +-- libguile/init.c | 2 +- libguile/ioext.c | 16 +++--- libguile/lang.c | 4 +- libguile/list.c | 18 +++---- libguile/load.c | 4 +- libguile/macros.c | 10 ++-- libguile/modules.h | 2 +- libguile/net_db.c | 45 ++++++++-------- libguile/numbers.c | 8 +-- libguile/objects.c | 8 +-- libguile/objects.h | 2 +- libguile/ports.c | 58 ++++++++++----------- libguile/ports.h | 6 +-- libguile/posix.c | 108 +++++++++++++++++++-------------------- libguile/print.c | 23 ++++----- libguile/procprop.c | 8 +-- libguile/ramap.c | 40 ++++++++------- libguile/random.c | 32 ++++++------ libguile/read.c | 4 +- libguile/regex-posix.c | 8 +-- libguile/scmsigs.c | 33 ++++++------ libguile/simpos.c | 2 +- libguile/smob.c | 6 +-- libguile/smob.h | 6 +-- libguile/socket.c | 81 +++++++++++++++-------------- libguile/sort.c | 70 +++++++++++++++---------- libguile/srcprop.c | 12 ++--- libguile/srcprop.h | 8 +-- libguile/stacks.c | 26 +++++----- libguile/stime.c | 34 ++++++------ libguile/strings.c | 6 +-- libguile/strop.c | 40 +++++++-------- libguile/struct.c | 26 +++++----- libguile/symbols.c | 10 ++-- libguile/tags.h | 2 +- libguile/throw.c | 6 +-- libguile/unif.c | 35 +++++++------ libguile/unif.h | 4 +- libguile/validate.h | 12 ++--- libguile/variable.h | 2 +- libguile/vectors.c | 44 +++++++++------- libguile/vectors.h | 15 ++++-- libguile/vports.c | 2 +- libguile/weaks.c | 11 ++-- 67 files changed, 739 insertions(+), 615 deletions(-) diff --git a/ChangeLog b/ChangeLog index d5b044ce6..73413fcb0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2002-07-20 Han-Wen + + * autogen.sh (mscripts): find and check version number of + autoconf. Complain if 2.53 is not found. + 2002-07-20 Dirk Herrmann * benchmark-guile.in: Copied from check-guile.in and adapted for diff --git a/autogen.sh b/autogen.sh index a41df1179..ef7b58af8 100755 --- a/autogen.sh +++ b/autogen.sh @@ -85,8 +85,26 @@ fi ###################################################################### -autoheader -autoconf + +# configure.in reqs autoconf-2.53; try to find it +for suf in "-2.53" "2.53" "" false; do + version=`autoconf$suf --version 2>/dev/null | head -1 | awk '{print $NF}' | awk -F. '{print $1 * 100 + $2}'` + if test "0$version" -eq 253; then + autoconf=autoconf$suf + autoheader=autoheader$suf + break + fi +done + +if test -z "$autoconf"; then + echo "ERROR: Please install autoconf 2.53" + exit 1 +fi + + +################################################################ +$autoheader +$autoconf # Automake has a bug that will let it only add one copy of a missing # file. We need two mdate-sh, tho, one in doc/ref/ and one in diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5d3375721..3f95b31ed 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,14 @@ +2002-07-20 Han-Wen + + * *.c: add space after commas everywhere. + + * *.c: use SCM_VECTOR_SET everywhere, where a vector is written. + Document cases where SCM_WRITABLE_VELTS() is used. + + * vectors.h (SCM_VELTS): prepare for write barrier, and let + SCM_VELTS() return a const pointer + (SCM_VECTOR_SET): add macro. + 2002-07-15 Dirk Herrmann * eval.c (SCM_CEVAL), macros.c (macro_print, scm_makmacro, diff --git a/libguile/_scm.h b/libguile/_scm.h index 0a1c3f4fe..7fedd5c00 100644 --- a/libguile/_scm.h +++ b/libguile/_scm.h @@ -125,10 +125,10 @@ #ifndef min -#define min(A,B) ((A) <= (B) ? (A) : (B)) +#define min(A, B) ((A) <= (B) ? (A) : (B)) #endif #ifndef max -#define max(A,B) ((A) >= (B) ? (A) : (B)) +#define max(A, B) ((A) >= (B) ? (A) : (B)) #endif #endif /* SCM__SCM_H */ diff --git a/libguile/async.c b/libguile/async.c index 118a0d0e6..f0a2b2eae 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -115,7 +115,7 @@ static scm_t_bits tc16_async; /* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it. this is ugly. */ #define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X) -#define VALIDATE_ASYNC(pos,a) SCM_MAKE_VALIDATE(pos, a, ASYNCP) +#define VALIDATE_ASYNC(pos, a) SCM_MAKE_VALIDATE(pos, a, ASYNCP) #define ASYNC_GOT_IT(X) (SCM_CELL_WORD_0 (X) >> 16) #define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) << 16))) diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 6c707ac90..b75031cf5 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -132,7 +132,7 @@ scm_display_error_message (SCM message, SCM args, SCM port) } static void -display_expression (SCM frame,SCM pname,SCM source,SCM port) +display_expression (SCM frame, SCM pname, SCM source, SCM port) { SCM print_state = scm_make_print_state (); scm_print_state *pstate = SCM_PRINT_STATE (print_state); @@ -335,7 +335,7 @@ indent (int n, SCM port) } static void -display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM port,scm_print_state *pstate) +display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, SCM port, scm_print_state *pstate) { SCM string; int i = 0, n; @@ -377,7 +377,7 @@ display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM po } static void -display_application (SCM frame,int indentation,SCM sport,SCM port,scm_print_state *pstate) +display_application (SCM frame, int indentation, SCM sport, SCM port, scm_print_state *pstate) { SCM proc = SCM_FRAME_PROC (frame); SCM name = (!SCM_FALSEP (scm_procedure_p (proc)) @@ -400,15 +400,15 @@ SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0, "output.") #define FUNC_NAME s_scm_display_application { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); if (SCM_UNBNDP (port)) port = scm_cur_outp; else - SCM_VALIDATE_OPOUTPORT (2,port); + SCM_VALIDATE_OPOUTPORT (2, port); if (SCM_UNBNDP (indent)) indent = SCM_INUM0; else - SCM_VALIDATE_INUM (3,indent); + SCM_VALIDATE_INUM (3, indent); if (SCM_FRAME_PROC_P (frame)) /* Display an application. */ @@ -524,7 +524,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) } static void -display_frame (SCM frame,int nfield,int indentation,SCM sport,SCM port,scm_print_state *pstate) +display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_print_state *pstate) { int n, i, j; diff --git a/libguile/chars.c b/libguile/chars.c index cbc2cb5e8..f9800dfed 100644 --- a/libguile/chars.c +++ b/libguile/chars.c @@ -76,8 +76,8 @@ SCM_DEFINE1 (scm_char_less_p, "char?", scm_tc7_rpsubr, "sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_gr_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(SCM_CHAR(x) > SCM_CHAR(y)); } #undef FUNC_NAME @@ -112,8 +112,8 @@ SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr, "ASCII sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_geq_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(SCM_CHAR(x) >= SCM_CHAR(y)); } #undef FUNC_NAME @@ -124,8 +124,8 @@ SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr, "case, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_eq_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(scm_upcase(SCM_CHAR(x))==scm_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -136,8 +136,8 @@ SCM_DEFINE1 (scm_char_ci_less_p, "char-ci?", scm_tc7_rpsubr, "sequence ignoring case, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_gr_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(scm_upcase(SCM_CHAR(x)) > scm_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -172,8 +172,8 @@ SCM_DEFINE1 (scm_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr, "ASCII sequence ignoring case, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_geq_p { - SCM_VALIDATE_CHAR (1,x); - SCM_VALIDATE_CHAR (2,y); + SCM_VALIDATE_CHAR (1, x); + SCM_VALIDATE_CHAR (2, y); return SCM_BOOL(scm_upcase(SCM_CHAR(x)) >= scm_upcase(SCM_CHAR(y))); } #undef FUNC_NAME @@ -185,7 +185,7 @@ SCM_DEFINE (scm_char_alphabetic_p, "char-alphabetic?", 1, 0, 0, "Alphabetic means the same thing as the isalpha C library function.") #define FUNC_NAME s_scm_char_alphabetic_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(isalpha(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -196,7 +196,7 @@ SCM_DEFINE (scm_char_numeric_p, "char-numeric?", 1, 0, 0, "Numeric means the same thing as the isdigit C library function.") #define FUNC_NAME s_scm_char_numeric_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(isdigit(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -207,7 +207,7 @@ SCM_DEFINE (scm_char_whitespace_p, "char-whitespace?", 1, 0, 0, "Whitespace means the same thing as the isspace C library function.") #define FUNC_NAME s_scm_char_whitespace_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(isspace(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -220,7 +220,7 @@ SCM_DEFINE (scm_char_upper_case_p, "char-upper-case?", 1, 0, 0, "Uppercase means the same thing as the isupper C library function.") #define FUNC_NAME s_scm_char_upper_case_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(isupper(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -232,7 +232,7 @@ SCM_DEFINE (scm_char_lower_case_p, "char-lower-case?", 1, 0, 0, "Lowercase means the same thing as the islower C library function.") #define FUNC_NAME s_scm_char_lower_case_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL(islower(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -246,7 +246,7 @@ SCM_DEFINE (scm_char_is_both_p, "char-is-both?", 1, 0, 0, "C library functions.") #define FUNC_NAME s_scm_char_is_both_p { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_BOOL((isupper(SCM_CHAR(chr)) || islower(SCM_CHAR(chr)))); } #undef FUNC_NAME @@ -260,7 +260,7 @@ SCM_DEFINE (scm_char_to_integer, "char->integer", 1, 0, 0, "ASCII sequence.") #define FUNC_NAME s_scm_char_to_integer { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return scm_ulong2num((unsigned long)SCM_CHAR(chr)); } #undef FUNC_NAME @@ -283,7 +283,7 @@ SCM_DEFINE (scm_char_upcase, "char-upcase", 1, 0, 0, "Return the uppercase character version of @var{chr}.") #define FUNC_NAME s_scm_char_upcase { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_MAKE_CHAR(scm_upcase(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -294,7 +294,7 @@ SCM_DEFINE (scm_char_downcase, "char-downcase", 1, 0, 0, "Return the lowercase character version of @var{chr}.") #define FUNC_NAME s_scm_char_downcase { - SCM_VALIDATE_CHAR (1,chr); + SCM_VALIDATE_CHAR (1, chr); return SCM_MAKE_CHAR(scm_downcase(SCM_CHAR(chr))); } #undef FUNC_NAME @@ -358,14 +358,14 @@ scm_downcase (unsigned int c) #ifdef EBCDIC char *const scm_charnames[] = { - "nul","soh","stx","etx", "pf", "ht", "lc","del", - 0 , 0 ,"smm", "vt", "ff", "cr", "so", "si", - "dle","dc1","dc2","dc3","res", "nl", "bs", "il", - "can", "em", "cc", 0 ,"ifs","igs","irs","ius", - "ds","sos", "fs", 0 ,"byp", "lf","eob","pre", - 0 , 0 , "sm", 0 , 0 ,"enq","ack","bel", - 0 , 0 ,"syn", 0 , "pn", "rs", "uc","eot", - 0 , 0 , 0 , 0 ,"dc4","nak", 0 ,"sub", + "nul", "soh", "stx", "etx", "pf", "ht", "lc", "del", + 0 , 0 , "smm", "vt", "ff", "cr", "so", "si", + "dle", "dc1", "dc2", "dc3", "res", "nl", "bs", "il", + "can", "em", "cc", 0 , "ifs", "igs", "irs", "ius", + "ds", "sos", "fs", 0 , "byp", "lf", "eob", "pre", + 0 , 0 , "sm", 0 , 0 , "enq", "ack", "bel", + 0 , 0 , "syn", 0 , "pn", "rs", "uc", "eot", + 0 , 0 , 0 , 0 , "dc4", "nak", 0 , "sub", "space", scm_s_newline, "tab", "backspace", "return", "page", "null"}; const char scm_charnums[] = diff --git a/libguile/continuations.h b/libguile/continuations.h index d8db12ff0..96d02fb77 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -91,7 +91,7 @@ typedef struct #define SCM_CONTREGS(x) ((scm_t_contregs *) SCM_CELL_WORD_1 (x)) #define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items) -#define SCM_SET_CONTINUATION_LENGTH(x,n)\ +#define SCM_SET_CONTINUATION_LENGTH(x, n)\ (SCM_CONTREGS (x)->num_stack_items = (n)) #define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf) #define SCM_DYNENV(x) ((SCM_CONTREGS (x))->dynenv) diff --git a/libguile/convert.i.c b/libguile/convert.i.c index 45a3ea443..258062232 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -245,17 +245,17 @@ SCM CTYPES2SCM (const CTYPE *data, long n) { long i; - SCM v, *velts; - + SCM v; + SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), n > 0 && n <= SCM_VECTOR_MAX_LENGTH); v = scm_c_make_vector (n, SCM_UNSPECIFIED); - velts = SCM_VELTS (v); + for (i = 0; i < n; i++) #ifdef FLOATTYPE - velts[i] = scm_make_real ((double) data[i]); + SCM_VECTOR_SET (v, i, scm_make_real ((double) data[i])); #else - velts[i] = SCM_MAKINUM (data[i]); + SCM_VECTOR_SET (v, i, SCM_MAKINUM (data[i])); #endif return v; } diff --git a/libguile/debug.c b/libguile/debug.c index 05c0cf3bd..dc947cc39 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -123,7 +123,7 @@ SCM_DEFINE (scm_with_traps, "with-traps", 1, 0, 0, #define FUNC_NAME s_scm_with_traps { int trap_flag; - SCM_VALIDATE_THUNK (1,thunk); + SCM_VALIDATE_THUNK (1, thunk); return scm_internal_dynamic_wind (with_traps_before, with_traps_inner, with_traps_after, @@ -243,8 +243,8 @@ SCM_DEFINE (scm_make_iloc, "make-iloc", 3, 0, 0, "offset @var{binding} and the cdr flag @var{cdrp}.") #define FUNC_NAME s_scm_make_iloc { - SCM_VALIDATE_INUM (1,frame); - SCM_VALIDATE_INUM (2,binding); + SCM_VALIDATE_INUM (1, frame); + SCM_VALIDATE_INUM (2, binding); return SCM_PACK (SCM_UNPACK (SCM_ILOC00) + SCM_IFRINC * SCM_INUM (frame) + (!SCM_FALSEP (cdrp) ? SCM_ICDR : 0) @@ -289,7 +289,7 @@ SCM_DEFINE (scm_memcons, "memcons", 2, 1, 0, if (SCM_UNBNDP (env)) env = scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE); else - SCM_VALIDATE_NULLORCONS (3,env); + SCM_VALIDATE_NULLORCONS (3, env); return scm_make_memoized (scm_cons (car, cdr), env); } #undef FUNC_NAME @@ -301,7 +301,7 @@ SCM_DEFINE (scm_mem_to_proc, "mem->proc", 1, 0, 0, #define FUNC_NAME s_scm_mem_to_proc { SCM env; - SCM_VALIDATE_MEMOIZED (1,obj); + SCM_VALIDATE_MEMOIZED (1, obj); env = SCM_MEMOIZED_ENV (obj); obj = SCM_MEMOIZED_EXP (obj); if (!SCM_CONSP (obj) || !SCM_EQ_P (SCM_CAR (obj), SCM_IM_LAMBDA)) @@ -328,7 +328,7 @@ SCM_DEFINE (scm_unmemoize, "unmemoize", 1, 0, 0, "Unmemoize the memoized expression @var{m},") #define FUNC_NAME s_scm_unmemoize { - SCM_VALIDATE_MEMOIZED (1,m); + SCM_VALIDATE_MEMOIZED (1, m); return scm_unmemocopy (SCM_MEMOIZED_EXP (m), SCM_MEMOIZED_ENV (m)); } #undef FUNC_NAME @@ -338,7 +338,7 @@ SCM_DEFINE (scm_memoized_environment, "memoized-environment", 1, 0, 0, "Return the environment of the memoized expression @var{m}.") #define FUNC_NAME s_scm_memoized_environment { - SCM_VALIDATE_MEMOIZED (1,m); + SCM_VALIDATE_MEMOIZED (1, m); return SCM_MEMOIZED_ENV (m); } #undef FUNC_NAME @@ -348,7 +348,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0, "Return the name of the procedure @var{proc}") #define FUNC_NAME s_scm_procedure_name { - SCM_VALIDATE_PROC (1,proc); + SCM_VALIDATE_PROC (1, proc); switch (SCM_TYP7 (proc)) { case scm_tcs_subrs: return SCM_SNAME (proc); @@ -374,7 +374,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, "Return the source of the procedure @var{proc}.") #define FUNC_NAME s_scm_procedure_source { - SCM_VALIDATE_NIM (1,proc); + SCM_VALIDATE_NIM (1, proc); switch (SCM_TYP7 (proc)) { case scm_tcs_closures: { @@ -407,7 +407,7 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0, "Return the environment of the procedure @var{proc}.") #define FUNC_NAME s_scm_procedure_environment { - SCM_VALIDATE_NIM (1,proc); + SCM_VALIDATE_NIM (1, proc); switch (SCM_TYP7 (proc)) { case scm_tcs_closures: return SCM_ENV (proc); diff --git a/libguile/environments.c b/libguile/environments.c index f083b9399..a5cc3c244 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -533,7 +533,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data) size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray); SCM entry = scm_cons (symbol, data); SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]); - SCM_VELTS (obarray)[hash] = slot; + SCM_VECTOR_SET (obarray, hash, slot); return entry; } @@ -562,7 +562,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data) } slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]); - SCM_VELTS (obarray)[hash] = slot; + SCM_VECTOR_SET (obarray, hash, slot); return SCM_BOOL_F; } @@ -587,6 +587,46 @@ obarray_retrieve (SCM obarray, SCM sym) return SCM_UNDEFINED; } +/* + Remove first occurance of KEY from (cdr ALIST), + return (KEY . VAL) if found, otherwise return #f + + PRECONDITION: + + length (ALIST) >= 1 + */ +static +SCM +remove_key_from_alist (SCM alist, SCM key) +{ + SCM cell_cdr = alist; + alist =SCM_CDR (alist); + + /* + inv: cdr(cell_cdr) == alist + */ + while (!SCM_NULLP (alist)) + { + if (SCM_EQ_P(SCM_CAAR (alist), key)) + { + SCM entry = SCM_CAR(alist); + SCM_SETCDR(cell_cdr, SCM_CDR (alist)); + + return entry; + } + else + { + cell_cdr = SCM_CDR (cell_cdr); + } + + if (!SCM_NULLP(alist)) + alist = SCM_CDR (alist); + } + + return SCM_BOOL_F; +} + + /* * Remove entry from obarray. If the symbol was found and removed, the old @@ -596,22 +636,20 @@ static SCM obarray_remove (SCM obarray, SCM sym) { size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray); - SCM lsym; - SCM *lsymp; + SCM table_entry = SCM_VELTS (obarray)[hash]; - /* Dirk:FIXME:: gc problem due to use of &SCM_VELTS[hash] */ - for (lsym = *(lsymp = &SCM_VELTS (obarray)[hash]); - !SCM_NULLP (lsym); - lsym = *(lsymp = SCM_CDRLOC (lsym))) + if (SCM_NULLP(table_entry)) + return SCM_BOOL_F; + + if (SCM_EQ_P (SCM_CAAR (table_entry), sym)) { - SCM entry = SCM_CAR (lsym); - if (SCM_EQ_P (SCM_CAR (entry), sym)) - { - *lsymp = SCM_CDR (lsym); - return entry; - } + SCM_VECTOR_SET (obarray, hash, SCM_CDR(table_entry)); + return SCM_CAR(table_entry); + } + else + { + return remove_key_from_alist (table_entry, sym); } - return SCM_BOOL_F; } @@ -623,7 +661,7 @@ obarray_remove_all (SCM obarray) for (i = 0; i < size; i++) { - SCM_VELTS (obarray)[i] = SCM_EOL; + SCM_VECTOR_SET (obarray, i, SCM_EOL); } } @@ -655,7 +693,7 @@ struct core_environments_base { #define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \ (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0]) #define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \ - (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0] = (v)) + (SCM_VECTOR_SET (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0, (v))) diff --git a/libguile/error.c b/libguile/error.c index 9308205a6..2042b12fb 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -168,7 +168,7 @@ SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0, "must be an integer value.") #define FUNC_NAME s_scm_strerror { - SCM_VALIDATE_INUM (1,err); + SCM_VALIDATE_INUM (1, err); return scm_makfrom0str (SCM_I_STRERROR (SCM_INUM (err))); } #undef FUNC_NAME @@ -224,7 +224,7 @@ scm_out_of_range_pos (const char *subr, SCM bad_value, SCM pos) scm_error (scm_out_of_range_key, subr, "Argument ~S out of range: ~S", - scm_list_2 (pos,bad_value), + scm_list_2 (pos, bad_value), SCM_BOOL_F); } diff --git a/libguile/eval.c b/libguile/eval.c index 8a07bfeb1..699f9fc4a 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -798,7 +798,7 @@ iqq (SCM form, SCM env, unsigned long int depth) else if (SCM_VECTORP (form)) { size_t i = SCM_VECTOR_LENGTH (form); - SCM *data = SCM_VELTS (form); + SCM const *data = SCM_VELTS (form); SCM tmp = SCM_EOL; while (i != 0) tmp = scm_cons (data[--i], tmp); @@ -1020,7 +1020,7 @@ scm_m_let (SCM xorig, SCM env) } -SCM_SYNTAX (s_atapply,"@apply", scm_makmmacro, scm_m_apply); +SCM_SYNTAX (s_atapply, "@apply", scm_makmmacro, scm_m_apply); SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply); SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1); @@ -1032,8 +1032,8 @@ scm_m_apply (SCM xorig, SCM env SCM_UNUSED) } -SCM_SYNTAX(s_atcall_cc,"@call-with-current-continuation", scm_makmmacro, scm_m_cont); -SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc,s_atcall_cc); +SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_makmmacro, scm_m_cont); +SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc); SCM @@ -3413,7 +3413,7 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0, #define FUNC_NAME s_scm_nconc2last { SCM *lloc; - SCM_VALIDATE_NONEMPTYLIST (1,lst); + SCM_VALIDATE_NONEMPTYLIST (1, lst); lloc = &lst; while (!SCM_NULLP (SCM_CDR (*lloc))) /* Perhaps should be SCM_NULL_OR_NIL_P, but not @@ -3792,7 +3792,7 @@ check_map_args (SCM argv, SCM args, const char *who) { - SCM *ve = SCM_VELTS (argv); + SCM const *ve = SCM_VELTS (argv); long i; for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--) @@ -3831,7 +3831,7 @@ scm_map (SCM proc, SCM arg1, SCM args) long i, len; SCM res = SCM_EOL; SCM *pres = &res; - SCM *ve = &args; /* Keep args from being optimized away. */ + SCM const *ve = &args; /* Keep args from being optimized away. */ len = scm_ilength (arg1); SCM_GASSERTn (len >= 0, @@ -3858,7 +3858,7 @@ scm_map (SCM proc, SCM arg1, SCM args) if (SCM_IMP (ve[i])) return res; arg1 = scm_cons (SCM_CAR (ve[i]), arg1); - ve[i] = SCM_CDR (ve[i]); + SCM_VECTOR_SET (args, i, SCM_CDR (ve[i])); } *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL)); pres = SCM_CDRLOC (*pres); @@ -3873,7 +3873,7 @@ SCM scm_for_each (SCM proc, SCM arg1, SCM args) #define FUNC_NAME s_for_each { - SCM *ve = &args; /* Keep args from being optimized away. */ + SCM const *ve = &args; /* Keep args from being optimized away. */ long i, len; len = scm_ilength (arg1); SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args), @@ -3899,7 +3899,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args) if (SCM_IMP (ve[i])) return SCM_UNSPECIFIED; arg1 = scm_cons (SCM_CAR (ve[i]), arg1); - ve[i] = SCM_CDR (ve[i]); + SCM_VECTOR_SET (args, i, SCM_CDR (ve[i])); } scm_apply (proc, arg1, SCM_EOL); } @@ -4011,7 +4011,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0, unsigned long i = SCM_VECTOR_LENGTH (obj); ans = scm_c_make_vector (i, SCM_UNSPECIFIED); while (i--) - SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]); + SCM_VECTOR_SET (ans, i, scm_copy_tree (SCM_VELTS (obj)[i])); return ans; } if (!SCM_CONSP (obj)) diff --git a/libguile/evalext.c b/libguile/evalext.c index 4b64eaa0f..16b3ed567 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -77,7 +77,7 @@ SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0, { SCM var; - SCM_VALIDATE_SYMBOL (1,sym); + SCM_VALIDATE_SYMBOL (1, sym); if (SCM_UNBNDP (env)) var = scm_sym2var (sym, scm_current_module_lookup_closure (), diff --git a/libguile/filesys.c b/libguile/filesys.c index fa7e75427..b1c757725 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -218,8 +218,8 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0, object = SCM_COERCE_OUTPORT (object); - SCM_VALIDATE_INUM (2,owner); - SCM_VALIDATE_INUM (3,group); + SCM_VALIDATE_INUM (2, owner); + SCM_VALIDATE_INUM (3, group); #ifdef HAVE_FCHOWN if (SCM_INUMP (object) || (SCM_OPFPORTP (object))) { @@ -259,7 +259,7 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0, object = SCM_COERCE_OUTPORT (object); - SCM_VALIDATE_INUM (2,mode); + SCM_VALIDATE_INUM (2, mode); if (SCM_INUMP (object) || SCM_OPFPORTP (object)) { if (SCM_INUMP (object)) @@ -295,7 +295,7 @@ SCM_DEFINE (scm_umask, "umask", 0, 1, 0, } else { - SCM_VALIDATE_INUM (1,mode); + SCM_VALIDATE_INUM (1, mode); mask = umask (SCM_INUM (mode)); } return SCM_MAKINUM (mask); @@ -397,7 +397,7 @@ SCM_DEFINE (scm_close, "close", 1, 0, 0, if (SCM_PORTP (fd_or_port)) return scm_close_port (fd_or_port); - SCM_VALIDATE_INUM (1,fd_or_port); + SCM_VALIDATE_INUM (1, fd_or_port); fd = SCM_INUM (fd_or_port); scm_evict_ports (fd); /* see scsh manual. */ SCM_SYSCALL (rv = close (fd)); @@ -448,58 +448,57 @@ static SCM scm_stat2scm (struct stat *stat_temp) { SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); - ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev); - ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino); - ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode); - ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink); - ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid); - ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid); + SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) stat_temp->st_dev)); + SCM_VECTOR_SET(ans, 1, scm_ulong2num ((unsigned long) stat_temp->st_ino)); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) stat_temp->st_mode)); + SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) stat_temp->st_nlink)); + SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) stat_temp->st_uid)); + SCM_VECTOR_SET(ans, 5, scm_ulong2num ((unsigned long) stat_temp->st_gid)); #ifdef HAVE_STRUCT_STAT_ST_RDEV - ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev); + SCM_VECTOR_SET(ans, 6, scm_ulong2num ((unsigned long) stat_temp->st_rdev)); #else - ve[6] = SCM_BOOL_F; + SCM_VECTOR_SET(ans, 6, SCM_BOOL_F); #endif - ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size); - ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime); - ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime); - ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime); + SCM_VECTOR_SET(ans, 7, scm_ulong2num ((unsigned long) stat_temp->st_size)); + SCM_VECTOR_SET(ans, 8, scm_ulong2num ((unsigned long) stat_temp->st_atime)); + SCM_VECTOR_SET(ans, 9, scm_ulong2num ((unsigned long) stat_temp->st_mtime)); + SCM_VECTOR_SET(ans, 10, scm_ulong2num ((unsigned long) stat_temp->st_ctime)); #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE - ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize); + SCM_VECTOR_SET(ans, 11, scm_ulong2num ((unsigned long) stat_temp->st_blksize)); #else - ve[11] = scm_ulong2num (4096L); + SCM_VECTOR_SET(ans, 11, scm_ulong2num (4096L)); #endif #ifdef HAVE_STRUCT_STAT_ST_BLOCKS - ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks); + SCM_VECTOR_SET(ans, 12, scm_ulong2num ((unsigned long) stat_temp->st_blocks)); #else - ve[12] = SCM_BOOL_F; + SCM_VECTOR_SET(ans, 12, SCM_BOOL_F); #endif { int mode = stat_temp->st_mode; if (S_ISREG (mode)) - ve[13] = scm_sym_regular; + SCM_VECTOR_SET(ans, 13, scm_sym_regular); else if (S_ISDIR (mode)) - ve[13] = scm_sym_directory; + SCM_VECTOR_SET(ans, 13, scm_sym_directory); #ifdef HAVE_S_ISLNK else if (S_ISLNK (mode)) - ve[13] = scm_sym_symlink; + SCM_VECTOR_SET(ans, 13, scm_sym_symlink); #endif else if (S_ISBLK (mode)) - ve[13] = scm_sym_block_special; + SCM_VECTOR_SET(ans, 13, scm_sym_block_special); else if (S_ISCHR (mode)) - ve[13] = scm_sym_char_special; + SCM_VECTOR_SET(ans, 13, scm_sym_char_special); else if (S_ISFIFO (mode)) - ve[13] = scm_sym_fifo; + SCM_VECTOR_SET(ans, 13, scm_sym_fifo); #ifdef S_ISSOCK else if (S_ISSOCK (mode)) - ve[13] = scm_sym_sock; + SCM_VECTOR_SET(ans, 13, scm_sym_sock); #endif else - ve[13] = scm_sym_unknown; + SCM_VECTOR_SET(ans, 13, scm_sym_unknown); - ve[14] = SCM_MAKINUM ((~S_IFMT) & mode); + SCM_VECTOR_SET(ans, 14, SCM_MAKINUM ((~S_IFMT) & mode)); /* the layout of the bits in ve[14] is intended to be portable. If there are systems that don't follow the usual convention, @@ -528,7 +527,7 @@ scm_stat2scm (struct stat *stat_temp) tmp <<= 1; if (S_IXOTH & mode) tmp += 1; - ve[14] = SCM_MAKINUM (tmp); + SCM_VECTOR_SET(ans, 14, SCM_MAKINUM (tmp)); */ } @@ -761,7 +760,7 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0, } else { - SCM_VALIDATE_INUM (2,mode); + SCM_VALIDATE_INUM (2, mode); SCM_SYSCALL (rv = mkdir (SCM_STRING_CHARS (path), SCM_INUM (mode))); } if (rv != 0) @@ -1021,7 +1020,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos) if (SCM_VECTORP (list_or_vec)) { int i = SCM_VECTOR_LENGTH (list_or_vec); - SCM *ve = SCM_VELTS (list_or_vec); + SCM const *ve = SCM_VELTS (list_or_vec); while (--i >= 0) { @@ -1082,7 +1081,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec) if (SCM_VECTORP (list_or_vec)) { int i = SCM_VECTOR_LENGTH (list_or_vec); - SCM *ve = SCM_VELTS (list_or_vec); + SCM const *ve = SCM_VELTS (list_or_vec); while (--i >= 0) { @@ -1212,7 +1211,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0, timeout.tv_usec = 0; else { - SCM_VALIDATE_INUM (5,usecs); + SCM_VALIDATE_INUM (5, usecs); timeout.tv_usec = SCM_INUM (usecs); } } @@ -1285,12 +1284,12 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0, object = SCM_COERCE_OUTPORT (object); - SCM_VALIDATE_INUM (2,cmd); + SCM_VALIDATE_INUM (2, cmd); if (SCM_OPFPORTP (object)) fdes = SCM_FPORT_FDES (object); else { - SCM_VALIDATE_INUM (1,object); + SCM_VALIDATE_INUM (1, object); fdes = SCM_INUM (object); } @@ -1327,7 +1326,7 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0, } else { - SCM_VALIDATE_INUM (1,object); + SCM_VALIDATE_INUM (1, object); fdes = SCM_INUM (object); } if (fsync (fdes) == -1) @@ -1464,7 +1463,7 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0, long int i; unsigned long int len; - SCM_VALIDATE_STRING (1,filename); + SCM_VALIDATE_STRING (1, filename); s = SCM_STRING_CHARS (filename); len = SCM_STRING_LENGTH (filename); @@ -1506,7 +1505,7 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0, char *f, *s = 0; int i, j, len, end; - SCM_VALIDATE_STRING (1,filename); + SCM_VALIDATE_STRING (1, filename); f = SCM_STRING_CHARS (filename); len = SCM_STRING_LENGTH (filename); diff --git a/libguile/fluids.c b/libguile/fluids.c index 267918249..c975be49b 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -76,12 +76,12 @@ grow_fluids (scm_root_state *root_state, int new_length) i = 0; while (i < old_length) { - SCM_VELTS(new_fluids)[i] = SCM_VELTS(old_fluids)[i]; + SCM_VECTOR_SET (new_fluids, i, SCM_VELTS(old_fluids)[i]); i++; } while (i < new_length) { - SCM_VELTS(new_fluids)[i] = SCM_BOOL_F; + SCM_VECTOR_SET (new_fluids, i, SCM_BOOL_F); i++; } @@ -171,7 +171,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0, if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n) grow_fluids (scm_root, n+1); - SCM_VELTS (scm_root->fluids)[n] = value; + SCM_VECTOR_SET (scm_root->fluids, n, value); return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/gc.h b/libguile/gc.h index fce0add19..72ac83074 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -80,9 +80,24 @@ typedef scm_t_cell * SCM_CELLPTR; # define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) #endif /* def _UNICOS */ +#ifdef GENGC +/* + TODO + */ +#else /* ! genGC */ + #define SCM_GC_CARD_N_HEADER_CELLS 1 #define SCM_GC_CARD_N_CELLS 256 +#define SCM_GC_CARD_GENERATION(card) +#define SCM_GC_FLAG_OBJECT_WRITE(x) + +#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) +#define SCM_GC_SET_CARD_BVEC(card, bvec) \ + ((card)->word_0 = (scm_t_bits) (bvec)) +#endif + + #define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)) #define SCM_GC_CARD_N_DATA_CELLS (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) @@ -92,10 +107,6 @@ typedef scm_t_cell * SCM_CELLPTR; #define SCM_GC_IN_CARD_HEADERP(x) \ SCM_PTR_LT ((scm_t_cell *) (x), SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS) -#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) -#define SCM_GC_SET_CARD_BVEC(card, bvec) \ - ((card)->word_0 = (scm_t_bits) (bvec)) - #define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1)) #define SCM_GC_SET_CARD_FLAGS(card, flags) \ ((card)->word_1 = (scm_t_bits) (flags)) diff --git a/libguile/gh.h b/libguile/gh.h index 90b229dd9..e180c0d7c 100644 --- a/libguile/gh.h +++ b/libguile/gh.h @@ -167,7 +167,7 @@ SCM_API SCM gh_define(const char *name, SCM val); #define gh_string_length(str) scm_string_length(str) #define gh_string_ref(str, k) scm_string_ref(str, k) #define gh_string_set_x(str, k, chr) scm_string_set_x(str, k, chr) -#define gh_substring(str, start,end) scm_substring(str, start, end) +#define gh_substring(str, start, end) scm_substring(str, start, end) #define gh_string_append(args) scm_string_append(args) diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 31c9ea730..edcc290d3 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -122,10 +122,8 @@ gh_ints2scm (const int *d, long n) { long i; SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); - SCM *velts = SCM_VELTS(v); - for (i = 0; i < n; ++i) - velts[i] = (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i])); + SCM_VECTOR_SET (v, i, (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i]))); return v; } @@ -135,10 +133,9 @@ gh_doubles2scm (const double *d, long n) { long i; SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); - SCM *velts = SCM_VELTS(v); for(i = 0; i < n; i++) - velts[i] = scm_make_real (d[i]); + SCM_VECTOR_SET (v, i, scm_make_real (d[i])); return v; } diff --git a/libguile/goops.c b/libguile/goops.c index fcb8ee3ed..7ff530d1d 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -75,7 +75,7 @@ #define SPEC_OF(x) SCM_SLOT (x, scm_si_specializers) -#define DEFVAR(v,val) \ +#define DEFVAR(v, val) \ { scm_eval (scm_list_3 (scm_sym_define_public, (v), (val)), \ scm_module_goops); } /* Temporary hack until we get the new module system */ @@ -84,13 +84,13 @@ (v), SCM_BOOL_F))) /* Fixme: Should use already interned symbols */ -#define CALL_GF1(name,a) (scm_call_1 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF1(name, a) (scm_call_1 (GETVAR (scm_str2symbol (name)), \ a)) -#define CALL_GF2(name,a,b) (scm_call_2 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF2(name, a, b) (scm_call_2 (GETVAR (scm_str2symbol (name)), \ a, b)) -#define CALL_GF3(name,a,b,c) (scm_call_3 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF3(name, a, b, c) (scm_call_3 (GETVAR (scm_str2symbol (name)), \ a, b, c)) -#define CALL_GF4(name,a,b,c,d) (scm_call_4 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF4(name, a, b, c, d) (scm_call_4 (GETVAR (scm_str2symbol (name)), \ a, b, c, d)) /* Class redefinition protocol: @@ -1684,7 +1684,7 @@ applicablep (SCM actual, SCM formal) } static int -more_specificp (SCM m1, SCM m2, SCM *targs) +more_specificp (SCM m1, SCM m2, SCM const *targs) { register SCM s1, s2; register long i; @@ -1704,7 +1704,7 @@ more_specificp (SCM m1, SCM m2, SCM *targs) * the end of this array). * */ - for (i=0,s1=SPEC_OF(m1),s2=SPEC_OF(m2); ; i++,s1=SCM_CDR(s1),s2=SCM_CDR(s2)) { + for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) { if (SCM_NULLP(s1)) return 1; if (SCM_NULLP(s2)) return 0; if (SCM_CAR(s1) != SCM_CAR(s2)) { @@ -1731,13 +1731,13 @@ scm_i_vector2list (SCM l, long len) SCM z = scm_c_make_vector (len, SCM_UNDEFINED); for (j = 0; j < len; j++, l = SCM_CDR (l)) { - SCM_VELTS (z)[j] = SCM_CAR (l); + SCM_VECTOR_SET (z, j, SCM_CAR (l)); } return z; } static SCM -sort_applicable_methods (SCM method_list, long size, SCM *targs) +sort_applicable_methods (SCM method_list, long size, SCM const *targs) { long i, j, incr; SCM *v, vector = SCM_EOL; @@ -1761,7 +1761,13 @@ sort_applicable_methods (SCM method_list, long size, SCM *targs) { /* Too many elements in method_list to keep everything locally */ vector = scm_i_vector2list (save, size); - v = SCM_VELTS (vector); + + /* + This is a new vector. Don't worry about the write barrier. + We're not allocating elements in this routine, so this should + pose no problem. + */ + v = SCM_WRITABLE_VELTS (vector); } /* Use a simple shell sort since it is generally faster than qsort on @@ -1807,8 +1813,10 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) long count = 0; SCM l, fl, applicable = SCM_EOL; SCM save = args; - SCM buffer[BUFFSIZE], *types, *p; - SCM tmp; + SCM buffer[BUFFSIZE]; + SCM const *types; + SCM *p; + SCM tmp = SCM_EOL; /* Build the list of arguments types */ if (len >= BUFFSIZE) { @@ -1816,14 +1824,20 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) /* NOTE: Using pointers to malloced memory won't work if we 1. have preemtive threading, and, 2. have a GC which moves objects. */ - types = p = SCM_VELTS(tmp); + types = p = SCM_WRITABLE_VELTS(tmp); + + /* + note that we don't have to work to reset the generation + count. TMP is a new vector anyway, and it is found + conservatively. + */ } else types = p = buffer; for ( ; !SCM_NULLP (args); args = SCM_CDR (args)) *p++ = scm_class_of (SCM_CAR (args)); - + /* Build a list of all applicable methods */ for (l = SCM_SLOT (gf, scm_si_methods); !SCM_NULLP (l); l = SCM_CDR (l)) { @@ -1857,6 +1871,8 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) /* if we are here, it's because no-applicable-method hasn't signaled an error */ return SCM_BOOL_F; } + + scm_remember_upto_here (tmp); return (count == 1 ? applicable : sort_applicable_methods (applicable, count, types)); @@ -2135,7 +2151,7 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0, for (i = 0, l = targs; !SCM_NULLP (l); i++, l = SCM_CDR (l)) { SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME); - SCM_VELTS(v)[i] = SCM_CAR(l); + SCM_VECTOR_SET (v, i, SCM_CAR(l)); } return more_specificp (m1, m2, SCM_VELTS(v)) ? SCM_BOOL_T: SCM_BOOL_F; } diff --git a/libguile/hash.c b/libguile/hash.c index f3fba4e3b..b89415086 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -145,7 +145,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d) case scm_tc7_vector: { size_t len = SCM_VECTOR_LENGTH(obj); - SCM *data = SCM_VELTS(obj); + SCM const *data = SCM_VELTS(obj); if (len > 5) { size_t i = d/2; diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 5cf8c7e6b..b347dd3d9 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -61,7 +61,7 @@ scm_c_make_hash_table (unsigned long k) SCM -scm_hash_fn_get_handle (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(),void * closure) +scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*assoc_fn)(), void * closure) #define FUNC_NAME "scm_hash_fn_get_handle" { unsigned long k; @@ -80,8 +80,8 @@ scm_hash_fn_get_handle (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc SCM -scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)(), - SCM (*assoc_fn)(),void * closure) +scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_fn)(), + SCM (*assoc_fn)(), void * closure) #define FUNC_NAME "scm_hash_fn_create_handle_x" { unsigned long k; @@ -107,7 +107,7 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn) SCM old_bucket; old_bucket = SCM_VELTS (table)[k]; new_bucket = scm_acons (obj, init, old_bucket); - SCM_VELTS(table)[k] = new_bucket; + SCM_VECTOR_SET (table, k, new_bucket); SCM_REALLOW_INTS; return SCM_CAR (new_bucket); } @@ -116,8 +116,8 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn) SCM -scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(), - SCM (*assoc_fn)(),void * closure) +scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned long (*hash_fn)(), + SCM (*assoc_fn)(), void * closure) { SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure); if (SCM_CONSP (it)) @@ -130,8 +130,8 @@ scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(), SCM -scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(), - SCM (*assoc_fn)(),void * closure) +scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned long (*hash_fn)(), + SCM (*assoc_fn)(), void * closure) { SCM it; @@ -145,8 +145,8 @@ scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(), SCM -scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(), - SCM (*delete_fn)(),void * closure) +scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*assoc_fn)(), + SCM (*delete_fn)(), void * closure) { unsigned long k; SCM h; @@ -158,7 +158,7 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_f if (k >= SCM_VECTOR_LENGTH (table)) scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k)); h = assoc_fn (obj, SCM_VELTS (table)[k], closure); - SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]); + SCM_VECTOR_SET (table, k, delete_fn (h, SCM_VELTS(table)[k])); return h; } @@ -528,8 +528,8 @@ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, "table into an a-list of key-value pairs.") #define FUNC_NAME s_scm_hash_fold { - SCM_VALIDATE_PROC (1,proc); - SCM_VALIDATE_VECTOR (3,table); + SCM_VALIDATE_PROC (1, proc); + SCM_VALIDATE_VECTOR (3, table); return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table); } #undef FUNC_NAME diff --git a/libguile/hooks.c b/libguile/hooks.c index ade502e54..3d01de1c8 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -228,7 +228,7 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0, { SCM arity, rest; int n_args; - SCM_VALIDATE_HOOK (1,hook); + SCM_VALIDATE_HOOK (1, hook); SCM_ASSERT (!SCM_FALSEP (arity = scm_i_procedure_arity (proc)), proc, SCM_ARG2, FUNC_NAME); n_args = SCM_HOOK_ARITY (hook); @@ -267,7 +267,7 @@ SCM_DEFINE (scm_reset_hook_x, "reset-hook!", 1, 0, 0, "value of this procedure is not specified.") #define FUNC_NAME s_scm_reset_hook_x { - SCM_VALIDATE_HOOK (1,hook); + SCM_VALIDATE_HOOK (1, hook); SCM_SET_HOOK_PROCEDURES (hook, SCM_EOL); return SCM_UNSPECIFIED; } @@ -281,7 +281,7 @@ SCM_DEFINE (scm_run_hook, "run-hook", 1, 0, 1, "last. The return value of this procedure is not specified.") #define FUNC_NAME s_scm_run_hook { - SCM_VALIDATE_HOOK (1,hook); + SCM_VALIDATE_HOOK (1, hook); if (scm_ilength (args) != SCM_HOOK_ARITY (hook)) SCM_MISC_ERROR ("Hook ~S requires ~A arguments", scm_list_2 (hook, SCM_MAKINUM (SCM_HOOK_ARITY (hook)))); diff --git a/libguile/init.c b/libguile/init.c index 0e8b6ff73..432983ea3 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -199,7 +199,7 @@ static char remsg[] = "remove\n#define ", addmsg[] = "add\n#define "; static void -fixconfig (char *s1,char *s2,int s) +fixconfig (char *s1, char *s2, int s) { fputs (s1, stderr); fputs (s2, stderr); diff --git a/libguile/ioext.c b/libguile/ioext.c index 124332366..931a157f7 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -97,8 +97,8 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0, old = SCM_COERCE_OUTPORT (old); new = SCM_COERCE_OUTPORT (new); - SCM_VALIDATE_OPFPORT (1,old); - SCM_VALIDATE_OPFPORT (2,new); + SCM_VALIDATE_OPFPORT (1, old); + SCM_VALIDATE_OPFPORT (2, new); oldfd = SCM_FPORT_FDES (old); fp = SCM_FSTREAM (new); newfd = fp->fdes; @@ -138,7 +138,7 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0, oldfd = SCM_INUM (fd_or_port); else { - SCM_VALIDATE_OPFPORT (1,fd_or_port); + SCM_VALIDATE_OPFPORT (1, fd_or_port); oldfd = SCM_FPORT_FDES (fd_or_port); } @@ -197,7 +197,7 @@ SCM_DEFINE (scm_fileno, "fileno", 1, 0, 0, #define FUNC_NAME s_scm_fileno { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); + SCM_VALIDATE_OPFPORT (1, port); return SCM_MAKINUM (SCM_FPORT_FDES (port)); } #undef FUNC_NAME @@ -238,7 +238,7 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0, "same as that accepted by @ref{File Ports, open-file}.") #define FUNC_NAME s_scm_fdopen { - SCM_VALIDATE_INUM (1,fdes); + SCM_VALIDATE_INUM (1, fdes); SCM_VALIDATE_STRING (2, modes); return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F); @@ -269,8 +269,8 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0, port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); - SCM_VALIDATE_INUM (2,fd); + SCM_VALIDATE_OPFPORT (1, port); + SCM_VALIDATE_INUM (2, fd); stream = SCM_FSTREAM (port); old_fd = stream->fdes; new_fd = SCM_INUM (fd); @@ -300,7 +300,7 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0, int int_fd; long i; - SCM_VALIDATE_INUM_COPY (1,fd,int_fd); + SCM_VALIDATE_INUM_COPY (1, fd, int_fd); for (i = 0; i < scm_port_table_size; i++) { diff --git a/libguile/lang.c b/libguile/lang.c index 4fbcbf47f..6d6077935 100644 --- a/libguile/lang.c +++ b/libguile/lang.c @@ -85,7 +85,7 @@ SCM_DEFINE (scm_nil_car, "nil-car", 1, 0, 0, { if (SCM_NILP (x)) return scm_lisp_nil; - SCM_VALIDATE_CONS (1,x); + SCM_VALIDATE_CONS (1, x); return SCM_CAR (x); } #undef FUNC_NAME @@ -98,7 +98,7 @@ SCM_DEFINE (scm_nil_cdr, "nil-cdr", 1, 0, 0, { if (SCM_NILP (x)) return scm_lisp_nil; - SCM_VALIDATE_CONS (1,x); + SCM_VALIDATE_CONS (1, x); return SCM_EOL2NIL (SCM_CDR (x), x); } #undef FUNC_NAME diff --git a/libguile/list.c b/libguile/list.c index fd815c7a6..e62ad5b37 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -59,7 +59,7 @@ /* creating lists */ -#define SCM_I_CONS(cell,x,y) \ +#define SCM_I_CONS(cell, x, y) \ do { \ cell = scm_cell ((scm_t_bits)x, (scm_t_bits)y); \ } while (0) @@ -218,7 +218,7 @@ SCM_DEFINE (scm_length, "length", 1, 0, 0, #define FUNC_NAME s_scm_length { long i; - SCM_VALIDATE_LIST_COPYLEN (1,lst,i); + SCM_VALIDATE_LIST_COPYLEN (1, lst, i); return SCM_MAKINUM (i); } #undef FUNC_NAME @@ -398,7 +398,7 @@ SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0, { SCM lst = list; unsigned long int i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); while (SCM_CONSP (lst)) { if (i == 0) return SCM_CAR (lst); @@ -422,7 +422,7 @@ SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0, { SCM lst = list; unsigned long int i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); while (SCM_CONSP (lst)) { if (i == 0) { SCM_SETCAR (lst, val); @@ -453,9 +453,9 @@ SCM_DEFINE (scm_list_tail, "list-tail", 2, 0, 0, #define FUNC_NAME s_scm_list_tail { register long i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); while (i-- > 0) { - SCM_VALIDATE_CONS (1,lst); + SCM_VALIDATE_CONS (1, lst); lst = SCM_CDR(lst); } return lst; @@ -470,7 +470,7 @@ SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, { SCM lst = list; unsigned long int i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); while (SCM_CONSP (lst)) { if (i == 0) { SCM_SETCDR (lst, val); @@ -501,12 +501,12 @@ SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0, SCM * pos; register long i; - SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i); + SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i); answer = SCM_EOL; pos = &answer; while (i-- > 0) { - SCM_VALIDATE_CONS (1,lst); + SCM_VALIDATE_CONS (1, lst); *pos = scm_cons (SCM_CAR (lst), SCM_EOL); pos = SCM_CDRLOC (*pos); lst = SCM_CDR(lst); diff --git a/libguile/load.c b/libguile/load.c index f3511231f..300480bdf 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -282,12 +282,12 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, size_t max_path_len; /* maximum length of any PATH element */ size_t max_ext_len; /* maximum length of any EXTENSIONS element */ - SCM_VALIDATE_LIST (1,path); + SCM_VALIDATE_LIST (1, path); SCM_VALIDATE_STRING (2, filename); if (SCM_UNBNDP (extensions)) extensions = SCM_EOL; else - SCM_VALIDATE_LIST (3,extensions); + SCM_VALIDATE_LIST (3, extensions); filename_chars = SCM_STRING_CHARS (filename); filename_len = SCM_STRING_LENGTH (filename); diff --git a/libguile/macros.c b/libguile/macros.c index 467de2c02..77c068519 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -106,7 +106,7 @@ SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0, "environment.") #define FUNC_NAME s_scm_makacro { - SCM_VALIDATE_PROC (1,code); + SCM_VALIDATE_PROC (1, code); SCM_RETURN_NEWSMOB (scm_tc16_macro, SCM_UNPACK (code)); } #undef FUNC_NAME @@ -134,7 +134,7 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0, " non-memoizing macros in general. Use memoizing macros" " or r5rs macros instead."); - SCM_VALIDATE_PROC (1,code); + SCM_VALIDATE_PROC (1, code); SCM_RETURN_NEWSMOB (scm_tc16_macro | (1L << 16), SCM_UNPACK (code)); } #undef FUNC_NAME @@ -154,7 +154,7 @@ SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0, "form of the containing code.") #define FUNC_NAME s_scm_makmmacro { - SCM_VALIDATE_PROC (1,code); + SCM_VALIDATE_PROC (1, code); SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), SCM_UNPACK (code)); } #undef FUNC_NAME @@ -206,7 +206,7 @@ SCM_DEFINE (scm_macro_name, "macro-name", 1, 0, 0, "Return the name of the macro @var{m}.") #define FUNC_NAME s_scm_macro_name { - SCM_VALIDATE_SMOB (1,m,macro); + SCM_VALIDATE_SMOB (1, m, macro); return scm_procedure_name (SCM_PACK (SCM_SMOB_DATA (m))); } #undef FUNC_NAME @@ -217,7 +217,7 @@ SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1, 0, 0, "Return the transformer of the macro @var{m}.") #define FUNC_NAME s_scm_macro_transformer { - SCM_VALIDATE_SMOB (1,m,macro); + SCM_VALIDATE_SMOB (1, m, macro); return ((SCM_CLOSUREP (SCM_PACK (SCM_SMOB_DATA (m)))) ? SCM_PACK(SCM_SMOB_DATA (m)) : SCM_BOOL_F); } diff --git a/libguile/modules.h b/libguile/modules.h index f5e8e4f55..32d74efeb 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -3,7 +3,7 @@ #ifndef SCM_MODULES_H #define SCM_MODULES_H -/* Copyright (C) 1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by diff --git a/libguile/net_db.c b/libguile/net_db.c index ecb075c8b..12885642e 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -154,7 +154,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, #define FUNC_NAME s_scm_gethost { SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); + SCM *ve = SCM_WRITABLE_VELTS (ans); SCM lst = SCM_EOL; struct hostent *entry; struct in_addr inad; @@ -190,13 +190,13 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, if (!entry) scm_resolv_error (FUNC_NAME, host); - ve[0] = scm_mem2string (entry->h_name, strlen (entry->h_name)); - ve[1] = scm_makfromstrs (-1, entry->h_aliases); - ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L); - ve[3] = SCM_MAKINUM (entry->h_length + 0L); + SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->h_name, strlen (entry->h_name))); + SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->h_aliases)); + SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->h_addrtype + 0L)); + SCM_VECTOR_SET(ans, 3, SCM_MAKINUM (entry->h_length + 0L)); if (sizeof (struct in_addr) != entry->h_length) { - ve[4] = SCM_BOOL_F; + SCM_VECTOR_SET(ans, 4, SCM_BOOL_F); return ans; } for (argv = entry->h_addr_list; argv[i]; i++); @@ -205,7 +205,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, inad = *(struct in_addr *) argv[i]; lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst); } - ve[4] = lst; + SCM_VECTOR_SET(ans, 4, lst); return ans; } #undef FUNC_NAME @@ -237,7 +237,8 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, struct netent *entry; ans = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); + ve = SCM_WRITABLE_VELTS (ans); + if (SCM_UNBNDP (net)) { entry = getnetent (); @@ -261,10 +262,10 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, } if (!entry) SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); - ve[0] = scm_mem2string (entry->n_name, strlen (entry->n_name)); - ve[1] = scm_makfromstrs (-1, entry->n_aliases); - ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L); - ve[3] = scm_ulong2num (entry->n_net + 0L); + SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->n_name, strlen (entry->n_name))); + SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->n_aliases)); + SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->n_addrtype + 0L)); + SCM_VECTOR_SET(ans, 3, scm_ulong2num (entry->n_net + 0L)); return ans; } #undef FUNC_NAME @@ -286,7 +287,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, struct protoent *entry; ans = scm_c_make_vector (3, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); + ve = SCM_WRITABLE_VELTS (ans); if (SCM_UNBNDP (protocol)) { entry = getprotoent (); @@ -310,9 +311,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, } if (!entry) SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); - ve[0] = scm_mem2string (entry->p_name, strlen (entry->p_name)); - ve[1] = scm_makfromstrs (-1, entry->p_aliases); - ve[2] = SCM_MAKINUM (entry->p_proto + 0L); + SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->p_name, strlen (entry->p_name))); + SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->p_aliases)); + SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->p_proto + 0L)); return ans; } #undef FUNC_NAME @@ -326,11 +327,11 @@ scm_return_entry (struct servent *entry) SCM *ve; ans = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); - ve[0] = scm_mem2string (entry->s_name, strlen (entry->s_name)); - ve[1] = scm_makfromstrs (-1, entry->s_aliases); - ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L); - ve[3] = scm_mem2string (entry->s_proto, strlen (entry->s_proto)); + ve = SCM_WRITABLE_VELTS (ans); + SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->s_name, strlen (entry->s_name))); + SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->s_aliases)); + SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L)); + SCM_VECTOR_SET(ans, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto))); return ans; } @@ -367,7 +368,7 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, } else { - SCM_VALIDATE_INUM (1,name); + SCM_VALIDATE_INUM (1, name); entry = getservbyport (htons (SCM_INUM (name)), SCM_STRING_CHARS (protocol)); } if (!entry) diff --git a/libguile/numbers.c b/libguile/numbers.c index d3d8eca2e..09b81c7da 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -65,7 +65,7 @@ static SCM scm_divbigbig (SCM_BIGDIG *x, size_t nx, SCM_BIGDIG *y, size_t ny, in static SCM scm_divbigint (SCM x, long z, int sgn, int mode); -#define SCM_SWAP(x,y) do { SCM __t = x; x = y; y = __t; } while (0) +#define SCM_SWAP(x, y) do { SCM __t = x; x = y; y = __t; } while (0) /* FLOBUFLEN is the maximum number of characters neccessary for the @@ -1257,7 +1257,7 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, SCM_WRONG_TYPE_ARG (2, k); } else - SCM_VALIDATE_ULONG_COPY (2,k,i2); + SCM_VALIDATE_ULONG_COPY (2, k, i2); if (i2 < 0) { i2 = -i2; @@ -1350,7 +1350,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, #define FUNC_NAME s_scm_bit_extract { unsigned long int istart, iend; - SCM_VALIDATE_INUM_MIN_COPY (2,start,0,istart); + SCM_VALIDATE_INUM_MIN_COPY (2, start,0, istart); SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend); SCM_ASSERT_RANGE (3, end, (iend >= istart)); @@ -2992,7 +2992,7 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0, SCM answer; int base; SCM_VALIDATE_STRING (1, string); - SCM_VALIDATE_INUM_MIN_DEF_COPY (2,radix,2,10,base); + SCM_VALIDATE_INUM_MIN_DEF_COPY (2, radix,2,10, base); answer = scm_i_mem2number (SCM_STRING_CHARS (string), SCM_STRING_LENGTH (string), base); diff --git a/libguile/objects.c b/libguile/objects.c index 22fa968cb..4c22626c6 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -468,8 +468,8 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0, #define FUNC_NAME s_scm_make_class_object { unsigned long flags = 0; - SCM_VALIDATE_STRUCT (1,metaclass); - SCM_VALIDATE_STRING (2,layout); + SCM_VALIDATE_STRUCT (1, metaclass); + SCM_VALIDATE_STRING (2, layout); if (SCM_EQ_P (metaclass, scm_metaclass_operator)) flags = SCM_CLASSF_OPERATOR; return scm_i_make_class_object (metaclass, layout, flags); @@ -483,8 +483,8 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0, #define FUNC_NAME s_scm_make_subclass_object { SCM pl; - SCM_VALIDATE_STRUCT (1,class); - SCM_VALIDATE_STRING (2,layout); + SCM_VALIDATE_STRUCT (1, class); + SCM_VALIDATE_STRING (2, layout); pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]); /* Convert symbol->string */ pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl)); diff --git a/libguile/objects.h b/libguile/objects.h index afeeb181a..5bf79fc9b 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -92,7 +92,7 @@ ((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0) #define SCM_ENTITY_PROCEDURE(obj) \ (SCM_PACK (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure])) -#define SCM_SET_ENTITY_PROCEDURE(obj,v) \ +#define SCM_SET_ENTITY_PROCEDURE(obj, v) \ (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure] = SCM_UNPACK (v)) #define SCM_ENTITY_SETTER(obj) (SCM_PACK (SCM_STRUCT_DATA (obj)[scm_struct_i_setter])) #define SCM_SET_ENTITY_SETTER(obj, v) \ diff --git a/libguile/ports.c b/libguile/ports.c index fe9fcc6d6..057327460 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -264,7 +264,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_inp; else - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); pt = SCM_PTAB_ENTRY (port); @@ -340,7 +340,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0, scm_t_port *pt = SCM_PTAB_ENTRY (port); long count; - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); count = pt->read_end - pt->read_pos; if (pt->read_buf == pt->putback_buf) @@ -409,7 +409,7 @@ SCM_DEFINE (scm_set_current_input_port, "set-current-input-port", 1, 0, 0, #define FUNC_NAME s_scm_set_current_input_port { SCM oinp = scm_cur_inp; - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); scm_cur_inp = port; return oinp; } @@ -423,7 +423,7 @@ SCM_DEFINE (scm_set_current_output_port, "set-current-output-port", 1, 0, 0, { SCM ooutp = scm_cur_outp; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPOUTPORT (1,port); + SCM_VALIDATE_OPOUTPORT (1, port); scm_cur_outp = port; return ooutp; } @@ -437,7 +437,7 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0, { SCM oerrp = scm_cur_errp; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPOUTPORT (1,port); + SCM_VALIDATE_OPOUTPORT (1, port); scm_cur_errp = port; return oerrp; } @@ -538,7 +538,7 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0, #define FUNC_NAME s_scm_pt_member { long i; - SCM_VALIDATE_INUM_COPY (1,index,i); + SCM_VALIDATE_INUM_COPY (1, index, i); if (i < 0 || i >= scm_port_table_size) return SCM_BOOL_F; else @@ -579,7 +579,7 @@ SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0, #define FUNC_NAME s_scm_port_revealed { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); return SCM_MAKINUM (scm_revealed_count (port)); } #undef FUNC_NAME @@ -592,8 +592,8 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0, #define FUNC_NAME s_scm_set_port_revealed_x { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); - SCM_VALIDATE_INUM (2,rcount); + SCM_VALIDATE_OPENPORT (1, port); + SCM_VALIDATE_INUM (2, rcount); SCM_REVEALED (port) = SCM_INUM (rcount); return SCM_UNSPECIFIED; } @@ -638,7 +638,7 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0, modes[0] = '\0'; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPPORT (1,port); + SCM_VALIDATE_OPPORT (1, port); if (SCM_CELL_WORD_0 (port) & SCM_RDNG) { if (SCM_CELL_WORD_0 (port) & SCM_WRTNG) strcpy (modes, "r+"); @@ -805,7 +805,7 @@ SCM_DEFINE (scm_port_closed_p, "port-closed?", 1, 0, 0, "open.") #define FUNC_NAME s_scm_port_closed_p { - SCM_VALIDATE_PORT (1,port); + SCM_VALIDATE_PORT (1, port); return SCM_BOOL (!SCM_OPPORTP (port)); } #undef FUNC_NAME @@ -835,7 +835,7 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0, else { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPOUTPORT (1,port); + SCM_VALIDATE_OPOUTPORT (1, port); } scm_flush (port); return SCM_UNSPECIFIED; @@ -869,7 +869,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0, int c; if (SCM_UNBNDP (port)) port = scm_cur_inp; - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); c = scm_getc (port); if (EOF == c) return SCM_EOF_VAL; @@ -1196,7 +1196,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_inp; else - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); c = scm_getc (port); if (EOF == c) return SCM_EOF_VAL; @@ -1215,11 +1215,11 @@ SCM_DEFINE (scm_unread_char, "unread-char", 1, 1, 0, { int c; - SCM_VALIDATE_CHAR (1,cobj); + SCM_VALIDATE_CHAR (1, cobj); if (SCM_UNBNDP (port)) port = scm_cur_inp; else - SCM_VALIDATE_OPINPORT (2,port); + SCM_VALIDATE_OPINPORT (2, port); c = SCM_CHAR (cobj); @@ -1236,11 +1236,11 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0, "@var{port} is not supplied, the current-input-port is used.") #define FUNC_NAME s_scm_unread_string { - SCM_VALIDATE_STRING (1,str); + SCM_VALIDATE_STRING (1, str); if (SCM_UNBNDP (port)) port = scm_cur_inp; else - SCM_VALIDATE_OPINPORT (2,port); + SCM_VALIDATE_OPINPORT (2, port); scm_ungets (SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str), port); @@ -1297,7 +1297,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0, } else /* file descriptor?. */ { - SCM_VALIDATE_INUM (1,fd_port); + SCM_VALIDATE_INUM (1, fd_port); rv = lseek (SCM_INUM (fd_port), off, how); if (rv == -1) SCM_SYSERROR; @@ -1339,11 +1339,11 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, { /* must supply length if object is a filename. */ if (SCM_STRINGP (object)) - SCM_MISC_ERROR("must supply length if OBJECT is a filename",SCM_EOL); + SCM_MISC_ERROR("must supply length if OBJECT is a filename", SCM_EOL); length = scm_seek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); } - c_length = SCM_NUM2LONG (2,length); + c_length = SCM_NUM2LONG (2, length); if (c_length < 0) SCM_MISC_ERROR ("negative offset", SCM_EOL); @@ -1384,7 +1384,7 @@ SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0, #define FUNC_NAME s_scm_port_line { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); return SCM_MAKINUM (SCM_LINUM (port)); } #undef FUNC_NAME @@ -1395,8 +1395,8 @@ SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0, #define FUNC_NAME s_scm_set_port_line_x { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); - SCM_VALIDATE_INUM (2,line); + SCM_VALIDATE_OPENPORT (1, port); + SCM_VALIDATE_INUM (2, line); SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line); return SCM_UNSPECIFIED; } @@ -1416,7 +1416,7 @@ SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0, #define FUNC_NAME s_scm_port_column { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); return SCM_MAKINUM (SCM_COL (port)); } #undef FUNC_NAME @@ -1429,8 +1429,8 @@ SCM_DEFINE (scm_set_port_column_x, "set-port-column!", 2, 0, 0, #define FUNC_NAME s_scm_set_port_column_x { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); - SCM_VALIDATE_INUM (2,column); + SCM_VALIDATE_OPENPORT (1, port); + SCM_VALIDATE_INUM (2, column); SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column); return SCM_UNSPECIFIED; } @@ -1444,7 +1444,7 @@ SCM_DEFINE (scm_port_filename, "port-filename", 1, 0, 0, #define FUNC_NAME s_scm_port_filename { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); return SCM_FILENAME (port); } #undef FUNC_NAME @@ -1458,7 +1458,7 @@ SCM_DEFINE (scm_set_port_filename_x, "set-port-filename!", 2, 0, 0, #define FUNC_NAME s_scm_set_port_filename_x { port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPENPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); /* We allow the user to set the filename to whatever he likes. */ SCM_SET_FILENAME (port, filename); return SCM_UNSPECIFIED; diff --git a/libguile/ports.h b/libguile/ports.h index e9a1af950..500a3802a 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -168,15 +168,15 @@ SCM_API long scm_port_table_size; /* Number of ports in scm_port_table. */ SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN) #define SCM_PTAB_ENTRY(x) ((scm_t_port *) SCM_CELL_WORD_1 (x)) -#define SCM_SETPTAB_ENTRY(x,ent) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (ent))) +#define SCM_SETPTAB_ENTRY(x, ent) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (ent))) #define SCM_STREAM(x) (SCM_PTAB_ENTRY(x)->stream) -#define SCM_SETSTREAM(x,s) (SCM_PTAB_ENTRY(x)->stream = (scm_t_bits) (s)) +#define SCM_SETSTREAM(x, s) (SCM_PTAB_ENTRY(x)->stream = (scm_t_bits) (s)) #define SCM_FILENAME(x) (SCM_PTAB_ENTRY(x)->file_name) #define SCM_SET_FILENAME(x, n) (SCM_PTAB_ENTRY(x)->file_name = (n)) #define SCM_LINUM(x) (SCM_PTAB_ENTRY(x)->line_number) #define SCM_COL(x) (SCM_PTAB_ENTRY(x)->column_number) #define SCM_REVEALED(x) (SCM_PTAB_ENTRY(x)->revealed) -#define SCM_SETREVEALED(x,s) (SCM_PTAB_ENTRY(x)->revealed = (s)) +#define SCM_SETREVEALED(x, s) (SCM_PTAB_ENTRY(x)->revealed = (s)) #define SCM_INCLINE(port) {SCM_LINUM (port) += 1; SCM_COL (port) = 0;} #define SCM_INCCOL(port) {SCM_COL (port) += 1;} diff --git a/libguile/posix.c b/libguile/posix.c index 066e0f90b..f9d8a22e0 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -236,9 +236,13 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0, getgroups (ngroups, groups); ans = scm_c_make_vector (ngroups, SCM_UNDEFINED); - while (--ngroups >= 0) - SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]); + { + SCM * ve = SCM_WRITABLE_VELTS(ans); + + while (--ngroups >= 0) + ve[ngroups] = SCM_MAKINUM (groups [ngroups]); + } free (groups); return ans; } @@ -253,12 +257,9 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, "or getpwent respectively.") #define FUNC_NAME s_scm_getpwuid { - SCM result; struct passwd *entry; - SCM *ve; - result = scm_c_make_vector (7, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + SCM ans = scm_c_make_vector (7, SCM_UNSPECIFIED); if (SCM_UNBNDP (user) || SCM_FALSEP (user)) { SCM_SYSCALL (entry = getpwent ()); @@ -279,20 +280,20 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, if (!entry) SCM_MISC_ERROR ("entry not found", SCM_EOL); - ve[0] = scm_makfrom0str (entry->pw_name); - ve[1] = scm_makfrom0str (entry->pw_passwd); - ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid); - ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid); - ve[4] = scm_makfrom0str (entry->pw_gecos); + SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->pw_name)); + SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->pw_passwd)); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->pw_uid)); + SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) entry->pw_gid)); + SCM_VECTOR_SET(ans, 4, scm_makfrom0str (entry->pw_gecos)); if (!entry->pw_dir) - ve[5] = scm_makfrom0str (""); + SCM_VECTOR_SET(ans, 5, scm_makfrom0str ("")); else - ve[5] = scm_makfrom0str (entry->pw_dir); + SCM_VECTOR_SET(ans, 5, scm_makfrom0str (entry->pw_dir)); if (!entry->pw_shell) - ve[6] = scm_makfrom0str (""); + SCM_VECTOR_SET(ans, 6, scm_makfrom0str ("")); else - ve[6] = scm_makfrom0str (entry->pw_shell); - return result; + SCM_VECTOR_SET(ans, 6, scm_makfrom0str (entry->pw_shell)); + return ans; } #undef FUNC_NAME #endif /* HAVE_GETPWENT */ @@ -325,11 +326,9 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, "or getgrent respectively.") #define FUNC_NAME s_scm_getgrgid { - SCM result; struct group *entry; - SCM *ve; - result = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + SCM ans = scm_c_make_vector (4, SCM_UNSPECIFIED); + if (SCM_UNBNDP (name) || SCM_FALSEP (name)) { SCM_SYSCALL (entry = getgrent ()); @@ -348,11 +347,11 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, if (!entry) SCM_SYSERROR; - ve[0] = scm_makfrom0str (entry->gr_name); - ve[1] = scm_makfrom0str (entry->gr_passwd); - ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid); - ve[3] = scm_makfromstrs (-1, entry->gr_mem); - return result; + SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->gr_name)); + SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->gr_passwd)); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->gr_gid)); + SCM_VECTOR_SET(ans, 3, scm_makfromstrs (-1, entry->gr_mem)); + return ans; } #undef FUNC_NAME @@ -401,8 +400,8 @@ SCM_DEFINE (scm_kill, "kill", 2, 0, 0, "@end defvar") #define FUNC_NAME s_scm_kill { - SCM_VALIDATE_INUM (1,pid); - SCM_VALIDATE_INUM (2,sig); + SCM_VALIDATE_INUM (1, pid); + SCM_VALIDATE_INUM (2, sig); /* Signal values are interned in scm_init_posix(). */ #ifdef HAVE_KILL if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0) @@ -457,12 +456,12 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0, int i; int status; int ioptions; - SCM_VALIDATE_INUM (1,pid); + SCM_VALIDATE_INUM (1, pid); if (SCM_UNBNDP (options)) ioptions = 0; else { - SCM_VALIDATE_INUM (2,options); + SCM_VALIDATE_INUM (2, options); /* Flags are interned in scm_init_posix. */ ioptions = SCM_INUM (options); } @@ -484,7 +483,7 @@ SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0, { int lstatus; - SCM_VALIDATE_INUM (1,status); + SCM_VALIDATE_INUM (1, status); /* On Ultrix, the WIF... macros assume their argument is an lvalue; go figure. SCM_INUM does not yield an lvalue. */ @@ -504,7 +503,7 @@ SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0, { int lstatus; - SCM_VALIDATE_INUM (1,status); + SCM_VALIDATE_INUM (1, status); lstatus = SCM_INUM (status); if (WIFSIGNALED (lstatus)) @@ -522,7 +521,7 @@ SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0, { int lstatus; - SCM_VALIDATE_INUM (1,status); + SCM_VALIDATE_INUM (1, status); lstatus = SCM_INUM (status); if (WIFSTOPPED (lstatus)) @@ -610,7 +609,7 @@ SCM_DEFINE (scm_setuid, "setuid", 1, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_setuid { - SCM_VALIDATE_INUM (1,id); + SCM_VALIDATE_INUM (1, id); if (setuid (SCM_INUM (id)) != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -624,7 +623,7 @@ SCM_DEFINE (scm_setgid, "setgid", 1, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_setgid { - SCM_VALIDATE_INUM (1,id); + SCM_VALIDATE_INUM (1, id); if (setgid (SCM_INUM (id)) != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -642,7 +641,7 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0, { int rv; - SCM_VALIDATE_INUM (1,id); + SCM_VALIDATE_INUM (1, id); #ifdef HAVE_SETEUID rv = seteuid (SCM_INUM (id)); #else @@ -668,7 +667,7 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0, { int rv; - SCM_VALIDATE_INUM (1,id); + SCM_VALIDATE_INUM (1, id); #ifdef HAVE_SETEUID rv = setegid (SCM_INUM (id)); #else @@ -708,8 +707,8 @@ SCM_DEFINE (scm_setpgid, "setpgid", 2, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_setpgid { - SCM_VALIDATE_INUM (1,pid); - SCM_VALIDATE_INUM (2,pgid); + SCM_VALIDATE_INUM (1, pid); + SCM_VALIDATE_INUM (2, pgid); /* FIXME(?): may be known as setpgrp. */ if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0) SCM_SYSERROR; @@ -746,7 +745,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, int fd; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPPORT (1,port); + SCM_VALIDATE_OPPORT (1, port); if (!SCM_FPORTP (port)) return SCM_BOOL_F; fd = SCM_FPORT_FDES (port); @@ -794,7 +793,7 @@ SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0, port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); + SCM_VALIDATE_OPFPORT (1, port); fd = SCM_FPORT_FDES (port); if ((pgid = tcgetpgrp (fd)) == -1) SCM_SYSERROR; @@ -817,8 +816,8 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0, port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); - SCM_VALIDATE_INUM (2,pgid); + SCM_VALIDATE_OPFPORT (1, port); + SCM_VALIDATE_INUM (2, pgid); fd = SCM_FPORT_FDES (port); if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1) SCM_SYSERROR; @@ -984,17 +983,16 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0, { struct utsname buf; SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); if (uname (&buf) < 0) SCM_SYSERROR; - ve[0] = scm_makfrom0str (buf.sysname); - ve[1] = scm_makfrom0str (buf.nodename); - ve[2] = scm_makfrom0str (buf.release); - ve[3] = scm_makfrom0str (buf.version); - ve[4] = scm_makfrom0str (buf.machine); + SCM_VECTOR_SET(ans, 0, scm_makfrom0str (buf.sysname)); + SCM_VECTOR_SET(ans, 1, scm_makfrom0str (buf.nodename)); + SCM_VECTOR_SET(ans, 2, scm_makfrom0str (buf.release)); + SCM_VECTOR_SET(ans, 3, scm_makfrom0str (buf.version)); + SCM_VECTOR_SET(ans, 4, scm_makfrom0str (buf.machine)); /* a linux special? - ve[5] = scm_makfrom0str (buf.domainname); + SCM_VECTOR_SET(ans, 5, scm_makfrom0str (buf.domainname)); */ return ans; } @@ -1225,7 +1223,7 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, char *clocale; char *rv; - SCM_VALIDATE_INUM (1,category); + SCM_VALIDATE_INUM (1, category); if (SCM_UNBNDP (locale)) { clocale = NULL; @@ -1267,9 +1265,9 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, int ctype = 0; SCM_VALIDATE_STRING (1, path); - SCM_VALIDATE_SYMBOL (2,type); - SCM_VALIDATE_INUM (3,perms); - SCM_VALIDATE_INUM (4,dev); + SCM_VALIDATE_SYMBOL (2, type); + SCM_VALIDATE_INUM (3, perms); + SCM_VALIDATE_INUM (4, dev); p = SCM_SYMBOL_CHARS (type); if (strcmp (p, "regular") == 0) @@ -1289,7 +1287,7 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, ctype = S_IFSOCK; #endif else - SCM_OUT_OF_RANGE (2,type); + SCM_OUT_OF_RANGE (2, type); SCM_SYSCALL (val = mknod (SCM_STRING_CHARS (path), ctype | SCM_INUM (perms), SCM_INUM (dev))); @@ -1308,7 +1306,7 @@ SCM_DEFINE (scm_nice, "nice", 1, 0, 0, "The return value is unspecified.") #define FUNC_NAME s_scm_nice { - SCM_VALIDATE_INUM (1,incr); + SCM_VALIDATE_INUM (1, incr); if (nice(SCM_INUM(incr)) != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; diff --git a/libguile/print.c b/libguile/print.c index fd869402a..63389f1f5 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -216,7 +216,7 @@ make_print_state (void) = scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL); scm_print_state *pstate = SCM_PRINT_STATE (print_state); pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED); - pstate->ref_stack = SCM_VELTS (pstate->ref_vect); + pstate->ref_stack = SCM_WRITABLE_VELTS (pstate->ref_vect); pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect); return print_state; } @@ -260,23 +260,22 @@ static void grow_ref_stack (scm_print_state *pstate) { unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect); - SCM *old_elts = SCM_VELTS (pstate->ref_vect); + SCM const *old_elts = SCM_VELTS (pstate->ref_vect); unsigned long int new_size = 2 * pstate->ceiling; SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED); - SCM *new_elts = SCM_VELTS (new_vect); unsigned long int i; for (i = 0; i != old_size; ++i) - new_elts [i] = old_elts [i]; + SCM_VECTOR_SET (new_vect, i, old_elts [i]); pstate->ref_vect = new_vect; - pstate->ref_stack = new_elts; + pstate->ref_stack = SCM_WRITABLE_VELTS(new_vect); pstate->ceiling = new_size; } static void -print_circref (SCM port,scm_print_state *pstate,SCM ref) +print_circref (SCM port, scm_print_state *pstate, SCM ref) { register long i; long self = pstate->top - 1; @@ -757,7 +756,7 @@ scm_ipruk (char *hdr, SCM ptr, SCM port) /* Print a list. */ void -scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate) +scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate) { register SCM hare, tortoise; long floor = pstate->top - 2; @@ -1012,7 +1011,7 @@ SCM_DEFINE (scm_newline, "newline", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_outp; - SCM_VALIDATE_OPORT_VALUE (1,port); + SCM_VALIDATE_OPORT_VALUE (1, port); scm_putc ('\n', SCM_COERCE_OUTPORT (port)); return SCM_UNSPECIFIED; @@ -1027,8 +1026,8 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_outp; - SCM_VALIDATE_CHAR (1,chr); - SCM_VALIDATE_OPORT_VALUE (2,port); + SCM_VALIDATE_CHAR (1, chr); + SCM_VALIDATE_OPORT_VALUE (2, port); scm_putc ((int) SCM_CHAR (chr), SCM_COERCE_OUTPORT (port)); #ifdef HAVE_PIPE @@ -1079,8 +1078,8 @@ SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 2, 0, 0, #define FUNC_NAME s_scm_port_with_print_state { SCM pwps; - SCM_VALIDATE_OPORT_VALUE (1,port); - SCM_VALIDATE_PRINTSTATE (2,pstate); + SCM_VALIDATE_OPORT_VALUE (1, port); + SCM_VALIDATE_PRINTSTATE (2, pstate); port = SCM_COERCE_OUTPORT (port); SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (scm_cons (port, pstate))); return pwps; diff --git a/libguile/procprop.c b/libguile/procprop.c index 099691ca4..f7887ed55 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -176,7 +176,7 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0, "Return @var{obj}'s property list.") #define FUNC_NAME s_scm_procedure_properties { - SCM_VALIDATE_PROC (1,proc); + SCM_VALIDATE_PROC (1, proc); return scm_acons (scm_sym_arity, scm_i_procedure_arity (proc), SCM_PROCPROPS (SCM_CLOSUREP (proc) ? proc @@ -191,7 +191,7 @@ SCM_DEFINE (scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0 { if (!SCM_CLOSUREP (proc)) proc = scm_stand_in_scm_proc(proc); - SCM_VALIDATE_CLOSURE (1,proc); + SCM_VALIDATE_CLOSURE (1, proc); SCM_SETPROCPROPS (proc, new_val); return SCM_UNSPECIFIED; } @@ -210,7 +210,7 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0, p, SCM_ARG1, FUNC_NAME); return arity; } - SCM_VALIDATE_PROC (1,p); + SCM_VALIDATE_PROC (1, p); assoc = scm_sloppy_assq (k, SCM_PROCPROPS (SCM_CLOSUREP (p) ? p @@ -228,7 +228,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, SCM assoc; if (!SCM_CLOSUREP (p)) p = scm_stand_in_scm_proc(p); - SCM_VALIDATE_CLOSURE (1,p); + SCM_VALIDATE_CLOSURE (1, p); if (SCM_EQ_P (k, scm_sym_arity)) SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL); assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p)); diff --git a/libguile/ramap.c b/libguile/ramap.c index e2389451f..24c1474d9 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -488,7 +488,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) case scm_tc7_vector: case scm_tc7_wvect: for (i = base; n--; i += inc) - SCM_VELTS (ra)[i] = fill; + SCM_VECTOR_SET (ra, i, fill); break; case scm_tc7_string: SCM_ASRTGO (SCM_CHARP (fill), badarg2); @@ -905,7 +905,7 @@ scm_ra_eqp (SCM ra0, SCM ras) /* opt 0 means <, nonzero means >= */ static int -ra_compare (SCM ra0,SCM ra1,SCM ra2,int opt) +ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt) { long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2); @@ -1230,7 +1230,7 @@ scm_array_identity (SCM dst, SCM src) static int -ramap (SCM ra0,SCM proc,SCM ras) +ramap (SCM ra0, SCM proc, SCM ras) { long i = SCM_ARRAY_DIMS (ra0)->lbnd; long inc = SCM_ARRAY_DIMS (ra0)->inc; @@ -1243,7 +1243,8 @@ ramap (SCM ra0,SCM proc,SCM ras) else { SCM ra1 = SCM_CAR (ras); - SCM args, *ve = &ras; + SCM args; + SCM const *ve = &ras; unsigned long k, i1 = SCM_ARRAY_BASE (ra1); long inc1 = SCM_ARRAY_DIMS (ra1)->inc; ra1 = SCM_ARRAY_V (ra1); @@ -1255,6 +1256,7 @@ ramap (SCM ra0,SCM proc,SCM ras) ras = scm_vector (ras); ve = SCM_VELTS (ras); } + for (; i <= n; i++, i1 += inc1) { args = SCM_EOL; @@ -1269,7 +1271,7 @@ ramap (SCM ra0,SCM proc,SCM ras) static int -ramap_cxr (SCM ra0,SCM proc,SCM ras) +ramap_cxr (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras); SCM e1 = SCM_UNDEFINED; @@ -1330,7 +1332,7 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras) static int -ramap_rp (SCM ra0,SCM proc,SCM ras) +ramap_rp (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras)); SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED; @@ -1415,7 +1417,7 @@ ramap_rp (SCM ra0,SCM proc,SCM ras) static int -ramap_1 (SCM ra0,SCM proc,SCM ras) +ramap_1 (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras); SCM e1 = SCM_UNDEFINED; @@ -1436,7 +1438,7 @@ ramap_1 (SCM ra0,SCM proc,SCM ras) static int -ramap_2o (SCM ra0,SCM proc,SCM ras) +ramap_2o (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras); SCM e1 = SCM_UNDEFINED; @@ -1483,7 +1485,7 @@ ramap_2o (SCM ra0,SCM proc,SCM ras) static int -ramap_a (SCM ra0,SCM proc,SCM ras) +ramap_a (SCM ra0, SCM proc, SCM ras) { SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; @@ -1521,7 +1523,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, "unspecified. The order of application is unspecified.") #define FUNC_NAME s_scm_array_map_x { - SCM_VALIDATE_PROC (2,proc); + SCM_VALIDATE_PROC (2, proc); SCM_VALIDATE_REST_ARGUMENT (lra); switch (SCM_TYP7 (proc)) { @@ -1624,7 +1626,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, static int -rafe (SCM ra0,SCM proc,SCM ras) +rafe (SCM ra0, SCM proc, SCM ras) { long i = SCM_ARRAY_DIMS (ra0)->lbnd; unsigned long i0 = SCM_ARRAY_BASE (ra0); @@ -1637,7 +1639,8 @@ rafe (SCM ra0,SCM proc,SCM ras) else { SCM ra1 = SCM_CAR (ras); - SCM args, *ve = &ras; + SCM args; + SCM const*ve = &ras; unsigned long k, i1 = SCM_ARRAY_BASE (ra1); long inc1 = SCM_ARRAY_DIMS (ra1)->inc; ra1 = SCM_ARRAY_V (ra1); @@ -1668,7 +1671,7 @@ SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1, "in row-major order. The value returned is unspecified.") #define FUNC_NAME s_scm_array_for_each { - SCM_VALIDATE_PROC (1,proc); + SCM_VALIDATE_PROC (1, proc); SCM_VALIDATE_REST_ARGUMENT (lra); scm_ramapc (rafe, proc, ra0, lra, FUNC_NAME); return SCM_UNSPECIFIED; @@ -1697,8 +1700,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, #define FUNC_NAME s_scm_array_index_map_x { unsigned long i; - SCM_VALIDATE_NIM (1,ra); - SCM_VALIDATE_PROC (2,proc); + SCM_VALIDATE_NIM (1, ra); + SCM_VALIDATE_PROC (2, proc); switch (SCM_TYP7(ra)) { default: @@ -1706,9 +1709,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, case scm_tc7_vector: case scm_tc7_wvect: { - SCM *ve = SCM_VELTS (ra); for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++) - ve[i] = scm_call_1 (proc, SCM_MAKINUM (i)); + SCM_VECTOR_SET(ra, i, scm_call_1 (proc, SCM_MAKINUM (i))); return SCM_UNSPECIFIED; } case scm_tc7_string: @@ -1778,7 +1780,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, static int -raeql_1 (SCM ra0,SCM as_equal,SCM ra1) +raeql_1 (SCM ra0, SCM as_equal, SCM ra1) { SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; unsigned long i0 = 0, i1 = 0; @@ -1906,7 +1908,7 @@ raeql_1 (SCM ra0,SCM as_equal,SCM ra1) static int -raeql (SCM ra0,SCM as_equal,SCM ra1) +raeql (SCM ra0, SCM as_equal, SCM ra1) { SCM v0 = ra0, v1 = ra1; scm_t_array_dim dim0, dim1; diff --git a/libguile/random.c b/libguile/random.c index 319d2a0c6..ea1d3a755 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -362,7 +362,7 @@ SCM_GLOBAL_VARIABLE_INIT (scm_var_random_state, "*random-state*", scm_seed_to_ra SCM_DEFINE (scm_random, "random", 1, 1, 0, (SCM n, SCM state), - "Return a number in [0,N).\n" + "Return a number in [0, N).\n" "\n" "Accepts a positive integer or real n and returns a\n" "number of the same type between zero (inclusive) and\n" @@ -378,14 +378,14 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (2,state); + SCM_VALIDATE_RSTATE (2, state); if (SCM_INUMP (n)) { unsigned long m = SCM_INUM (n); - SCM_ASSERT_RANGE (1,n,m > 0); + SCM_ASSERT_RANGE (1, n, m > 0); return SCM_MAKINUM (scm_c_random (SCM_RSTATE (state), m)); } - SCM_VALIDATE_NIM (1,n); + SCM_VALIDATE_NIM (1, n); if (SCM_REALP (n)) return scm_make_real (SCM_REAL_VALUE (n) * scm_c_uniform01 (SCM_RSTATE (state))); @@ -401,7 +401,7 @@ SCM_DEFINE (scm_copy_random_state, "copy-random-state", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (1,state); + SCM_VALIDATE_RSTATE (1, state); return make_rstate (scm_the_rng.copy_rstate (SCM_RSTATE (state))); } #undef FUNC_NAME @@ -413,7 +413,7 @@ SCM_DEFINE (scm_seed_to_random_state, "seed->random-state", 1, 0, 0, { if (SCM_NUMBERP (seed)) seed = scm_number_to_string (seed, SCM_UNDEFINED); - SCM_VALIDATE_STRING (1,seed); + SCM_VALIDATE_STRING (1, seed); return make_rstate (scm_c_make_rstate (SCM_STRING_CHARS (seed), SCM_STRING_LENGTH (seed))); } @@ -427,7 +427,7 @@ SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (1,state); + SCM_VALIDATE_RSTATE (1, state); return scm_make_real (scm_c_uniform01 (SCM_RSTATE (state))); } #undef FUNC_NAME @@ -442,7 +442,7 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (1,state); + SCM_VALIDATE_RSTATE (1, state); return scm_make_real (scm_c_normal01 (SCM_RSTATE (state))); } #undef FUNC_NAME @@ -496,10 +496,10 @@ SCM_DEFINE (scm_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, "The sum of the squares of the numbers is returned.") #define FUNC_NAME s_scm_random_solid_sphere_x { - SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v); + SCM_VALIDATE_VECTOR_OR_DVECTOR (1, v); if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (2,state); + SCM_VALIDATE_RSTATE (2, state); scm_random_normal_vector_x (v, state); vector_scale (v, pow (scm_c_uniform01 (SCM_RSTATE (state)), @@ -519,10 +519,10 @@ SCM_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0, "unit n-sphere.") #define FUNC_NAME s_scm_random_hollow_sphere_x { - SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v); + SCM_VALIDATE_VECTOR_OR_DVECTOR (1, v); if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (2,state); + SCM_VALIDATE_RSTATE (2, state); scm_random_normal_vector_x (v, state); vector_scale (v, 1 / sqrt (vector_sum_squares (v))); return SCM_UNSPECIFIED; @@ -538,14 +538,14 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0, #define FUNC_NAME s_scm_random_normal_vector_x { int n; - SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v); + SCM_VALIDATE_VECTOR_OR_DVECTOR (1, v); if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (2,state); + SCM_VALIDATE_RSTATE (2, state); n = SCM_INUM (scm_uniform_vector_length (v)); if (SCM_VECTORP (v)) while (--n >= 0) - SCM_VELTS (v)[n] = scm_make_real (scm_c_normal01 (SCM_RSTATE (state))); + SCM_VECTOR_SET (v, n, scm_make_real (scm_c_normal01 (SCM_RSTATE (state)))); else while (--n >= 0) ((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state)); @@ -564,7 +564,7 @@ SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); - SCM_VALIDATE_RSTATE (1,state); + SCM_VALIDATE_RSTATE (1, state); return scm_make_real (scm_c_exp1 (SCM_RSTATE (state))); } #undef FUNC_NAME diff --git a/libguile/read.c b/libguile/read.c index 36a9fff2d..f829cd535 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -107,7 +107,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_cur_inp; - SCM_VALIDATE_OPINPORT (1,port); + SCM_VALIDATE_OPINPORT (1, port); c = scm_flush_ws (port, (char *) NULL); if (EOF == c) @@ -280,7 +280,7 @@ static SCM scm_get_hash_procedure(int c); static char s_list[]="list"; SCM -scm_lreadr (SCM *tok_buf,SCM port,SCM *copy) +scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) #define FUNC_NAME "scm_lreadr" { int c; diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index eb28ebe4b..ddb73ea03 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -247,13 +247,13 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, regmatch_t *matches; SCM mvec = SCM_BOOL_F; - SCM_VALIDATE_RGXP (1,rx); + SCM_VALIDATE_RGXP (1, rx); SCM_VALIDATE_STRING (2, str); - SCM_VALIDATE_INUM_DEF_COPY (3,start,0,offset); - SCM_ASSERT_RANGE (3,start, offset >= 0 && offset <= SCM_STRING_LENGTH (str)); + SCM_VALIDATE_INUM_DEF_COPY (3, start,0, offset); + SCM_ASSERT_RANGE (3, start, offset >= 0 && offset <= SCM_STRING_LENGTH (str)); if (SCM_UNBNDP (flags)) flags = SCM_INUM0; - SCM_VALIDATE_INUM (4,flags); + SCM_VALIDATE_INUM (4, flags); /* re_nsub doesn't account for the `subexpression' representing the whole regexp, so add 1 to nmatches. */ diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index cdb44e049..95e15ec4d 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -192,10 +192,10 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, #endif int query_only = 0; int save_handler = 0; - SCM *scheme_handlers = SCM_VELTS (*signal_handlers); + SCM old_handler; - SCM_VALIDATE_INUM_COPY (1,signum,csig); + SCM_VALIDATE_INUM_COPY (1, signum, csig); #if defined(HAVE_SIGACTION) #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS) /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS @@ -207,13 +207,13 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, #endif if (!SCM_UNBNDP (flags)) { - SCM_VALIDATE_INUM (3,flags); + SCM_VALIDATE_INUM (3, flags); action.sa_flags |= SCM_INUM (flags); } sigemptyset (&action.sa_mask); #endif SCM_DEFER_INTS; - old_handler = scheme_handlers[csig]; + old_handler = SCM_VELTS(*signal_handlers)[csig]; if (SCM_UNBNDP (handler)) query_only = 1; else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T)) @@ -226,7 +226,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, #else chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler); #endif - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F); } else SCM_OUT_OF_RANGE (2, handler); @@ -241,7 +241,8 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, { action = orig_handlers[csig]; orig_handlers[csig].sa_handler = SIG_ERR; - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F); + } #else if (orig_handlers[csig] == SIG_ERR) @@ -250,13 +251,13 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, { chandler = orig_handlers[csig]; orig_handlers[csig] = SIG_ERR; - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F); } #endif } else { - SCM_VALIDATE_NIM (2,handler); + SCM_VALIDATE_NIM (2, handler); #ifdef HAVE_SIGACTION action.sa_handler = take_signal; if (orig_handlers[csig].sa_handler == SIG_ERR) @@ -266,7 +267,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, if (orig_handlers[csig] == SIG_ERR) save_handler = 1; #endif - scheme_handlers[csig] = handler; + SCM_VECTOR_SET (*signal_handlers, csig, handler); } /* XXX - Silently ignore setting handlers for `program error signals' @@ -346,8 +347,6 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0, #define FUNC_NAME s_scm_restore_signals { int i; - SCM *scheme_handlers = SCM_VELTS (*signal_handlers); - for (i = 0; i < NSIG; i++) { #ifdef HAVE_SIGACTION @@ -356,7 +355,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0, if (sigaction (i, &orig_handlers[i], NULL) == -1) SCM_SYSERROR; orig_handlers[i].sa_handler = SIG_ERR; - scheme_handlers[i] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F); } #else if (orig_handlers[i] != SIG_ERR) @@ -364,7 +363,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0, if (signal (i, orig_handlers[i]) == SIG_ERR) SCM_SYSERROR; orig_handlers[i] = SIG_ERR; - scheme_handlers[i] = SCM_BOOL_F; + SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F); } #endif } @@ -385,7 +384,7 @@ SCM_DEFINE (scm_alarm, "alarm", 1, 0, 0, #define FUNC_NAME s_scm_alarm { unsigned int j; - SCM_VALIDATE_INUM (1,i); + SCM_VALIDATE_INUM (1, i); j = alarm (SCM_INUM (i)); return SCM_MAKINUM (j); } @@ -496,7 +495,7 @@ SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0, #define FUNC_NAME s_scm_sleep { unsigned long j; - SCM_VALIDATE_INUM_MIN (1,i,0); + SCM_VALIDATE_INUM_MIN (1, i,0); #ifdef USE_THREADS j = scm_thread_sleep (SCM_INUM(i)); #else @@ -513,7 +512,7 @@ SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0, "all platforms.") #define FUNC_NAME s_scm_usleep { - SCM_VALIDATE_INUM_MIN (1,i,0); + SCM_VALIDATE_INUM_MIN (1, i,0); #ifdef USE_THREADS /* If we have threads, we use the thread system's sleep function. */ @@ -542,7 +541,7 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0, "@var{sig} is as described for the kill procedure.") #define FUNC_NAME s_scm_raise { - SCM_VALIDATE_INUM (1,sig); + SCM_VALIDATE_INUM (1, sig); SCM_DEFER_INTS; if (kill (getpid (), (int) SCM_INUM (sig)) != 0) SCM_SYSERROR; diff --git a/libguile/simpos.c b/libguile/simpos.c index 5dc7fff13..f3269000f 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -121,7 +121,7 @@ SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0, int cstatus = 0; if (!SCM_UNBNDP (status)) { - SCM_VALIDATE_INUM (1,status); + SCM_VALIDATE_INUM (1, status); cstatus = SCM_INUM (status); } exit (cstatus); diff --git a/libguile/smob.c b/libguile/smob.c index e907fb107..847748d33 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -137,11 +137,11 @@ scm_smob_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) #define SCM_SMOB_APPLY0(SMOB) \ SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB) -#define SCM_SMOB_APPLY1(SMOB,A1) \ +#define SCM_SMOB_APPLY1(SMOB, A1) \ SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1) -#define SCM_SMOB_APPLY2(SMOB,A1,A2) \ +#define SCM_SMOB_APPLY2(SMOB, A1, A2) \ SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2) -#define SCM_SMOB_APPLY3(SMOB,A1,A2,A3) \ +#define SCM_SMOB_APPLY3(SMOB, A1, A2, A3) \ SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2, A3) static SCM diff --git a/libguile/smob.h b/libguile/smob.h index 50de243ce..c1893a433 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -115,9 +115,9 @@ do { \ #define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)]) #define SCM_SMOB_APPLICABLE_P(x) (SCM_SMOB_DESCRIPTOR (x).apply) #define SCM_SMOB_APPLY_0(x) (SCM_SMOB_DESCRIPTOR (x).apply_0 (x)) -#define SCM_SMOB_APPLY_1(x,a1) (SCM_SMOB_DESCRIPTOR (x).apply_1 (x, (a1))) -#define SCM_SMOB_APPLY_2(x,a1,a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2))) -#define SCM_SMOB_APPLY_3(x,a1,a2,rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst))) +#define SCM_SMOB_APPLY_1(x, a1) (SCM_SMOB_DESCRIPTOR (x).apply_1 (x, (a1))) +#define SCM_SMOB_APPLY_2(x, a1, a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2))) +#define SCM_SMOB_APPLY_3(x, a1, a2, rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst))) SCM_API long scm_numsmob; SCM_API scm_smob_descriptor scm_smobs[]; diff --git a/libguile/socket.c b/libguile/socket.c index 86b61aca1..5ea34d78a 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -473,9 +473,9 @@ SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0, int fam; int fd[2]; - SCM_VALIDATE_INUM (1,family); - SCM_VALIDATE_INUM (2,style); - SCM_VALIDATE_INUM (3,proto); + SCM_VALIDATE_INUM (1, family); + SCM_VALIDATE_INUM (2, style); + SCM_VALIDATE_INUM (3, proto); fam = SCM_INUM (family); @@ -673,9 +673,9 @@ SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0, { int fd; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); - SCM_VALIDATE_INUM (2,how); - SCM_ASSERT_RANGE(2,how,0 <= SCM_INUM (how) && 2 >= SCM_INUM (how)); + SCM_VALIDATE_OPFPORT (1, sock); + SCM_VALIDATE_INUM (2, how); + SCM_ASSERT_RANGE(2, how,0 <= SCM_INUM (how) && 2 >= SCM_INUM (how)); fd = SCM_FPORT_FDES (sock); if (shutdown (fd, SCM_INUM (how)) == -1) SCM_SYSERROR; @@ -820,8 +820,8 @@ SCM_DEFINE (scm_connect, "connect", 3, 0, 1, int size; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); - SCM_VALIDATE_INUM (2,fam); + SCM_VALIDATE_OPFPORT (1, sock); + SCM_VALIDATE_INUM (2, fam); fd = SCM_FPORT_FDES (sock); soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, FUNC_NAME, &size); @@ -911,8 +911,8 @@ SCM_DEFINE (scm_listen, "listen", 2, 0, 0, { int fd; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); - SCM_VALIDATE_INUM (2,backlog); + SCM_VALIDATE_OPFPORT (1, sock); + SCM_VALIDATE_INUM (2, backlog); fd = SCM_FPORT_FDES (sock); if (listen (fd, SCM_INUM (backlog)) == -1) SCM_SYSERROR; @@ -925,8 +925,8 @@ static SCM scm_addr_vector (const struct sockaddr *address, const char *proc) { short int fam = address->sa_family; - SCM result; - SCM *ve; + SCM ans =SCM_EOL; + switch (fam) { @@ -934,11 +934,11 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_in *nad = (struct sockaddr_in *) address; - result = scm_c_make_vector (3, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); - ve[0] = scm_ulong2num ((unsigned long) fam); - ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); - ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); + ans = scm_c_make_vector (3, SCM_UNSPECIFIED); + + SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(ans, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr))); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port))); } break; #ifdef HAVE_IPV6 @@ -946,16 +946,15 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address; - result = scm_c_make_vector (5, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); - ve[0] = scm_ulong2num ((unsigned long) fam); - ve[1] = ipv6_net_to_num (nad->sin6_addr.s6_addr); - ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)); - ve[3] = scm_ulong2num ((unsigned long) nad->sin6_flowinfo); + ans = scm_c_make_vector (5, SCM_UNSPECIFIED); + SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(ans, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr)); + SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port))); + SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo)); #ifdef HAVE_SIN6_SCOPE_ID - ve[4] = scm_ulong2num ((unsigned long) nad->sin6_scope_id); + SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) nad->sin6_scope_id)); #else - ve[4] = SCM_INUM0; + SCM_VECTOR_SET(ans, 4, SCM_INUM0); #endif } break; @@ -965,10 +964,10 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_un *nad = (struct sockaddr_un *) address; - result = scm_c_make_vector (2, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); - ve[0] = scm_ulong2num ((unsigned long) fam); - ve[1] = scm_mem2string (nad->sun_path, strlen (nad->sun_path)); + ans = scm_c_make_vector (2, SCM_UNSPECIFIED); + + SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(ans, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path))); } break; #endif @@ -976,7 +975,7 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) scm_misc_error (proc, "Unrecognised address family: ~A", scm_list_1 (SCM_MAKINUM (fam))); } - return result; + return ans; } /* calculate the size of a buffer large enough to hold any supported @@ -1047,7 +1046,7 @@ SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0, struct sockaddr *addr = (struct sockaddr *) max_addr; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); + SCM_VALIDATE_OPFPORT (1, sock); fd = SCM_FPORT_FDES (sock); if (getsockname (fd, addr, &addr_size) == -1) SCM_SYSERROR; @@ -1069,7 +1068,7 @@ SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0, struct sockaddr *addr = (struct sockaddr *) max_addr; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); + SCM_VALIDATE_OPFPORT (1, sock); fd = SCM_FPORT_FDES (sock); if (getpeername (fd, addr, &addr_size) == -1) SCM_SYSERROR; @@ -1102,9 +1101,9 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0, int fd; int flg; - SCM_VALIDATE_OPFPORT (1,sock); - SCM_VALIDATE_STRING (2,buf); - SCM_VALIDATE_INUM_DEF_COPY (3,flags,0,flg); + SCM_VALIDATE_OPFPORT (1, sock); + SCM_VALIDATE_STRING (2, buf); + SCM_VALIDATE_INUM_DEF_COPY (3, flags,0, flg); fd = SCM_FPORT_FDES (sock); SCM_SYSCALL (rv = recv (fd, SCM_STRING_CHARS (buf), SCM_STRING_LENGTH (buf), flg)); @@ -1136,9 +1135,9 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0, int flg; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_OPFPORT (1,sock); + SCM_VALIDATE_OPFPORT (1, sock); SCM_VALIDATE_STRING (2, message); - SCM_VALIDATE_INUM_DEF_COPY (3,flags,0,flg); + SCM_VALIDATE_INUM_DEF_COPY (3, flags,0, flg); fd = SCM_FPORT_FDES (sock); SCM_SYSCALL (rv = send (fd, SCM_STRING_CHARS (message), SCM_STRING_LENGTH (message), flg)); @@ -1182,7 +1181,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0, char max_addr[MAX_ADDR_SIZE]; struct sockaddr *addr = (struct sockaddr *) max_addr; - SCM_VALIDATE_OPFPORT (1,sock); + SCM_VALIDATE_OPFPORT (1, sock); fd = SCM_FPORT_FDES (sock); SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str, buf, 4, start, offset, 5, end, cend); @@ -1236,9 +1235,9 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1, int size; sock = SCM_COERCE_OUTPORT (sock); - SCM_VALIDATE_FPORT (1,sock); + SCM_VALIDATE_FPORT (1, sock); SCM_VALIDATE_STRING (2, message); - SCM_VALIDATE_INUM (3,fam); + SCM_VALIDATE_INUM (3, fam); fd = SCM_FPORT_FDES (sock); soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4, FUNC_NAME, &size); @@ -1246,7 +1245,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1, flg = 0; else { - SCM_VALIDATE_CONS (5,args_and_flags); + SCM_VALIDATE_CONS (5, args_and_flags); flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags)); } SCM_SYSCALL (rv = sendto (fd, SCM_STRING_CHARS (message), diff --git a/libguile/sort.c b/libguile/sort.c index ac0eaf5a2..8bca27c41 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -425,18 +425,20 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, size_t vlen, spos, len, size = sizeof (SCM); SCM *vp; - SCM_VALIDATE_VECTOR (1,vec); - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_VECTOR (1, vec); + SCM_VALIDATE_NIM (2, less); - vp = SCM_VELTS (vec); /* vector pointer */ + vp = SCM_WRITABLE_VELTS (vec); /* vector pointer */ vlen = SCM_VECTOR_LENGTH (vec); SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos); - SCM_ASSERT_RANGE (3,startpos, spos <= vlen); - SCM_VALIDATE_INUM_RANGE (4,endpos,0,vlen+1); + SCM_ASSERT_RANGE (3, startpos, spos <= vlen); + SCM_VALIDATE_INUM_RANGE (4, endpos,0, vlen+1); len = SCM_INUM (endpos) - spos; quicksort (&vp[spos], len, size, scm_cmp_function (less), less); + SCM_GC_FLAG_OBJECT_WRITE(vec); + return SCM_UNSPECIFIED; /* return vec; */ } @@ -455,18 +457,18 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, { long len, j; /* list/vector length, temp j */ SCM item, rest; /* rest of items loop variable */ - SCM *vp; + SCM const *vp; cmp_fun_t cmp = scm_cmp_function (less); if (SCM_NULL_OR_NIL_P (items)) return SCM_BOOL_T; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { len = scm_ilength (items); /* also checks that it's a pure list */ - SCM_ASSERT_RANGE (1,items,len >= 0); + SCM_ASSERT_RANGE (1, items, len >= 0); if (len <= 1) return SCM_BOOL_T; @@ -529,7 +531,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, long alen, blen; /* list lengths */ SCM build, last; cmp_fun_t cmp = scm_cmp_function (less); - SCM_VALIDATE_NIM (3,less); + SCM_VALIDATE_NIM (3, less); if (SCM_NULL_OR_NIL_P (alist)) return blist; @@ -537,8 +539,8 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, return alist; else { - SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1,alist,alen); - SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2,blist,blen); + SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen); + SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen); if ((*cmp) (less, SCM_CARLOC (blist), SCM_CARLOC (alist))) { build = scm_cons (SCM_CAR (blist), SCM_EOL); @@ -641,15 +643,15 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, { long alen, blen; /* list lengths */ - SCM_VALIDATE_NIM (3,less); + SCM_VALIDATE_NIM (3, less); if (SCM_NULL_OR_NIL_P (alist)) return blist; else if (SCM_NULL_OR_NIL_P (blist)) return alist; else { - SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1,alist,alen); - SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2,blist,blen); + SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen); + SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen); return scm_merge_list_x (alist, blist, alen, blen, scm_cmp_function (less), @@ -719,11 +721,11 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { - SCM_VALIDATE_LIST_COPYLEN (1,items,len); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } else if (SCM_VECTORP (items)) @@ -752,12 +754,12 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { long len; - SCM_VALIDATE_LIST_COPYLEN (1,items,len); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); items = scm_list_copy (items); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } @@ -850,10 +852,10 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { - SCM_VALIDATE_LIST_COPYLEN (1,items,len); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } else if (SCM_VECTORP (items)) @@ -861,7 +863,14 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, SCM *temp, *vp; len = SCM_VECTOR_LENGTH (items); temp = malloc (len * sizeof(SCM)); - vp = SCM_VELTS (items); + + + vp = SCM_WRITABLE_VELTS (items); + /* + This routine modifies VP + */ + + SCM_GC_FLAG_OBJECT_WRITE(items); scm_merge_vector_step (vp, temp, scm_cmp_function (less), @@ -889,10 +898,10 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, if (SCM_NULL_OR_NIL_P (items)) return items; - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { - SCM_VALIDATE_LIST_COPYLEN (1,items,len); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); items = scm_list_copy (items); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } @@ -906,7 +915,12 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, retvec = scm_make_uve (len, scm_array_prototype (items)); scm_array_copy_x (items, retvec); temp = malloc (len * sizeof (SCM)); - vp = SCM_VELTS (retvec); + + /* + don't worry about write barrier: retvec is new anyway. + */ + vp = SCM_WRITABLE_VELTS (retvec); + scm_merge_vector_step (vp, temp, scm_cmp_function (less), @@ -932,8 +946,8 @@ SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0, #define FUNC_NAME s_scm_sort_list_x { long len; - SCM_VALIDATE_LIST_COPYLEN (1,items,len); - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); + SCM_VALIDATE_NIM (2, less); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } #undef FUNC_NAME @@ -946,8 +960,8 @@ SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0, #define FUNC_NAME s_scm_sort_list { long len; - SCM_VALIDATE_LIST_COPYLEN (1,items,len); - SCM_VALIDATE_NIM (2,less); + SCM_VALIDATE_LIST_COPYLEN (1, items, len); + SCM_VALIDATE_NIM (2, less); items = scm_list_copy (items); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); } diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 3c679d3bd..a47dfc0ea 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -179,7 +179,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, #define FUNC_NAME s_scm_source_properties { SCM p; - SCM_VALIDATE_NIM (1,obj); + SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); else if (!SCM_CONSP (obj)) @@ -200,7 +200,7 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0, #define FUNC_NAME s_scm_set_source_properties_x { SCM handle; - SCM_VALIDATE_NIM (1,obj); + SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); else if (!SCM_CONSP (obj)) @@ -218,7 +218,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, #define FUNC_NAME s_scm_source_property { SCM p; - SCM_VALIDATE_NIM (1,obj); + SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); else if (!SCM_CONSP (obj)) @@ -250,7 +250,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, { scm_whash_handle h; SCM p; - SCM_VALIDATE_NIM (1,obj); + SCM_VALIDATE_NIM (1, obj); if (SCM_MEMOIZEDP (obj)) obj = SCM_MEMOIZED_EXP (obj); else if (!SCM_CONSP (obj)) @@ -284,7 +284,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, } else if (SCM_EQ_P (scm_sym_line, key)) { - SCM_VALIDATE_INUM (3,datum); + SCM_VALIDATE_INUM (3, datum); if (SRCPROPSP (p)) SETSRCPROPLINE (p, SCM_INUM (datum)); else @@ -294,7 +294,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, } else if (SCM_EQ_P (scm_sym_column, key)) { - SCM_VALIDATE_INUM (3,datum); + SCM_VALIDATE_INUM (3, datum); if (SRCPROPSP (p)) SETSRCPROPCOL (p, SCM_INUM (datum)); else diff --git a/libguile/srcprop.h b/libguile/srcprop.h index 117dc39ed..37b452be9 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -110,10 +110,10 @@ typedef struct scm_t_srcprops_chunk #define CLEARSRCPROPBRK(p) \ (SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) \ & ~SCM_SOURCE_PROPERTY_FLAG_BREAK)) -#define SRCPROPMAKPOS(l,c) (((l) << 12) + (c)) -#define SETSRCPROPPOS(p,l,c) (SRCPROPPOS (p) = SRCPROPMAKPOS (l, c)) -#define SETSRCPROPLINE(p,l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) -#define SETSRCPROPCOL(p,c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) +#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c)) +#define SETSRCPROPPOS(p, l, c) (SRCPROPPOS (p) = SRCPROPMAKPOS (l, c)) +#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) +#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) #define PROCTRACEP(x) (!SCM_FALSEP (scm_procedure_property (x, scm_sym_trace))) diff --git a/libguile/stacks.c b/libguile/stacks.c index a2a397985..5765a2286 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -151,7 +151,7 @@ * is read from a continuation. */ static scm_t_bits -stack_depth (scm_t_debug_frame *dframe,long offset,SCM *id,int *maxp) +stack_depth (scm_t_debug_frame *dframe, long offset, SCM *id, int *maxp) { long n; long max_depth = SCM_BACKTRACE_MAXDEPTH; @@ -183,7 +183,7 @@ stack_depth (scm_t_debug_frame *dframe,long offset,SCM *id,int *maxp) /* Read debug info from DFRAME into IFRAME. */ static void -read_frame (scm_t_debug_frame *dframe,long offset,scm_t_info_frame *iframe) +read_frame (scm_t_debug_frame *dframe, long offset, scm_t_info_frame *iframe) { scm_t_bits flags = SCM_UNPACK (SCM_INUM0); /* UGh. */ if (SCM_EVALFRAMEP (*dframe)) @@ -250,7 +250,7 @@ do { \ */ static scm_t_bits -read_frames (scm_t_debug_frame *dframe,long offset,long n,scm_t_info_frame *iframes) +read_frames (scm_t_debug_frame *dframe, long offset, long n, scm_t_info_frame *iframes) { scm_t_info_frame *iframe = iframes; scm_t_debug_info *info; @@ -344,7 +344,7 @@ read_frames (scm_t_debug_frame *dframe,long offset,long n,scm_t_info_frame *ifra */ static void -narrow_stack (SCM stack,long inner,SCM inner_key,long outer,SCM outer_key) +narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) { scm_t_stack *s = SCM_STACK (stack); unsigned long int i; @@ -591,7 +591,7 @@ SCM_DEFINE (scm_stack_length, "stack-length", 1, 0, 0, "Return the length of @var{stack}.") #define FUNC_NAME s_scm_stack_length { - SCM_VALIDATE_STACK (1,stack); + SCM_VALIDATE_STACK (1, stack); return SCM_MAKINUM (SCM_STACK_LENGTH (stack)); } #undef FUNC_NAME @@ -657,7 +657,7 @@ SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0, "Return the frame number of @var{frame}.") #define FUNC_NAME s_scm_frame_number { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_MAKINUM (SCM_FRAME_NUMBER (frame)); } #undef FUNC_NAME @@ -667,7 +667,7 @@ SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0, "Return the source of @var{frame}.") #define FUNC_NAME s_scm_frame_source { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_FRAME_SOURCE (frame); } #undef FUNC_NAME @@ -678,7 +678,7 @@ SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0, "procedure is associated with @var{frame}.") #define FUNC_NAME s_scm_frame_procedure { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return (SCM_FRAME_PROC_P (frame) ? SCM_FRAME_PROC (frame) : SCM_BOOL_F); @@ -690,7 +690,7 @@ SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0, "Return the arguments of @var{frame}.") #define FUNC_NAME s_scm_frame_arguments { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_FRAME_ARGS (frame); } #undef FUNC_NAME @@ -732,7 +732,7 @@ SCM_DEFINE (scm_frame_real_p, "frame-real?", 1, 0, 0, "Return @code{#t} if @var{frame} is a real frame.") #define FUNC_NAME s_scm_frame_real_p { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_BOOL(SCM_FRAME_REAL_P (frame)); } #undef FUNC_NAME @@ -742,7 +742,7 @@ SCM_DEFINE (scm_frame_procedure_p, "frame-procedure?", 1, 0, 0, "Return @code{#t} if a procedure is associated with @var{frame}.") #define FUNC_NAME s_scm_frame_procedure_p { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_BOOL(SCM_FRAME_PROC_P (frame)); } #undef FUNC_NAME @@ -752,7 +752,7 @@ SCM_DEFINE (scm_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0, "Return @code{#t} if @var{frame} contains evaluated arguments.") #define FUNC_NAME s_scm_frame_evaluating_args_p { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_BOOL(SCM_FRAME_EVAL_ARGS_P (frame)); } #undef FUNC_NAME @@ -762,7 +762,7 @@ SCM_DEFINE (scm_frame_overflow_p, "frame-overflow?", 1, 0, 0, "Return @code{#t} if @var{frame} is an overflow frame.") #define FUNC_NAME s_scm_frame_overflow_p { - SCM_VALIDATE_FRAME (1,frame); + SCM_VALIDATE_FRAME (1, frame); return SCM_BOOL(SCM_FRAME_OVERFLOW_P (frame)); } #undef FUNC_NAME diff --git a/libguile/stime.c b/libguile/stime.c index 6b04e7e88..0db4ab26d 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -195,11 +195,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0, rv = times (&t); if (rv == -1) SCM_SYSERROR; - SCM_VELTS (result)[0] = scm_long2num (rv); - SCM_VELTS (result)[1] = scm_long2num (t.tms_utime); - SCM_VELTS (result)[2] = scm_long2num (t.tms_stime); - SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime); - SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime); + SCM_VECTOR_SET (result, 0, scm_long2num (rv)); + SCM_VECTOR_SET (result, 1, scm_long2num (t.tms_utime)); + SCM_VECTOR_SET (result, 2, scm_long2num (t.tms_stime)); + SCM_VECTOR_SET (result ,3, scm_long2num (t.tms_cutime)); + SCM_VECTOR_SET (result, 4, scm_long2num (t.tms_cstime)); return result; } #undef FUNC_NAME @@ -282,17 +282,17 @@ filltime (struct tm *bd_time, int zoff, char *zname) { SCM result = scm_c_make_vector (11, SCM_UNDEFINED); - SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec); - SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min); - SCM_VELTS (result)[2] = SCM_MAKINUM (bd_time->tm_hour); - SCM_VELTS (result)[3] = SCM_MAKINUM (bd_time->tm_mday); - SCM_VELTS (result)[4] = SCM_MAKINUM (bd_time->tm_mon); - SCM_VELTS (result)[5] = SCM_MAKINUM (bd_time->tm_year); - SCM_VELTS (result)[6] = SCM_MAKINUM (bd_time->tm_wday); - SCM_VELTS (result)[7] = SCM_MAKINUM (bd_time->tm_yday); - SCM_VELTS (result)[8] = SCM_MAKINUM (bd_time->tm_isdst); - SCM_VELTS (result)[9] = SCM_MAKINUM (zoff); - SCM_VELTS (result)[10] = zname ? scm_makfrom0str (zname) : SCM_BOOL_F; + SCM_VECTOR_SET (result,0, SCM_MAKINUM (bd_time->tm_sec)); + SCM_VECTOR_SET (result,1, SCM_MAKINUM (bd_time->tm_min)); + SCM_VECTOR_SET (result,2, SCM_MAKINUM (bd_time->tm_hour)); + SCM_VECTOR_SET (result,3, SCM_MAKINUM (bd_time->tm_mday)); + SCM_VECTOR_SET (result,4, SCM_MAKINUM (bd_time->tm_mon)); + SCM_VECTOR_SET (result,5, SCM_MAKINUM (bd_time->tm_year)); + SCM_VECTOR_SET (result,6, SCM_MAKINUM (bd_time->tm_wday)); + SCM_VECTOR_SET (result,7, SCM_MAKINUM (bd_time->tm_yday)); + SCM_VECTOR_SET (result,8, SCM_MAKINUM (bd_time->tm_isdst)); + SCM_VECTOR_SET (result,9, SCM_MAKINUM (zoff)); + SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F); return result; } @@ -439,7 +439,7 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0, static void bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) { - SCM *velts; + SCM const *velts; int i; SCM_ASSERT (SCM_VECTORP (sbd_time) diff --git a/libguile/strings.c b/libguile/strings.c index 4f5b48b18..cbfab7b99 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -271,8 +271,8 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0, #define FUNC_NAME s_scm_string_set_x { SCM_VALIDATE_STRING (1, str); - SCM_VALIDATE_INUM_RANGE (2,k,0,SCM_STRING_LENGTH(str)); - SCM_VALIDATE_CHAR (3,chr); + SCM_VALIDATE_INUM_RANGE (2, k,0, SCM_STRING_LENGTH(str)); + SCM_VALIDATE_CHAR (3, chr); SCM_STRING_UCHARS (str)[SCM_INUM (k)] = SCM_CHAR (chr); return SCM_UNSPECIFIED; } @@ -323,7 +323,7 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, SCM_VALIDATE_REST_ARGUMENT (args); for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) { s = SCM_CAR (l); - SCM_VALIDATE_STRING (SCM_ARGn,s); + SCM_VALIDATE_STRING (SCM_ARGn, s); i += SCM_STRING_LENGTH (s); } res = scm_allocate_string (i); diff --git a/libguile/strop.c b/libguile/strop.c index bf2ede036..f42046ba1 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -190,17 +190,17 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0, { long s1, s2, e, len; - SCM_VALIDATE_STRING (1,str1); - SCM_VALIDATE_INUM_COPY (2,start1,s1); - SCM_VALIDATE_INUM_COPY (3,end1,e); - SCM_VALIDATE_STRING (4,str2); - SCM_VALIDATE_INUM_COPY (5,start2,s2); + SCM_VALIDATE_STRING (1, str1); + SCM_VALIDATE_INUM_COPY (2, start1, s1); + SCM_VALIDATE_INUM_COPY (3, end1, e); + SCM_VALIDATE_STRING (4, str2); + SCM_VALIDATE_INUM_COPY (5, start2, s2); len = e - s1; - SCM_ASSERT_RANGE (3,end1,len >= 0); - SCM_ASSERT_RANGE (2,start1,s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0); - SCM_ASSERT_RANGE (5,start2,s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0); - SCM_ASSERT_RANGE (3,end1,e <= SCM_STRING_LENGTH (str1) && e >= 0); - SCM_ASSERT_RANGE (5,start2,len+s2 <= SCM_STRING_LENGTH (str2)); + SCM_ASSERT_RANGE (3, end1, len >= 0); + SCM_ASSERT_RANGE (2, start1, s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0); + SCM_ASSERT_RANGE (5, start2, s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0); + SCM_ASSERT_RANGE (3, end1, e <= SCM_STRING_LENGTH (str1) && e >= 0); + SCM_ASSERT_RANGE (5, start2, len+s2 <= SCM_STRING_LENGTH (str2)); SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])), (void *)(&(SCM_STRING_CHARS(str1)[s1])), @@ -226,12 +226,12 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0, { long i, e; char c; - SCM_VALIDATE_STRING (1,str); - SCM_VALIDATE_INUM_COPY (2,start,i); - SCM_VALIDATE_INUM_COPY (3,end,e); - SCM_VALIDATE_CHAR_COPY (4,fill,c); - SCM_ASSERT_RANGE (2,start,i <= SCM_STRING_LENGTH (str) && i >= 0); - SCM_ASSERT_RANGE (3,end,e <= SCM_STRING_LENGTH (str) && e >= 0); + SCM_VALIDATE_STRING (1, str); + SCM_VALIDATE_INUM_COPY (2, start, i); + SCM_VALIDATE_INUM_COPY (3, end, e); + SCM_VALIDATE_CHAR_COPY (4, fill, c); + SCM_ASSERT_RANGE (2, start, i <= SCM_STRING_LENGTH (str) && i >= 0); + SCM_ASSERT_RANGE (3, end, e <= SCM_STRING_LENGTH (str) && e >= 0); while (ilist", 1, 0, 0, long i; SCM res = SCM_EOL; unsigned char *src; - SCM_VALIDATE_STRING (1,str); + SCM_VALIDATE_STRING (1, str); src = SCM_STRING_UCHARS (str); for (i = SCM_STRING_LENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res); return res; @@ -307,8 +307,8 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0, { register char *dst, c; register long k; - SCM_VALIDATE_STRING_COPY (1,str,dst); - SCM_VALIDATE_CHAR_COPY (2,chr,c); + SCM_VALIDATE_STRING_COPY (1, str, dst); + SCM_VALIDATE_CHAR_COPY (2, chr, c); for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c; return SCM_UNSPECIFIED; } diff --git a/libguile/struct.c b/libguile/struct.c index c92beabb9..e8585896e 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -440,8 +440,8 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, scm_t_bits * data; SCM handle; - SCM_VALIDATE_VTABLE (1,vtable); - SCM_VALIDATE_INUM (2,tail_array_size); + SCM_VALIDATE_VTABLE (1, vtable); + SCM_VALIDATE_INUM (2, tail_array_size); SCM_VALIDATE_REST_ARGUMENT (init); layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]); @@ -569,8 +569,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, char field_type = 0; - SCM_VALIDATE_STRUCT (1,handle); - SCM_VALIDATE_INUM (2,pos); + SCM_VALIDATE_STRUCT (1, handle); + SCM_VALIDATE_INUM (2, pos); layout = SCM_STRUCT_LAYOUT (handle); data = SCM_STRUCT_DATA (handle); @@ -579,7 +579,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, fields_desc = SCM_SYMBOL_CHARS (layout); n_fields = data[scm_struct_i_n_words]; - SCM_ASSERT_RANGE(1,pos, p < n_fields); + SCM_ASSERT_RANGE(1, pos, p < n_fields); if (p * 2 < SCM_SYMBOL_LENGTH (layout)) { @@ -645,8 +645,8 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, char * fields_desc; char field_type = 0; - SCM_VALIDATE_STRUCT (1,handle); - SCM_VALIDATE_INUM (2,pos); + SCM_VALIDATE_STRUCT (1, handle); + SCM_VALIDATE_INUM (2, pos); layout = SCM_STRUCT_LAYOUT (handle); data = SCM_STRUCT_DATA (handle); @@ -655,7 +655,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, fields_desc = SCM_SYMBOL_CHARS (layout); n_fields = data[scm_struct_i_n_words]; - SCM_ASSERT_RANGE (1,pos, p < n_fields); + SCM_ASSERT_RANGE (1, pos, p < n_fields); if (p * 2 < SCM_SYMBOL_LENGTH (layout)) { @@ -708,7 +708,7 @@ SCM_DEFINE (scm_struct_vtable, "struct-vtable", 1, 0, 0, "Return the vtable structure that describes the type of @var{struct}.") #define FUNC_NAME s_scm_struct_vtable { - SCM_VALIDATE_STRUCT (1,handle); + SCM_VALIDATE_STRUCT (1, handle); return SCM_STRUCT_VTABLE (handle); } #undef FUNC_NAME @@ -719,7 +719,7 @@ SCM_DEFINE (scm_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0, "Return the vtable tag of the structure @var{handle}.") #define FUNC_NAME s_scm_struct_vtable_tag { - SCM_VALIDATE_VTABLE (1,handle); + SCM_VALIDATE_VTABLE (1, handle); return scm_long2num ((long) SCM_STRUCT_DATA (handle) >> 3); } #undef FUNC_NAME @@ -758,7 +758,7 @@ SCM_DEFINE (scm_struct_vtable_name, "struct-vtable-name", 1, 0, 0, "Return the name of the vtable @var{vtable}.") #define FUNC_NAME s_scm_struct_vtable_name { - SCM_VALIDATE_VTABLE (1,vtable); + SCM_VALIDATE_VTABLE (1, vtable); return SCM_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable))); } #undef FUNC_NAME @@ -768,8 +768,8 @@ SCM_DEFINE (scm_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0, "Set the name of the vtable @var{vtable} to @var{name}.") #define FUNC_NAME s_scm_set_struct_vtable_name_x { - SCM_VALIDATE_VTABLE (1,vtable); - SCM_VALIDATE_SYMBOL (2,name); + SCM_VALIDATE_VTABLE (1, vtable); + SCM_VALIDATE_SYMBOL (2, name); SCM_SET_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)), name); return SCM_UNSPECIFIED; diff --git a/libguile/symbols.c b/libguile/symbols.c index 780575228..73635dea4 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -133,7 +133,7 @@ scm_mem2symbol (const char *name, size_t len) slot = SCM_VELTS (symbols) [hash]; cell = scm_cons (symbol, SCM_UNDEFINED); - SCM_VELTS (symbols) [hash] = scm_cons (cell, slot); + SCM_VECTOR_SET (symbols, hash, scm_cons (cell, slot)); return symbol; } @@ -319,7 +319,7 @@ SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, "Return the contents of @var{symbol}'s @dfn{function slot}.") #define FUNC_NAME s_scm_symbol_fref { - SCM_VALIDATE_SYMBOL (1,s); + SCM_VALIDATE_SYMBOL (1, s); return SCM_SYMBOL_FUNC (s); } #undef FUNC_NAME @@ -330,7 +330,7 @@ SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, "Return the @dfn{property list} currently associated with @var{symbol}.") #define FUNC_NAME s_scm_symbol_pref { - SCM_VALIDATE_SYMBOL (1,s); + SCM_VALIDATE_SYMBOL (1, s); return SCM_SYMBOL_PROPS (s); } #undef FUNC_NAME @@ -341,7 +341,7 @@ SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, "Change the binding of @var{symbol}'s function slot.") #define FUNC_NAME s_scm_symbol_fset_x { - SCM_VALIDATE_SYMBOL (1,s); + SCM_VALIDATE_SYMBOL (1, s); SCM_SET_SYMBOL_FUNC (s, val); return SCM_UNSPECIFIED; } @@ -353,7 +353,7 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, "Change the binding of @var{symbol}'s property slot.") #define FUNC_NAME s_scm_symbol_pset_x { - SCM_VALIDATE_SYMBOL (1,s); + SCM_VALIDATE_SYMBOL (1, s); SCM_DEFER_INTS; SCM_SET_SYMBOL_PROPS (s, val); SCM_ALLOW_INTS; diff --git a/libguile/tags.h b/libguile/tags.h index 37d4a0f60..26d4e890e 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -315,7 +315,7 @@ typedef signed long scm_t_signed_bits; #define SCM_TYP16(x) (0xffff & SCM_CELL_TYPE (x)) #define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x)) -#define SCM_TYP16_PREDICATE(tag,x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag)) +#define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag)) diff --git a/libguile/throw.c b/libguile/throw.c index 68c18726e..ce0a403c2 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -76,10 +76,10 @@ static scm_t_bits tc16_jmpbuffer; (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L)))) #define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ)) -#define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) +#define SETJBJMPBUF(x, v) (SCM_SET_CELL_WORD_1 ((x), (v))) #ifdef DEBUG_EXTENSIONS #define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x)) -#define SCM_SETJBDFRAME(x,v) (SCM_SET_CELL_WORD_2 ((x), (v))) +#define SCM_SETJBDFRAME(x, v) (SCM_SET_CELL_WORD_2 ((x), (v))) #endif static int @@ -595,7 +595,7 @@ SCM_DEFINE (scm_throw, "throw", 1, 0, 1, "If there is no handler at all, Guile prints an error and then exits.") #define FUNC_NAME s_scm_throw { - SCM_VALIDATE_SYMBOL (1,key); + SCM_VALIDATE_SYMBOL (1, key); return scm_ithrow (key, args, 1); } #undef FUNC_NAME diff --git a/libguile/unif.c b/libguile/unif.c index 761fbc101..dedd1e559 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -678,8 +678,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, scm_t_array_dim *s; SCM_VALIDATE_REST_ARGUMENT (dims); - SCM_VALIDATE_ARRAY (1,oldra); - SCM_VALIDATE_PROC (2,mapfunc); + SCM_VALIDATE_ARRAY (1, oldra); + SCM_VALIDATE_PROC (2, mapfunc); ra = scm_shap2ra (dims, FUNC_NAME); if (SCM_ARRAYP (oldra)) { @@ -802,7 +802,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, "@end lisp") #define FUNC_NAME s_scm_transpose_array { - SCM res, vargs, *ve = &vargs; + SCM res, vargs; + SCM const *ve = &vargs; scm_t_array_dim *s, *r; int ndim, i, k; @@ -1104,7 +1105,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, } else { - SCM_VALIDATE_INUM (2,args); + SCM_VALIDATE_INUM (2, args); pos = SCM_INUM (args); } length = SCM_INUM (scm_uniform_vector_length (v)); @@ -1184,7 +1185,7 @@ scm_cvref (SCM v, unsigned long pos, SCM last) default: SCM_WRONG_TYPE_ARG (SCM_ARG1, v); case scm_tc7_bvect: - if (SCM_BITVEC_REF(v,pos)) + if (SCM_BITVEC_REF(v, pos)) return SCM_BOOL_T; else return SCM_BOOL_F; @@ -1278,7 +1279,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, } else { - SCM_VALIDATE_INUM_COPY (3,args,pos); + SCM_VALIDATE_INUM_COPY (3, args, pos); } length = SCM_INUM (scm_uniform_vector_length (v)); SCM_ASRTGO (pos >= 0 && pos < length, outrng); @@ -1296,9 +1297,9 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, goto badarg1; case scm_tc7_bvect: if (SCM_FALSEP (obj)) - SCM_BITVEC_CLR(v,pos); + SCM_BITVEC_CLR(v, pos); else if (SCM_EQ_P (obj, SCM_BOOL_T)) - SCM_BITVEC_SET(v,pos); + SCM_BITVEC_SET(v, pos); else badobj:SCM_WRONG_TYPE_ARG (2, obj); break; @@ -1350,7 +1351,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, break; case scm_tc7_vector: case scm_tc7_wvect: - SCM_VELTS (v)[pos] = obj; + SCM_VECTOR_SET (v, pos, obj); break; } return SCM_UNSPECIFIED; @@ -1824,7 +1825,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, SCM_VALIDATE_BOOL (1, item); SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME); - SCM_VALIDATE_INUM_COPY (3,k,pos); + SCM_VALIDATE_INUM_COPY (3, k, pos); SCM_ASSERT_RANGE (3, k, (pos <= SCM_BITVECTOR_LENGTH (v)) && (pos >= 0)); if (pos == SCM_BITVECTOR_LENGTH (v)) @@ -1902,7 +1903,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); - SCM_BITVEC_CLR(v,k); + SCM_BITVEC_CLR(v, k); } else if (SCM_EQ_P (obj, SCM_BOOL_T)) for (i = SCM_UVECTOR_LENGTH (kv); i;) @@ -1910,7 +1911,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); - SCM_BITVEC_SET(v,k); + SCM_BITVEC_SET(v, k); } else badarg3:SCM_WRONG_TYPE_ARG (3, obj); @@ -1960,7 +1961,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); - if (!SCM_BITVEC_REF(v,k)) + if (!SCM_BITVEC_REF(v, k)) count++; } else if (SCM_EQ_P (obj, SCM_BOOL_T)) @@ -1969,7 +1970,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); - if (SCM_BITVEC_REF (v,k)) + if (SCM_BITVEC_REF (v, k)) count++; } else @@ -2050,7 +2051,7 @@ scm_istr2bve (char *str, long len) static SCM -ra2l (SCM ra,unsigned long base,unsigned long k) +ra2l (SCM ra, unsigned long base, unsigned long k) { register SCM res = SCM_EOL; register long inc = SCM_ARRAY_DIMS (ra)[k].inc; @@ -2190,7 +2191,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, SCM ra; unsigned long k; long n; - SCM_VALIDATE_INUM_COPY (1,ndim,k); + SCM_VALIDATE_INUM_COPY (1, ndim, k); while (k--) { n = scm_ilength (row); @@ -2261,7 +2262,7 @@ l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k) static void -rapr1 (SCM ra,unsigned long j,unsigned long k,SCM port,scm_print_state *pstate) +rapr1 (SCM ra, unsigned long j, unsigned long k, SCM port, scm_print_state *pstate) { long inc = 1; long n = (SCM_TYP7 (ra) == scm_tc7_smob diff --git a/libguile/unif.h b/libguile/unif.h index e467033df..028446eff 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -96,8 +96,8 @@ SCM_API scm_t_bits scm_tc16_array; #define SCM_SET_UVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_UVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH #define SCM_UVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) -#define SCM_MAKE_UVECTOR_TAG(l,t) (((l) << 8) + (t)) -#define SCM_SET_UVECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_UVECTOR_TAG(l,t))) +#define SCM_MAKE_UVECTOR_TAG(l, t) (((l) << 8) + (t)) +#define SCM_SET_UVECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_UVECTOR_TAG(l, t))) #define SCM_BITVECTOR_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect)) #define SCM_BITVECTOR_BASE(x) ((unsigned long *) (SCM_CELL_WORD_1 (x))) diff --git a/libguile/validate.h b/libguile/validate.h index 9068b8278..2a2c83b52 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -306,10 +306,10 @@ } \ } while (0) -/* [low,high) */ -#define SCM_VALIDATE_INUM_RANGE(pos,k,low,high) \ +/* [low, high) */ +#define SCM_VALIDATE_INUM_RANGE(pos, k, low, high) \ do { SCM_ASSERT(SCM_INUMP(k), k, pos, FUNC_NAME); \ - SCM_ASSERT_RANGE(pos,k, \ + SCM_ASSERT_RANGE(pos, k, \ (SCM_INUM (k) >= low && \ SCM_INUM (k) < high)); \ } while (0) @@ -367,7 +367,7 @@ SCM_ASSERT (scm_valid_oport_value_p (port), port, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_PRINTSTATE(pos, a) SCM_MAKE_VALIDATE(pos,a,PRINT_STATE_P) +#define SCM_VALIDATE_PRINTSTATE(pos, a) SCM_MAKE_VALIDATE(pos, a, PRINT_STATE_P) #define SCM_VALIDATE_SMOB(pos, obj, type) \ do { \ @@ -421,7 +421,7 @@ #define SCM_VALIDATE_OPINPORT(pos, port) \ SCM_MAKE_VALIDATE (pos, port, OPINPORTP) -#define SCM_VALIDATE_OPENPORT(pos,port) \ +#define SCM_VALIDATE_OPENPORT(pos, port) \ do { \ SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \ port, pos, FUNC_NAME); \ @@ -445,7 +445,7 @@ #define SCM_VALIDATE_RSTATE(pos, v) SCM_MAKE_VALIDATE (pos, v, RSTATEP) -#define SCM_VALIDATE_ARRAY(pos,v) \ +#define SCM_VALIDATE_ARRAY(pos, v) \ do { \ SCM_ASSERT (!SCM_IMP (v) \ && !SCM_FALSEP (scm_array_p (v, SCM_UNDEFINED)), \ diff --git a/libguile/variable.h b/libguile/variable.h index 5be7d067d..7d0350938 100644 --- a/libguile/variable.h +++ b/libguile/variable.h @@ -55,7 +55,7 @@ */ #define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_TYP7(X) == scm_tc7_variable) #define SCM_VARIABLE_REF(V) SCM_CELL_OBJECT_1 (V) -#define SCM_VARIABLE_SET(V,X) SCM_SET_CELL_OBJECT_1 (V, X) +#define SCM_VARIABLE_SET(V, X) SCM_SET_CELL_OBJECT_1 (V, X) #define SCM_VARIABLE_LOC(V) ((SCM *) SCM_CELL_WORD_LOC ((V), 1)) diff --git a/libguile/vectors.c b/libguile/vectors.c index 7a6e64a17..86dc0b121 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -101,7 +101,11 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1, while the vector is being created. */ SCM_VALIDATE_LIST_COPYLEN (1, l, i); res = scm_c_make_vector (i, SCM_UNSPECIFIED); - data = SCM_VELTS (res); + + /* + this code doesn't alloc. -- accessing RES is safe. + */ + data = SCM_WRITABLE_VELTS (res); while (!SCM_NULL_OR_NIL_P (l)) { *data++ = SCM_CAR (l); @@ -165,7 +169,7 @@ scm_vector_set_x (SCM v, SCM k, SCM obj) g_vector_set_x, scm_list_3 (v, k, obj), SCM_ARG2, s_vector_set_x); SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); - SCM_VELTS(v)[(long) SCM_INUM(k)] = obj; + SCM_VECTOR_SET (v, (long) SCM_INUM(k), obj); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -235,8 +239,8 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, { SCM res = SCM_EOL; long i; - SCM *data; - SCM_VALIDATE_VECTOR (1,v); + SCM const *data; + SCM_VALIDATE_VECTOR (1, v); data = SCM_VELTS(v); for(i = SCM_VECTOR_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res); return res; @@ -251,11 +255,10 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0, #define FUNC_NAME s_scm_vector_fill_x { register long i; - register SCM *data; SCM_VALIDATE_VECTOR (1, v); - data = SCM_VELTS (v); + for(i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--) - data[i] = fill; + SCM_VECTOR_SET(v, i, fill); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -287,16 +290,19 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0, long j; long e; - SCM_VALIDATE_VECTOR (1,vec1); - SCM_VALIDATE_INUM_COPY (2,start1,i); - SCM_VALIDATE_INUM_COPY (3,end1,e); - SCM_VALIDATE_VECTOR (4,vec2); - SCM_VALIDATE_INUM_COPY (5,start2,j); + SCM_VALIDATE_VECTOR (1, vec1); + SCM_VALIDATE_INUM_COPY (2, start1, i); + SCM_VALIDATE_INUM_COPY (3, end1, e); + SCM_VALIDATE_VECTOR (4, vec2); + SCM_VALIDATE_INUM_COPY (5, start2, j); SCM_ASSERT_RANGE (2, start1, i <= SCM_VECTOR_LENGTH (vec1) && i >= 0); SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0); SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0); SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2)); - while (i= 0); SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0); SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0); j = e - i + j; SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2)); while (i < e) - SCM_VELTS (vec2)[--j] = SCM_VELTS (vec1)[--e]; + SCM_VECTOR_SET (vec2, --j, SCM_VELTS (vec1)[--e]); return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/vectors.h b/libguile/vectors.h index 4d37b37a2..dda0c7612 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -55,13 +55,20 @@ #define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1) #define SCM_VECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) -#define SCM_MAKE_VECTOR_TAG(l,t) (((l) << 8) + (t)) -#define SCM_SET_VECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_VECTOR_TAG(l,t))) +#define SCM_MAKE_VECTOR_TAG(l, t) (((l) << 8) + (t)) +#define SCM_SET_VECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_VECTOR_TAG(l, t))) -#define SCM_VELTS(x) ((SCM *) SCM_CELL_WORD_1 (x)) +#define SCM_VELTS(x) ((const SCM *) SCM_CELL_WORD_1 (x)) #define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_CELL_WORD_1 (x)) -#define SCM_SETVELTS(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) +#define SCM_SETVELTS(x, v) (SCM_SET_CELL_WORD_1 ((x), (v))) +#define SCM_VECTOR_SET(x, idx, val) (((SCM*)SCM_CELL_WORD_1 (x))[(idx)] = (val)) +#define SCM_GC_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x)) + +/* + no WB yet. + */ +#define SCM_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x)) /* diff --git a/libguile/vports.c b/libguile/vports.c index 69855331e..ce5ea7925 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -187,7 +187,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, { scm_t_port *pt; SCM z; - SCM_VALIDATE_VECTOR_LEN (1,pv,5); + SCM_VALIDATE_VECTOR_LEN (1, pv,5); SCM_VALIDATE_STRING (2, modes); z = scm_cell (scm_tc16_sfport, 0); SCM_DEFER_INTS; diff --git a/libguile/weaks.c b/libguile/weaks.c index 535b4482e..90b573185 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -141,8 +141,11 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, i = scm_ilength (l); SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME); res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED); - data = SCM_VELTS (res); + /* + no alloc, so this loop is safe. + */ + data = SCM_WRITABLE_VELTS (res); while (!SCM_NULL_OR_NIL_P (l)) { *data++ = SCM_CAR (l); @@ -261,7 +264,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED, { if (SCM_IS_WHVEC_ANY (w)) { - SCM *ptr; + SCM const *ptr; SCM obj; long j; long n; @@ -302,7 +305,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, { register long j, n; - ptr = SCM_VELTS (w); + ptr = SCM_GC_WRITABLE_VELTS (w); n = SCM_VECTOR_LENGTH (w); for (j = 0; j < n; ++j) if (SCM_FREE_CELL_P (ptr[j])) @@ -316,7 +319,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED, int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj); int weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj); - ptr = SCM_VELTS (w); + ptr = SCM_GC_WRITABLE_VELTS (w); for (j = 0; j < n; ++j) { From bde9d30b514ffffea48f68d303abd3e6fb159a90 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sun, 21 Jul 2002 10:22:54 +0000 Subject: [PATCH 069/306] * benchmarks/0-reference.bm: Added as a reference benchmark to be used to calibrate iteration counts. * lib.scm: Added documentation. Added some initialization messages. (benchmark-time-base, benchmark-total-time, benchmark-user-time, benchmark-system-time, benchmark-frame-time, benchmark-core-time, benchmark-user-time\interpreter, benchmark-core-time\interpreter): Exported. (benchmark-time-base, time-base): Renamed time-base to benchmark-time-base and introduced new time-base as a short-cut. (total-time, benchmark-total-time, user-time, benchmark-user-time, system-time, benchmark-system-time, frame-time, benchmark-frame-time, benchmark-time, benchmark-core-time, user-time\interpreter, benchmark-user-time\interpreter, benchmark-time\interpreter, benchmark-core-time\interpreter, print-result, print-user-result): Renamed -time to benchmark--time. Exceptions: benchmark-time and benchmark-time\interpreter were renamed to benchmark-core-time and benchmark-core-time\interpreter, respectively. --- benchmark-suite/ChangeLog | 26 ++ benchmark-suite/benchmarks/0-reference.bm | 2 + benchmark-suite/lib.scm | 305 ++++++++++++++++++++-- 3 files changed, 307 insertions(+), 26 deletions(-) create mode 100644 benchmark-suite/benchmarks/0-reference.bm diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog index 0f9f90638..1ed5c3421 100644 --- a/benchmark-suite/ChangeLog +++ b/benchmark-suite/ChangeLog @@ -1,3 +1,29 @@ +2002-07-21 Dirk Herrmann + + * benchmarks/0-reference.bm: Added as a reference benchmark to be + used to calibrate iteration counts. + + * lib.scm: Added documentation. Added some initialization + messages. + + (benchmark-time-base, benchmark-total-time, benchmark-user-time, + benchmark-system-time, benchmark-frame-time, benchmark-core-time, + benchmark-user-time\interpreter, benchmark-core-time\interpreter): + Exported. + + (benchmark-time-base, time-base): Renamed time-base to + benchmark-time-base and introduced new time-base as a short-cut. + + (total-time, benchmark-total-time, user-time, benchmark-user-time, + system-time, benchmark-system-time, frame-time, + benchmark-frame-time, benchmark-time, benchmark-core-time, + user-time\interpreter, benchmark-user-time\interpreter, + benchmark-time\interpreter, benchmark-core-time\interpreter, + print-result, print-user-result): Renamed -time to + benchmark--time. Exceptions: benchmark-time and + benchmark-time\interpreter were renamed to benchmark-core-time and + benchmark-core-time\interpreter, respectively. + 2002-07-20 Dirk Herrmann * COPYING, README, Makefile.am, lib.scm, guile-benchmark: Copied diff --git a/benchmark-suite/benchmarks/0-reference.bm b/benchmark-suite/benchmarks/0-reference.bm new file mode 100644 index 000000000..65085a8d7 --- /dev/null +++ b/benchmark-suite/benchmarks/0-reference.bm @@ -0,0 +1,2 @@ +(benchmark "reference benchmark for iteration counts" 330000 + #t) diff --git a/benchmark-suite/lib.scm b/benchmark-suite/lib.scm index 2eb858228..1f940a251 100644 --- a/benchmark-suite/lib.scm +++ b/benchmark-suite/lib.scm @@ -31,12 +31,258 @@ with-benchmark-prefix with-benchmark-prefix* current-benchmark-prefix format-benchmark-name + ;; Computing timing results + benchmark-time-base + benchmark-total-time benchmark-user-time benchmark-system-time + benchmark-frame-time benchmark-core-time + benchmark-user-time\interpreter benchmark-core-time\interpreter + ;; Reporting results in various ways. register-reporter unregister-reporter reporter-registered? make-log-reporter full-reporter user-reporter)) + +;;;; If you're using Emacs's Scheme mode: +;;;; (put 'with-benchmark-prefix 'scheme-indent-function 1) +;;;; (put 'benchmark 'scheme-indent-function 1) + + +;;;; CORE FUNCTIONS +;;;; +;;;; The function (run-benchmark name iterations thunk) is the heart of the +;;;; benchmarking environment. The first parameter NAME is a unique name for +;;;; the benchmark to be executed (for an explanation of this parameter see +;;;; below under ;;;; NAMES. The second parameter ITERATIONS is a positive +;;;; integer value that indicates how often the thunk shall be executed (for +;;;; an explanation of how iteration counts should be used, see below under +;;;; ;;;; ITERATION COUNTS). For example: +;;;; +;;;; (run-benchmark "small integer addition" 100000 (lambda () (+ 1 1))) +;;;; +;;;; This will run the function (lambda () (+ 1 1)) a 100000 times (the +;;;; iteration count can, however be scaled. See below for details). Some +;;;; different time data for running the thunk for the given number of +;;;; iterations is measured and reported. +;;;; +;;;; Convenience macro +;;;; +;;;; * (benchmark name iterations body) is a short form for +;;;; (run-benchmark name iterations (lambda () body)) + + +;;;; NAMES +;;;; +;;;; Every benchmark in the benchmark suite has a unique name to be able to +;;;; compare the results of individual benchmarks across several runs of the +;;;; benchmark suite. +;;;; +;;;; A benchmark name is a list of printable objects. For example: +;;;; ("ports.scm" "file" "read and write back list of strings") +;;;; ("ports.scm" "pipe" "read") +;;;; +;;;; Benchmark names may contain arbitrary objects, but they always have +;;;; the following properties: +;;;; - Benchmark names can be compared with EQUAL?. +;;;; - Benchmark names can be reliably stored and retrieved with the standard +;;;; WRITE and READ procedures; doing so preserves their identity. +;;;; +;;;; For example: +;;;; +;;;; (benchmark "simple addition" 100000 (+ 2 2)) +;;;; +;;;; In that case, the benchmark name is the list ("simple addition"). +;;;; +;;;; The WITH-BENCHMARK-PREFIX syntax and WITH-BENCHMARK-PREFIX* procedure +;;;; establish a prefix for the names of all benchmarks whose results are +;;;; reported within their dynamic scope. For example: +;;;; +;;;; (begin +;;;; (with-benchmark-prefix "basic arithmetic" +;;;; (benchmark "addition" 100000 (+ 2 2)) +;;;; (benchmark "subtraction" 100000 (- 4 2))) +;;;; (benchmark "multiplication" 100000 (* 2 2)))) +;;;; +;;;; In that example, the three benchmark names are: +;;;; ("basic arithmetic" "addition"), +;;;; ("basic arithmetic" "subtraction"), and +;;;; ("multiplication"). +;;;; +;;;; WITH-BENCHMARK-PREFIX can be nested. Each WITH-BENCHMARK-PREFIX +;;;; postpends a new element to the current prefix: +;;;; +;;;; (with-benchmark-prefix "arithmetic" +;;;; (with-benchmark-prefix "addition" +;;;; (benchmark "integer" 100000 (+ 2 2)) +;;;; (benchmark "complex" 100000 (+ 2+3i 4+5i))) +;;;; (with-benchmark-prefix "subtraction" +;;;; (benchmark "integer" 100000 (- 2 2)) +;;;; (benchmark "complex" 100000 (- 2+3i 1+2i)))) +;;;; +;;;; The four benchmark names here are: +;;;; ("arithmetic" "addition" "integer") +;;;; ("arithmetic" "addition" "complex") +;;;; ("arithmetic" "subtraction" "integer") +;;;; ("arithmetic" "subtraction" "complex") +;;;; +;;;; To print a name for a human reader, we DISPLAY its elements, +;;;; separated by ": ". So, the last set of benchmark names would be +;;;; reported as: +;;;; +;;;; arithmetic: addition: integer +;;;; arithmetic: addition: complex +;;;; arithmetic: subtraction: integer +;;;; arithmetic: subtraction: complex +;;;; +;;;; The Guile benchmarks use with-benchmark-prefix to include the name of +;;;; the source file containing the benchmark in the benchmark name, to +;;;; provide each file with its own namespace. + + +;;;; ITERATION COUNTS +;;;; +;;;; Every benchmark has to be given an iteration count that indicates how +;;;; often it should be executed. The reason is, that in most cases a single +;;;; execution of the benchmark code would not deliver usable timing results: +;;;; The resolution of the system time is not arbitrarily fine. Thus, some +;;;; benchmarks would be executed too quickly to be measured at all. A rule +;;;; of thumb is, that the longer a benchmark runs, be more exact is the +;;;; information about the execution time. +;;;; +;;;; However, execution time depends on several influences: First, the +;;;; machine you are running the benchmark on. Second, the compiler you use. +;;;; Third, which compiler options you use. Fourth, which version of guile +;;;; you are using. Fifth, which guile options you are using (for example if +;;;; you are using the debugging evaluator or not). There are even more +;;;; influences. +;;;; +;;;; For this reason, the same number of iterations for a single benchmark may +;;;; lead to completely different execution times in different +;;;; constellations. For someone working on a slow machine, the default +;;;; execution counts may lead to an inacceptable execution time of the +;;;; benchmark suite. For someone on a very fast machine, however, it may be +;;;; desireable to increase the number of iterations in order to increase the +;;;; accuracy of the time data. +;;;; +;;;; For this reason, the benchmark suite allows to scale the number of +;;;; executions by a global factor, stored in the exported variable +;;;; iteration-factor. The default for iteration-factor is 1. A number of 2 +;;;; means, that all benchmarks are executed twice as often, which will also +;;;; roughly double the execution time for the benchmark suite. Similarly, if +;;;; iteration-factor holds a value of 0.5, only about half the execution time +;;;; will be required. +;;;; +;;;; It is probably a good idea to choose the iteration count for each +;;;; benchmark such that all benchmarks will take about the same time, for +;;;; example one second. To achieve this, the benchmark suite holds an empty +;;;; benchmark in the file 0-reference.bm named "reference benchmark for +;;;; iteration counts". It's iteration count is calibrated to make the +;;;; benchmark run about one second on Dirk's laptop :-) If you are adding +;;;; benchmarks to the suite, it would be nice if you could calibrate the +;;;; number of iterations such that each of your added benchmarks takes about +;;;; as long to run as the reference benchmark. But: Don't be too accurate +;;;; to figure out the correct iteration count. + + +;;;; REPORTERS +;;;; +;;;; A reporter is a function which we apply to each benchmark outcome. +;;;; Reporters can log results, print interesting results to the standard +;;;; output, collect statistics, etc. +;;;; +;;;; A reporter function takes the following arguments: NAME ITERATIONS +;;;; BEFORE AFTER GC-TIME. The argument NAME holds the name of the benchmark, +;;;; ITERATIONS holds the actual number of iterations that were performed. +;;;; BEFORE holds the result of the function (times) at the very beginning of +;;;; the excution of the benchmark, AFTER holds the result of the function +;;;; (times) after the execution of the benchmark. GC-TIME, finally, holds +;;;; the difference of calls to (gc-run-time) before and after the execution +;;;; of the benchmark. +;;;; +;;;; This library provides some standard reporters for logging results +;;;; to a file, reporting interesting results to the user, (FIXME: and +;;;; collecting totals). +;;;; +;;;; You can use the REGISTER-REPORTER function and friends to add whatever +;;;; reporting functions you like. See under ;;;; TIMING DATA to see how the +;;;; library helps you to extract relevant timing information from the values +;;;; ITERATIONS, BEFORE, AFTER and GC-TIME. If you don't register any +;;;; reporters, the library uses USER-REPORTER, which writes the most +;;;; interesting results to the standard output. + + +;;;; TIME CALCULATION +;;;; +;;;; The library uses the guile functions (times) and (gc-run-time) to +;;;; determine the execution time for a single benchmark. Based on these +;;;; functions, the values of BEFORE, AFTER and GC-TIME are computed, which +;;;; are then passed to the reporter functions. All three values BEFORE, +;;;; AFTER and GC-TIME include the time needed to executed the benchmark code +;;;; itself, but also the surrounding code that implements the loop to run the +;;;; benchmark code for the given number of times. This is undesirable, since +;;;; one would prefer to only get the timing data for the benchmarking code. +;;;; +;;;; To cope with this, the benchmarking framework uses a trick: During +;;;; initialization of the library, the time for executing an empty benchmark +;;;; is measured and stored. This is an estimate for the time needed by the +;;;; benchmarking framework itself. For later benchmarks, this time can then +;;;; be subtracted from the measured execution times. +;;;; +;;;; In order to simplify the time calculation for users who want to write +;;;; their own reporters, benchmarking framework provides the following +;;;; definitions: +;;;; +;;;; benchmark-time-base : This variable holds the number of time units that +;;;; make up a second. By deviding the results of each of the functions +;;;; below by this value, you get the corresponding time in seconds. For +;;;; example (/ (benchmark-total-time before after) benchmark-time-base) +;;;; will give you the total time in seconds. +;;;; benchmark-total-time : this function takes two arguments BEFORE and AFTER +;;;; and computes the total time between the two timestamps. The result +;;;; of this function is what the time command of the unix command line +;;;; would report as real time. +;;;; benchmark-user-time : this function takes two arguments BEFORE and AFTER +;;;; and computes the time spent in the benchmarking process between the +;;;; two timestamps. That means, the time consumed by other processes +;;;; running on the same machine is not part of the resulting time, +;;;; neither is time spent within the operating system. The result of +;;;; this function is what the time command of the unix command line would +;;;; report as user time. +;;;; benchmark-system-time : similar to benchmark-user-time, but here the time +;;;; spent within the operating system is given. The result of this +;;;; function is what the time command of the unix command line would +;;;; report as system time. +;;;; benchmark-frame-time : this function takes the argument ITERATIONS. It +;;;; reports the part of the user time that is consumed by the +;;;; benchmarking framework itself to run some benchmark for the giben +;;;; number of iterations. You can think of this as the time that would +;;;; still be consumed, even if the benchmarking code itself was empty. +;;;; This value does not include any time for garbage collection, even if +;;;; it is the benchmarking framework which is responsible for causing a +;;;; garbage collection. +;;;; benchmark-core-time : this function takes three arguments ITERATIONS, +;;;; BEFORE and AFTER. It reports the part of the user time that is +;;;; actually spent within the benchmarking code. That is, the time +;;;; needed for the benchmarking framework is subtracted from the user +;;;; time. This value, however, includes all garbage collection times, +;;;; even if some part of the gc-time had actually to be attributed to the +;;;; benchmarking framework. +;;;; benchmark-user-time\interpreter : this function takes three arguments +;;;; BEFORE AFTER and GC-TIME. It reports the part of the user time that +;;;; is spent in the interpreter (and not in garbage collection). +;;;; benchmark-core-time\interpreter : this function takes four arguments +;;;; ITERATIONS, BEFORE, AFTER. and GC-TIME. It reports the part of the +;;;; benchmark-core-time that is spent in the interpreter (and not in +;;;; garbage collection). This value is most probably the one you are +;;;; interested in, except if you are doing some garbage collection +;;;; checks. +;;;; +;;;; There is not function to calculate the garbage-collection time, since the +;;;; garbage collection time is already passed as an argument GC-TIME to the +;;;; reporter functions. + + ;;;; MISCELLANEOUS ;;;; @@ -122,32 +368,35 @@ ;;;; TIME CALCULATION ;;;; -(define time-base +(define benchmark-time-base internal-time-units-per-second) +(define time-base ;; short-cut, not exported + benchmark-time-base) + (define frame-time/iteration "") -(define (total-time before after) +(define (benchmark-total-time before after) (- (tms:clock after) (tms:clock before))) -(define (user-time before after) +(define (benchmark-user-time before after) (- (tms:utime after) (tms:utime before))) -(define (system-time before after) +(define (benchmark-system-time before after) (- (tms:stime after) (tms:stime before))) -(define (frame-time iterations) +(define (benchmark-frame-time iterations) (* iterations frame-time/iteration)) -(define (benchmark-time iterations before after) - (- (user-time before after) (frame-time iterations))) +(define (benchmark-core-time iterations before after) + (- (benchmark-user-time before after) (benchmark-frame-time iterations))) -(define (user-time\interpreter before after gc-time) - (- (user-time before after) gc-time)) +(define (benchmark-user-time\interpreter before after gc-time) + (- (benchmark-user-time before after) gc-time)) -(define (benchmark-time\interpreter iterations before after gc-time) - (- (benchmark-time iterations before after) gc-time)) +(define (benchmark-core-time\interpreter iterations before after gc-time) + (- (benchmark-core-time iterations before after) gc-time)) ;;;; REPORTERS @@ -193,14 +442,15 @@ ;;; Display a single benchmark result to the given port (define (print-result port name iterations before after gc-time) (let* ((name (format-benchmark-name name)) - (total-time (total-time before after)) - (user-time (user-time before after)) - (system-time (system-time before after)) - (frame-time (frame-time iterations)) - (benchmark-time (benchmark-time iterations before after)) - (user-time\interpreter (user-time\interpreter before after gc-time)) - (benchmark-time\interpreter - (benchmark-time\interpreter iterations before after gc-time))) + (total-time (benchmark-total-time before after)) + (user-time (benchmark-user-time before after)) + (system-time (benchmark-system-time before after)) + (frame-time (benchmark-frame-time iterations)) + (benchmark-time (benchmark-core-time iterations before after)) + (user-time\interpreter + (benchmark-user-time\interpreter before after gc-time)) + (benchmark-core-time\interpreter + (benchmark-core-time\interpreter iterations before after gc-time))) (write (list name iterations "total:" (/ total-time time-base) "user:" (/ user-time time-base) @@ -208,7 +458,7 @@ "frame:" (/ frame-time time-base) "benchmark:" (/ benchmark-time time-base) "user/interp:" (/ user-time\interpreter time-base) - "bench/interp:" (/ benchmark-time\interpreter time-base) + "bench/interp:" (/ benchmark-core-time\interpreter time-base) "gc:" (/ gc-time time-base)) port) (newline port))) @@ -229,14 +479,14 @@ ;;; Display interesting results of a single benchmark to the given port (define (print-user-result port name iterations before after gc-time) (let* ((name (format-benchmark-name name)) - (user-time (user-time before after)) - (benchmark-time (benchmark-time iterations before after)) - (benchmark-time\interpreter - (benchmark-time\interpreter iterations before after gc-time))) + (user-time (benchmark-user-time before after)) + (benchmark-time (benchmark-core-time iterations before after)) + (benchmark-core-time\interpreter + (benchmark-core-time\interpreter iterations before after gc-time))) (write (list name iterations "user:" (/ user-time time-base) "benchmark:" (/ benchmark-time time-base) - "bench/interp:" (/ benchmark-time\interpreter time-base) + "bench/interp:" (/ benchmark-core-time\interpreter time-base) "gc:" (/ gc-time time-base)) port) (newline port))) @@ -255,10 +505,12 @@ (benchmark "empty initialization benchmark" 2 #t) ;;; Second, initialize the system constants +(display ";; calibrating the benchmarking framework..." (current-output-port)) +(newline (current-output-port)) (define (initialization-reporter name iterations before after gc-time) (let* ((frame-time (- (tms:utime after) (tms:utime before) gc-time 3))) (set! frame-time/iteration (/ frame-time iterations)) - (display ";; frame time per iteration: " (current-output-port)) + (display ";; framework time per iteration: " (current-output-port)) (display (/ frame-time/iteration time-base) (current-output-port)) (newline (current-output-port)))) (set! default-reporter initialization-reporter) @@ -266,3 +518,4 @@ ;;; Finally, set the default reporter (set! default-reporter user-reporter) + From 8f28ea31bb2a95e88b9d9e6e4f29655ab077c939 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sun, 21 Jul 2002 12:01:26 +0000 Subject: [PATCH 070/306] * lib.scm (print-result, print-user-result): Changed the reporter's outputs to use symbols rather than strings to document the individual values. Thanks to Neil Jerram for the suggestion. --- benchmark-suite/ChangeLog | 6 ++++++ benchmark-suite/lib.scm | 27 +++++++++++++-------------- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog index 1ed5c3421..5cc798ed5 100644 --- a/benchmark-suite/ChangeLog +++ b/benchmark-suite/ChangeLog @@ -1,3 +1,9 @@ +2002-07-21 Dirk Herrmann + + * lib.scm (print-result, print-user-result): Changed the + reporter's outputs to use symbols rather than strings to document + the individual values. Thanks to Neil Jerram for the suggestion. + 2002-07-21 Dirk Herrmann * benchmarks/0-reference.bm: Added as a reference benchmark to be diff --git a/benchmark-suite/lib.scm b/benchmark-suite/lib.scm index 1f940a251..7dfc8b48c 100644 --- a/benchmark-suite/lib.scm +++ b/benchmark-suite/lib.scm @@ -435,7 +435,7 @@ ;;;; Some useful standard reporters: -;;;; Log reporters write all test results to a given log file. +;;;; Log reporters write all benchmark results to a given log file. ;;;; Full reporters write all benchmark results to the standard output. ;;;; User reporters write some interesting results to the standard output. @@ -452,14 +452,14 @@ (benchmark-core-time\interpreter (benchmark-core-time\interpreter iterations before after gc-time))) (write (list name iterations - "total:" (/ total-time time-base) - "user:" (/ user-time time-base) - "system:" (/ system-time time-base) - "frame:" (/ frame-time time-base) - "benchmark:" (/ benchmark-time time-base) - "user/interp:" (/ user-time\interpreter time-base) - "bench/interp:" (/ benchmark-core-time\interpreter time-base) - "gc:" (/ gc-time time-base)) + 'total (/ total-time time-base) + 'user (/ user-time time-base) + 'system (/ system-time time-base) + 'frame (/ frame-time time-base) + 'benchmark (/ benchmark-time time-base) + 'user/interp (/ user-time\interpreter time-base) + 'bench/interp (/ benchmark-core-time\interpreter time-base) + 'gc (/ gc-time time-base)) port) (newline port))) @@ -484,10 +484,10 @@ (benchmark-core-time\interpreter (benchmark-core-time\interpreter iterations before after gc-time))) (write (list name iterations - "user:" (/ user-time time-base) - "benchmark:" (/ benchmark-time time-base) - "bench/interp:" (/ benchmark-core-time\interpreter time-base) - "gc:" (/ gc-time time-base)) + 'user (/ user-time time-base) + 'benchmark (/ benchmark-time time-base) + 'bench/interp (/ benchmark-core-time\interpreter time-base) + 'gc (/ gc-time time-base)) port) (newline port))) @@ -518,4 +518,3 @@ ;;; Finally, set the default reporter (set! default-reporter user-reporter) - From 1d1559ce6dc6190cb46d00c479a12ec51af12011 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 21 Jul 2002 17:46:23 +0000 Subject: [PATCH 071/306] * macros.c: include deprecation.h * vectors.c (s_scm_vector_move_right_x): remove side effect in macro arg. (s_scm_vector_move_left_x): idem. * net_db.c, posix.c, socket.c: variable naming: change ans to result. * sort.c (scm_merge_vector_x): accept vector as argument iso. SCM*. This is needed for full GC correctness. * gc.h: undo previous undocumented changes related to #ifdef GENGC. --- libguile/.cvsignore | 1 + libguile/ChangeLog | 20 ++++++++++ libguile/environments.c | 3 ++ libguile/gc.h | 10 ----- libguile/macros.c | 1 + libguile/net_db.c | 65 +++++++++++++----------------- libguile/posix.c | 68 +++++++++++++++---------------- libguile/socket.c | 32 +++++++-------- libguile/sort.c | 88 +++++++++++++++++++++-------------------- libguile/vectors.c | 13 +++++- 10 files changed, 158 insertions(+), 143 deletions(-) diff --git a/libguile/.cvsignore b/libguile/.cvsignore index d5d8f2a5e..9df5f259b 100644 --- a/libguile/.cvsignore +++ b/libguile/.cvsignore @@ -22,6 +22,7 @@ errnos.list fd.h gh_test_c gh_test_repl +goops.c guile guile-doc-snarf guile-func-name-check diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 3f95b31ed..5aa4ce9ab 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,23 @@ +2002-07-21 Han-Wen + + * goops.c (scm_compute_applicable_methods): use + scm_remember_upto_here_1 iso scm_remember_upto_here + + * macros.c: include deprecation.h + + * vectors.c (s_scm_vector_move_right_x): remove side effect in + macro arg. + (s_scm_vector_move_left_x): idem. + + * net_db.c, posix.c, socket.c: variable naming: change ans to + result. + + * sort.c (scm_merge_vector_x): accept vector as argument + iso. SCM*. This is needed for full GC correctness. + + * gc.h: undo previous undocumented changes related to #ifdef + GENGC. + 2002-07-20 Han-Wen * *.c: add space after commas everywhere. diff --git a/libguile/environments.c b/libguile/environments.c index a5cc3c244..26cf424e2 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -594,6 +594,9 @@ obarray_retrieve (SCM obarray, SCM sym) PRECONDITION: length (ALIST) >= 1 + + This could also be done by combining scm_delq1_x () and + scm_sloppy_assq(), at the cost of walking the list another time. */ static SCM diff --git a/libguile/gc.h b/libguile/gc.h index 72ac83074..0296ea0e0 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -80,22 +80,12 @@ typedef scm_t_cell * SCM_CELLPTR; # define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) #endif /* def _UNICOS */ -#ifdef GENGC -/* - TODO - */ -#else /* ! genGC */ - #define SCM_GC_CARD_N_HEADER_CELLS 1 #define SCM_GC_CARD_N_CELLS 256 -#define SCM_GC_CARD_GENERATION(card) -#define SCM_GC_FLAG_OBJECT_WRITE(x) - #define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) #define SCM_GC_SET_CARD_BVEC(card, bvec) \ ((card)->word_0 = (scm_t_bits) (bvec)) -#endif #define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)) diff --git a/libguile/macros.c b/libguile/macros.c index 77c068519..55fae13d6 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -49,6 +49,7 @@ #include "libguile/print.h" #include "libguile/root.h" #include "libguile/smob.h" +#include "libguile/deprecation.h" #include "libguile/validate.h" #include "libguile/macros.h" diff --git a/libguile/net_db.c b/libguile/net_db.c index 12885642e..f5a6537dc 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -153,8 +153,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, "@code{system-error} or @code{misc_error} keys.") #define FUNC_NAME s_scm_gethost { - SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); - SCM *ve = SCM_WRITABLE_VELTS (ans); + SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED); SCM lst = SCM_EOL; struct hostent *entry; struct in_addr inad; @@ -190,14 +189,14 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, if (!entry) scm_resolv_error (FUNC_NAME, host); - SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->h_name, strlen (entry->h_name))); - SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->h_aliases)); - SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->h_addrtype + 0L)); - SCM_VECTOR_SET(ans, 3, SCM_MAKINUM (entry->h_length + 0L)); + SCM_VECTOR_SET(result, 0, scm_mem2string (entry->h_name, strlen (entry->h_name))); + SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases)); + SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->h_addrtype + 0L)); + SCM_VECTOR_SET(result, 3, SCM_MAKINUM (entry->h_length + 0L)); if (sizeof (struct in_addr) != entry->h_length) { - SCM_VECTOR_SET(ans, 4, SCM_BOOL_F); - return ans; + SCM_VECTOR_SET(result, 4, SCM_BOOL_F); + return result; } for (argv = entry->h_addr_list; argv[i]; i++); while (i--) @@ -205,8 +204,8 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, inad = *(struct in_addr *) argv[i]; lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst); } - SCM_VECTOR_SET(ans, 4, lst); - return ans; + SCM_VECTOR_SET(result, 4, lst); + return result; } #undef FUNC_NAME @@ -232,13 +231,9 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, "given.") #define FUNC_NAME s_scm_getnet { - SCM ans; - SCM *ve; + SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); struct netent *entry; - ans = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_WRITABLE_VELTS (ans); - if (SCM_UNBNDP (net)) { entry = getnetent (); @@ -262,11 +257,11 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, } if (!entry) SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); - SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->n_name, strlen (entry->n_name))); - SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->n_aliases)); - SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->n_addrtype + 0L)); - SCM_VECTOR_SET(ans, 3, scm_ulong2num (entry->n_net + 0L)); - return ans; + SCM_VECTOR_SET(result, 0, scm_mem2string (entry->n_name, strlen (entry->n_name))); + SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases)); + SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->n_addrtype + 0L)); + SCM_VECTOR_SET(result, 3, scm_ulong2num (entry->n_net + 0L)); + return result; } #undef FUNC_NAME #endif @@ -282,12 +277,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, "@code{getprotoent} (see below) if no arguments are supplied.") #define FUNC_NAME s_scm_getproto { - SCM ans; - SCM *ve; - struct protoent *entry; + SCM result = scm_c_make_vector (3, SCM_UNSPECIFIED); - ans = scm_c_make_vector (3, SCM_UNSPECIFIED); - ve = SCM_WRITABLE_VELTS (ans); + struct protoent *entry; if (SCM_UNBNDP (protocol)) { entry = getprotoent (); @@ -311,10 +303,10 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, } if (!entry) SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); - SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->p_name, strlen (entry->p_name))); - SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->p_aliases)); - SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->p_proto + 0L)); - return ans; + SCM_VECTOR_SET(result, 0, scm_mem2string (entry->p_name, strlen (entry->p_name))); + SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases)); + SCM_VECTOR_SET(result, 2, SCM_MAKINUM (entry->p_proto + 0L)); + return result; } #undef FUNC_NAME #endif @@ -323,16 +315,13 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, static SCM scm_return_entry (struct servent *entry) { - SCM ans; - SCM *ve; + SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); - ans = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_WRITABLE_VELTS (ans); - SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->s_name, strlen (entry->s_name))); - SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->s_aliases)); - SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L)); - SCM_VECTOR_SET(ans, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto))); - return ans; + SCM_VECTOR_SET(result, 0, scm_mem2string (entry->s_name, strlen (entry->s_name))); + SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases)); + SCM_VECTOR_SET(result, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L)); + SCM_VECTOR_SET(result, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto))); + return result; } SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, diff --git a/libguile/posix.c b/libguile/posix.c index f9d8a22e0..a4da1a8cf 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -222,7 +222,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0, "supplementary group IDs.") #define FUNC_NAME s_scm_getgroups { - SCM ans; + SCM result; int ngroups; size_t size; GETGROUPS_T *groups; @@ -235,16 +235,16 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0, groups = scm_malloc (size); getgroups (ngroups, groups); - ans = scm_c_make_vector (ngroups, SCM_UNDEFINED); + result = scm_c_make_vector (ngroups, SCM_UNDEFINED); { - SCM * ve = SCM_WRITABLE_VELTS(ans); + SCM * ve = SCM_WRITABLE_VELTS(result); while (--ngroups >= 0) ve[ngroups] = SCM_MAKINUM (groups [ngroups]); } free (groups); - return ans; + return result; } #undef FUNC_NAME #endif @@ -259,7 +259,7 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, { struct passwd *entry; - SCM ans = scm_c_make_vector (7, SCM_UNSPECIFIED); + SCM result = scm_c_make_vector (7, SCM_UNSPECIFIED); if (SCM_UNBNDP (user) || SCM_FALSEP (user)) { SCM_SYSCALL (entry = getpwent ()); @@ -280,20 +280,20 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, if (!entry) SCM_MISC_ERROR ("entry not found", SCM_EOL); - SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->pw_name)); - SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->pw_passwd)); - SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->pw_uid)); - SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) entry->pw_gid)); - SCM_VECTOR_SET(ans, 4, scm_makfrom0str (entry->pw_gecos)); + SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->pw_name)); + SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->pw_passwd)); + SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) entry->pw_uid)); + SCM_VECTOR_SET(result, 3, scm_ulong2num ((unsigned long) entry->pw_gid)); + SCM_VECTOR_SET(result, 4, scm_makfrom0str (entry->pw_gecos)); if (!entry->pw_dir) - SCM_VECTOR_SET(ans, 5, scm_makfrom0str ("")); + SCM_VECTOR_SET(result, 5, scm_makfrom0str ("")); else - SCM_VECTOR_SET(ans, 5, scm_makfrom0str (entry->pw_dir)); + SCM_VECTOR_SET(result, 5, scm_makfrom0str (entry->pw_dir)); if (!entry->pw_shell) - SCM_VECTOR_SET(ans, 6, scm_makfrom0str ("")); + SCM_VECTOR_SET(result, 6, scm_makfrom0str ("")); else - SCM_VECTOR_SET(ans, 6, scm_makfrom0str (entry->pw_shell)); - return ans; + SCM_VECTOR_SET(result, 6, scm_makfrom0str (entry->pw_shell)); + return result; } #undef FUNC_NAME #endif /* HAVE_GETPWENT */ @@ -327,7 +327,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, #define FUNC_NAME s_scm_getgrgid { struct group *entry; - SCM ans = scm_c_make_vector (4, SCM_UNSPECIFIED); + SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); if (SCM_UNBNDP (name) || SCM_FALSEP (name)) { @@ -347,11 +347,11 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, if (!entry) SCM_SYSERROR; - SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->gr_name)); - SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->gr_passwd)); - SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->gr_gid)); - SCM_VECTOR_SET(ans, 3, scm_makfromstrs (-1, entry->gr_mem)); - return ans; + SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->gr_name)); + SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->gr_passwd)); + SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) entry->gr_gid)); + SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem)); + return result; } #undef FUNC_NAME @@ -741,7 +741,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, "underlying @var{port}.") #define FUNC_NAME s_scm_ttyname { - char *ans; + char *result; int fd; port = SCM_COERCE_OUTPORT (port); @@ -749,11 +749,11 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, if (!SCM_FPORTP (port)) return SCM_BOOL_F; fd = SCM_FPORT_FDES (port); - SCM_SYSCALL (ans = ttyname (fd)); - if (!ans) + SCM_SYSCALL (result = ttyname (fd)); + if (!result) SCM_SYSERROR; - /* ans could be overwritten by another call to ttyname */ - return (scm_makfrom0str (ans)); + /* result could be overwritten by another call to ttyname */ + return (scm_makfrom0str (result)); } #undef FUNC_NAME #endif /* HAVE_TTYNAME */ @@ -982,19 +982,19 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0, #define FUNC_NAME s_scm_uname { struct utsname buf; - SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); + SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED); if (uname (&buf) < 0) SCM_SYSERROR; - SCM_VECTOR_SET(ans, 0, scm_makfrom0str (buf.sysname)); - SCM_VECTOR_SET(ans, 1, scm_makfrom0str (buf.nodename)); - SCM_VECTOR_SET(ans, 2, scm_makfrom0str (buf.release)); - SCM_VECTOR_SET(ans, 3, scm_makfrom0str (buf.version)); - SCM_VECTOR_SET(ans, 4, scm_makfrom0str (buf.machine)); + SCM_VECTOR_SET(result, 0, scm_makfrom0str (buf.sysname)); + SCM_VECTOR_SET(result, 1, scm_makfrom0str (buf.nodename)); + SCM_VECTOR_SET(result, 2, scm_makfrom0str (buf.release)); + SCM_VECTOR_SET(result, 3, scm_makfrom0str (buf.version)); + SCM_VECTOR_SET(result, 4, scm_makfrom0str (buf.machine)); /* a linux special? - SCM_VECTOR_SET(ans, 5, scm_makfrom0str (buf.domainname)); + SCM_VECTOR_SET(result, 5, scm_makfrom0str (buf.domainname)); */ - return ans; + return result; } #undef FUNC_NAME #endif /* HAVE_UNAME */ diff --git a/libguile/socket.c b/libguile/socket.c index 5ea34d78a..bf1dc019e 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -925,7 +925,7 @@ static SCM scm_addr_vector (const struct sockaddr *address, const char *proc) { short int fam = address->sa_family; - SCM ans =SCM_EOL; + SCM result =SCM_EOL; switch (fam) @@ -934,11 +934,11 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_in *nad = (struct sockaddr_in *) address; - ans = scm_c_make_vector (3, SCM_UNSPECIFIED); + result = scm_c_make_vector (3, SCM_UNSPECIFIED); - SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); - SCM_VECTOR_SET(ans, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr))); - SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port))); + SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(result, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr))); + SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port))); } break; #ifdef HAVE_IPV6 @@ -946,15 +946,15 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address; - ans = scm_c_make_vector (5, SCM_UNSPECIFIED); - SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); - SCM_VECTOR_SET(ans, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr)); - SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port))); - SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo)); + result = scm_c_make_vector (5, SCM_UNSPECIFIED); + SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(result, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr)); + SCM_VECTOR_SET(result, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port))); + SCM_VECTOR_SET(result, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo)); #ifdef HAVE_SIN6_SCOPE_ID - SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) nad->sin6_scope_id)); + SCM_VECTOR_SET(result, 4, scm_ulong2num ((unsigned long) nad->sin6_scope_id)); #else - SCM_VECTOR_SET(ans, 4, SCM_INUM0); + SCM_VECTOR_SET(result, 4, SCM_INUM0); #endif } break; @@ -964,10 +964,10 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) { const struct sockaddr_un *nad = (struct sockaddr_un *) address; - ans = scm_c_make_vector (2, SCM_UNSPECIFIED); + result = scm_c_make_vector (2, SCM_UNSPECIFIED); - SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam)); - SCM_VECTOR_SET(ans, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path))); + SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam)); + SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path))); } break; #endif @@ -975,7 +975,7 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) scm_misc_error (proc, "Unrecognised address family: ~A", scm_list_1 (SCM_MAKINUM (fam))); } - return ans; + return result; } /* calculate the size of a buffer large enough to hold any supported diff --git a/libguile/sort.c b/libguile/sort.c index 8bca27c41..e8b332e42 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -437,7 +437,6 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, len = SCM_INUM (endpos) - spos; quicksort (&vp[spos], len, size, scm_cmp_function (less), less); - SCM_GC_FLAG_OBJECT_WRITE(vec); return SCM_UNSPECIFIED; /* return vec; */ @@ -784,43 +783,55 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0, #undef FUNC_NAME static void -scm_merge_vector_x (void *const vecbase, - void *const tempbase, +scm_merge_vector_x (SCM vec, + SCM * temp, cmp_fun_t cmp, SCM less, long low, long mid, long high) { - register SCM *vp = (SCM *) vecbase; - register SCM *temp = (SCM *) tempbase; long it; /* Index for temp vector */ long i1 = low; /* Index for lower vector segment */ long i2 = mid + 1; /* Index for upper vector segment */ /* Copy while both segments contain more characters */ for (it = low; (i1 <= mid) && (i2 <= high); ++it) - if ((*cmp) (less, &vp[i2], &vp[i1])) - temp[it] = vp[i2++]; - else - temp[it] = vp[i1++]; + { + /* + Every call of LESS might invoke GC. For full correctness, we + should reset the generation of vecbase and tempbase between + every call of less. - /* Copy while first segment contains more characters */ - while (i1 <= mid) - temp[it++] = vp[i1++]; + */ + register SCM *vp = SCM_WRITABLE_VELTS(vec); + + if ((*cmp) (less, &vp[i2], &vp[i1])) + temp[it] = vp[i2++]; + else + temp[it] = vp[i1++]; + } - /* Copy while second segment contains more characters */ - while (i2 <= high) - temp[it++] = vp[i2++]; + { + register SCM *vp = SCM_WRITABLE_VELTS(vec); + + /* Copy while first segment contains more characters */ + while (i1 <= mid) + temp[it++] = vp[i1++]; - /* Copy back from temp to vp */ - for (it = low; it <= high; ++it) - vp[it] = temp[it]; -} /* scm_merge_vector_x */ + /* Copy while second segment contains more characters */ + while (i2 <= high) + temp[it++] = vp[i2++]; + + /* Copy back from temp to vp */ + for (it = low; it <= high; ++it) + vp[it] = temp[it]; + } +} /* scm_merge_vector_x */ static void -scm_merge_vector_step (void *const vp, - void *const temp, +scm_merge_vector_step (SCM vp, + SCM * temp, cmp_fun_t cmp, SCM less, long low, @@ -860,18 +871,16 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, } else if (SCM_VECTORP (items)) { - SCM *temp, *vp; + SCM *temp; len = SCM_VECTOR_LENGTH (items); + + /* + the following array does not contain any new references to + SCM objects, so we can get away with allocing it on the heap. + */ temp = malloc (len * sizeof(SCM)); - - vp = SCM_WRITABLE_VELTS (items); - /* - This routine modifies VP - */ - - SCM_GC_FLAG_OBJECT_WRITE(items); - scm_merge_vector_step (vp, + scm_merge_vector_step (items, temp, scm_cmp_function (less), less, @@ -886,7 +895,6 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, #undef FUNC_NAME /* stable_sort manages lists and vectors */ - SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, (SCM items, SCM less), "Sort the sequence @var{items}, which may be a list or a\n" @@ -894,13 +902,14 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, "This is a stable sort.") #define FUNC_NAME s_scm_stable_sort { - long len; /* list/vector length */ + if (SCM_NULL_OR_NIL_P (items)) return items; SCM_VALIDATE_NIM (2, less); if (SCM_CONSP (items)) { + long len; /* list/vector length */ SCM_VALIDATE_LIST_COPYLEN (1, items, len); items = scm_list_copy (items); return scm_merge_list_step (&items, scm_cmp_function (less), less, len); @@ -909,19 +918,12 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, /* support ordinary vectors even if arrays not available? */ else if (SCM_VECTORP (items)) { - SCM retvec; - SCM *temp, *vp; - len = SCM_VECTOR_LENGTH (items); - retvec = scm_make_uve (len, scm_array_prototype (items)); + long len = SCM_VECTOR_LENGTH (items); + SCM *temp = malloc (len * sizeof (SCM)); + SCM retvec = scm_make_uve (len, scm_array_prototype (items)); scm_array_copy_x (items, retvec); - temp = malloc (len * sizeof (SCM)); - /* - don't worry about write barrier: retvec is new anyway. - */ - vp = SCM_WRITABLE_VELTS (retvec); - - scm_merge_vector_step (vp, + scm_merge_vector_step (retvec, temp, scm_cmp_function (less), less, diff --git a/libguile/vectors.c b/libguile/vectors.c index 86dc0b121..947c333be 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -301,7 +301,11 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0, SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2)); while (i Date: Sun, 21 Jul 2002 21:18:27 +0000 Subject: [PATCH 072/306] * modules.c (scm_sym2var): Don't compare SCM values with ==. --- libguile/ChangeLog | 4 ++++ libguile/modules.c | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5aa4ce9ab..513102edb 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-07-21 Dirk Herrmann + + * modules.c (scm_sym2var): Don't compare SCM values with ==. + 2002-07-21 Han-Wen * goops.c (scm_compute_applicable_methods): use diff --git a/libguile/modules.c b/libguile/modules.c index 9c6d72621..d77aab912 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -435,7 +435,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep) { SCM handle; - if (definep == SCM_BOOL_F) + if (SCM_FALSEP (definep)) var = scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_BOOL_F); else { From afc8e572bae0ffabd72b77ed6d9326362356c34a Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Mon, 22 Jul 2002 00:17:26 +0000 Subject: [PATCH 073/306] (mscripts): find and check version number of automake. Complain if 1.6 is not found. --- ChangeLog | 5 +++++ autogen.sh | 24 +++++++++++++++++++++--- libguile/goops.c | 2 +- 3 files changed, 27 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index 73413fcb0..9f3b87388 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2002-07-22 Han-Wen + + * autogen.sh (mscripts): find and check version number of + automake. Complain if 1.6 is not found. + 2002-07-20 Han-Wen * autogen.sh (mscripts): find and check version number of diff --git a/autogen.sh b/autogen.sh index ef7b58af8..f06a127ac 100755 --- a/autogen.sh +++ b/autogen.sh @@ -100,6 +100,24 @@ if test -z "$autoconf"; then echo "ERROR: Please install autoconf 2.53" exit 1 fi +################################################################ + +#detect automake version + + +# configure.in reqs autoconf-2.53; try to find it +for suf in "-1.6" "1.6" "" false; do + version=`automake$suf --version 2>/dev/null | head -1 | awk '{print $NF}' | awk -F. '{print $1 * 10 + $2}'` + if test "0$version" -eq 16; then + automake=automake$suf + break + fi +done + +if test -z "$automake"; then + echo "ERROR: Please install automake 1.6.x" + exit 1 +fi ################################################################ @@ -110,15 +128,15 @@ $autoconf # file. We need two mdate-sh, tho, one in doc/ref/ and one in # doc/tutorial/. We run automake twice as a workaround. -automake --add-missing -automake --add-missing +$automake --add-missing +$automake --add-missing # Make sure that libltdl uses the same autoconf version as the rest. # echo "libltdl..." (cd libltdl && aclocal) (cd libltdl && autoconf) -(cd libltdl && automake --gnu --add-missing) +(cd libltdl && $automake --gnu --add-missing) echo "guile-readline..." (cd guile-readline && ./autogen.sh) diff --git a/libguile/goops.c b/libguile/goops.c index 7ff530d1d..8017cffa3 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1872,7 +1872,7 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p) return SCM_BOOL_F; } - scm_remember_upto_here (tmp); + scm_remember_upto_here_1 (tmp); return (count == 1 ? applicable : sort_applicable_methods (applicable, count, types)); From 6a5354407299c4faf8df61235a2867a8db5aa7e3 Mon Sep 17 00:00:00 2001 From: Stefan Jahn Date: Wed, 24 Jul 2002 09:25:24 +0000 Subject: [PATCH 074/306] 2002-07-24 Stefan Jahn * continuations.h: ia64: Include before . --- libguile/ChangeLog | 5 +++++ libguile/continuations.h | 1 + 2 files changed, 6 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 513102edb..c401582ee 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-07-24 Stefan Jahn + + * continuations.h: ia64: Include before + . + 2002-07-21 Dirk Herrmann * modules.c (scm_sym2var): Don't compare SCM values with ==. diff --git a/libguile/continuations.h b/libguile/continuations.h index 96d02fb77..c876fad03 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -49,6 +49,7 @@ #include "libguile/__scm.h" #ifdef __ia64__ +#include #include extern unsigned long * __libc_ia64_register_backing_store_base; #endif /* __ia64__ */ From 35060ae90ef2b79bc7f9cd0ca1b820f775e51730 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Wed, 24 Jul 2002 16:34:43 +0000 Subject: [PATCH 075/306] * environments.c (remove_key_from_alist): Removed. (obarray_remove): Simplified. --- libguile/ChangeLog | 6 ++++ libguile/environments.c | 62 ++++++----------------------------------- 2 files changed, 14 insertions(+), 54 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c401582ee..d5007ded2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-07-24 Dirk Herrmann + + * environments.c (remove_key_from_alist): Removed. + + (obarray_remove): Simplified. + 2002-07-24 Stefan Jahn * continuations.h: ia64: Include before diff --git a/libguile/environments.c b/libguile/environments.c index 26cf424e2..fadfbc6de 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -46,6 +46,7 @@ #include "libguile/eval.h" #include "libguile/gh.h" #include "libguile/hash.h" +#include "libguile/list.h" #include "libguile/ports.h" #include "libguile/smob.h" #include "libguile/symbols.h" @@ -587,49 +588,6 @@ obarray_retrieve (SCM obarray, SCM sym) return SCM_UNDEFINED; } -/* - Remove first occurance of KEY from (cdr ALIST), - return (KEY . VAL) if found, otherwise return #f - - PRECONDITION: - - length (ALIST) >= 1 - - This could also be done by combining scm_delq1_x () and - scm_sloppy_assq(), at the cost of walking the list another time. - */ -static -SCM -remove_key_from_alist (SCM alist, SCM key) -{ - SCM cell_cdr = alist; - alist =SCM_CDR (alist); - - /* - inv: cdr(cell_cdr) == alist - */ - while (!SCM_NULLP (alist)) - { - if (SCM_EQ_P(SCM_CAAR (alist), key)) - { - SCM entry = SCM_CAR(alist); - SCM_SETCDR(cell_cdr, SCM_CDR (alist)); - - return entry; - } - else - { - cell_cdr = SCM_CDR (cell_cdr); - } - - if (!SCM_NULLP(alist)) - alist = SCM_CDR (alist); - } - - return SCM_BOOL_F; -} - - /* * Remove entry from obarray. If the symbol was found and removed, the old @@ -640,19 +598,15 @@ obarray_remove (SCM obarray, SCM sym) { size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray); SCM table_entry = SCM_VELTS (obarray)[hash]; + SCM handle = scm_sloppy_assq (sym, table_entry); - if (SCM_NULLP(table_entry)) - return SCM_BOOL_F; + if (SCM_CONSP (handle)) + { + SCM new_table_entry = scm_delq1_x (handle, table_entry); + SCM_VECTOR_SET (obarray, hash, new_table_entry); + } - if (SCM_EQ_P (SCM_CAAR (table_entry), sym)) - { - SCM_VECTOR_SET (obarray, hash, SCM_CDR(table_entry)); - return SCM_CAR(table_entry); - } - else - { - return remove_key_from_alist (table_entry, sym); - } + return handle; } From dfd71abaf089b69c299f1a99670ce74e4c4c254e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 25 Jul 2002 12:12:21 +0000 Subject: [PATCH 076/306] (rstate_free): Return zero. --- libguile/random.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/random.c b/libguile/random.c index ea1d3a755..efdf59749 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -351,7 +351,7 @@ static size_t rstate_free (SCM rstate) { free (SCM_RSTATE (rstate)); - return scm_the_rng.rstate_size; + return 0; } /* From aea06b34a5c6ecfc7f7fc257d42b0b7c92109a92 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 25 Jul 2002 12:12:33 +0000 Subject: [PATCH 077/306] *** empty log message *** --- libguile/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d5007ded2..9522a54c3 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-07-25 Marius Vollmer + + * random.c (rstate_free): Return zero. + 2002-07-24 Dirk Herrmann * environments.c (remove_key_from_alist): Removed. From 5a6aa7e7ce3c71e93cf032a18ab2b2b51d5ed317 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 26 Jul 2002 16:00:27 +0000 Subject: [PATCH 078/306] (SCM_BENCHMARKS): List the real benchmarks, not foo and bar. (SCM_BENCHMARKS_DIRS): Uncommented, with an empty value. --- benchmark-suite/Makefile.am | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am index 4bb81e49e..073a3677a 100644 --- a/benchmark-suite/Makefile.am +++ b/benchmark-suite/Makefile.am @@ -1,8 +1,9 @@ -SCM_BENCHMARKS = benchmarks/foo.bm \ - benchmarks/bar.bm +SCM_BENCHMARKS = benchmarks/0-reference.bm \ + benchmarks/continuations.bm \ + benchmarks/if.bm \ + benchmarks/logand.bm -## SCM_BENCHMARKS_DIRS = benchmarks/dirfoo \ -## benchmarks/dirbar +SCM_BENCHMARKS_DIRS = EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) From ab331c2b6c724f49a409d71abc1c4c3c8099e164 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 26 Jul 2002 16:00:38 +0000 Subject: [PATCH 079/306] *** empty log message *** --- benchmark-suite/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog index 5cc798ed5..923019024 100644 --- a/benchmark-suite/ChangeLog +++ b/benchmark-suite/ChangeLog @@ -1,3 +1,9 @@ +2002-07-26 Marius Vollmer + + * Makefile.am (SCM_BENCHMARKS): List the real benchmarks, not foo + and bar. + (SCM_BENCHMARKS_DIRS): Uncommented, with an empty value. + 2002-07-21 Dirk Herrmann * lib.scm (print-result, print-user-result): Changed the From 1bb649f993e77749a463b77b5db4d524473a3c7e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 26 Jul 2002 16:20:53 +0000 Subject: [PATCH 080/306] (dist-hook): Use quotes so that an empty SCM_BENCHMARKS_DIRS works. --- benchmark-suite/Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am index 073a3677a..db7674ccf 100644 --- a/benchmark-suite/Makefile.am +++ b/benchmark-suite/Makefile.am @@ -11,6 +11,6 @@ EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) ## etc without any help, but not all version can handle 'deep' ## directories. So we do it on our own. dist-hook: - for d in $(SCM_BENCHMARKS_DIRS); do \ + for d in "$(SCM_BENCHMARKS_DIRS)"; do \ cp -pR $(srcdir)/$$d $(distdir)/$$d; \ done From c3b6ed76e38a09e0f34879ef353b02b0bfdfab63 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 26 Jul 2002 16:21:00 +0000 Subject: [PATCH 081/306] *** empty log message *** --- benchmark-suite/ChangeLog | 1 + 1 file changed, 1 insertion(+) diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog index 923019024..a7d17d1ec 100644 --- a/benchmark-suite/ChangeLog +++ b/benchmark-suite/ChangeLog @@ -3,6 +3,7 @@ * Makefile.am (SCM_BENCHMARKS): List the real benchmarks, not foo and bar. (SCM_BENCHMARKS_DIRS): Uncommented, with an empty value. + (dist-hook): Use quotes so that an empty SCM_BENCHMARKS_DIRS works. 2002-07-21 Dirk Herrmann From f9482b3108145947232dd1a899d4aa1fd1ede2ed Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 1 Aug 2002 18:42:11 +0000 Subject: [PATCH 082/306] Moved here from parent directory. --- qt/md/arm.h | 96 +++++++++++++++++++++++++++++++++++++++++++++++++++++ qt/md/arm.s | 34 +++++++++++++++++++ 2 files changed, 130 insertions(+) create mode 100644 qt/md/arm.h create mode 100644 qt/md/arm.s diff --git a/qt/md/arm.h b/qt/md/arm.h new file mode 100644 index 000000000..016cbb873 --- /dev/null +++ b/qt/md/arm.h @@ -0,0 +1,96 @@ +/* + * QuickThreads -- Threads-building toolkit. + * Copyright (c) 1993 by David Keppel + * Copyright (c) 2002 by Marius Vollmer + * + * Permission to use, copy, modify and distribute this software and + * its documentation for any purpose and without fee is hereby + * granted, provided that the above copyright notice and this notice + * appear in all copies. This software is provided as a + * proof-of-concept and for demonstration purposes; there is no + * representation about the suitability of this software for any + * purpose. + */ + +#ifndef QT_ARM_H +#define QT_ARM_H + +typedef unsigned long qt_word_t; + +#define QT_GROW_DOWN + +/* Stack layout on the ARM: + + Callee-save registers are: r4-r11 (f4-f7) + Also save r14, link register, and restore as pc. + + +--- + | lr/pc + | r11 + | r10 + | r9 + | r8 + | r7 + | r6 + | r5 + | r4 <- sp of a suspended thread + +--- + + Startup: + + +--- + | only + | user + | argt + | argu <- sp on entry to qt_start + +--- + | pc == qt_start + | r11 + | r10 + | r9 + | r8 + | r7 + | r6 + | r5 + | r4 + +--- + +*/ + +/* Stack must be word aligned. */ +#define QT_STKALIGN (4) /* Doubleword aligned. */ + +/* How much space is allocated to hold all the crud for + initialization: r4-r11, r14, and the four args for qt_start. */ + +#define QT_STKBASE ((9+4)*4) + + +/* Offsets of various registers, in words, relative to final value of SP. */ +#define QT_LR 8 +#define QT_11 7 +#define QT_10 6 +#define QT_9 5 +#define QT_8 4 +#define QT_7 3 +#define QT_6 2 +#define QT_5 1 +#define QT_4 0 + + +/* When a never-before-run thread is restored, the return pc points + to a fragment of code that starts the thread running. For + non-vargs functions, it just calls the client's `only' function. + */ + +extern void qt_start(void); +#define QT_ARGS_MD(sp) (QT_SPUT (sp, QT_LR, qt_start)) + + +/* The *index* (positive offset) of where to put each value. */ +#define QT_ONLY_INDEX (12) +#define QT_USER_INDEX (11) +#define QT_ARGT_INDEX (10) +#define QT_ARGU_INDEX (9) + +#endif /* ndef QT_ARM_H */ diff --git a/qt/md/arm.s b/qt/md/arm.s new file mode 100644 index 000000000..cd322a373 --- /dev/null +++ b/qt/md/arm.s @@ -0,0 +1,34 @@ + .text + .align 2 + .global qt_abort + .global qt_block + .global qt_blocki + + # r0: helper + # r1: arg1 + # r2: arg2 + # r3: new_sp +qt_abort: +qt_block: +qt_blocki: + stmfd sp!, {r4-r11,lr} + mov ip, r0 + mov r0, sp + mov sp, r3 + mov lr, pc + mov pc, ip + ldmfd sp!, {r4-r11,pc} + + + .global qt_start + .global qt_error + .type qt_start,function +qt_start: + ldr r0, [sp] + ldr r1, [sp, #4] + ldr r2, [sp, #8] + ldr lr, qt_error_loc + ldr pc, [sp, #12] + +qt_error_loc: + .word qt_error From cc8c6e7d30b8c6fa327fb9d1e2d3864a60731d78 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 1 Aug 2002 18:43:19 +0000 Subject: [PATCH 083/306] *** empty log message *** --- qt/arm.h | 0 qt/arm.s | 0 2 files changed, 0 insertions(+), 0 deletions(-) delete mode 100644 qt/arm.h delete mode 100644 qt/arm.s diff --git a/qt/arm.h b/qt/arm.h deleted file mode 100644 index e69de29bb..000000000 diff --git a/qt/arm.s b/qt/arm.s deleted file mode 100644 index e69de29bb..000000000 From c3164ca85ed8c43a1732a828fc299a05d556a1f3 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Fri, 2 Aug 2002 22:58:38 +0000 Subject: [PATCH 084/306] * scheme-modules.texi: split "Scheme and modules" into "provide and require" and "Environments". Mention R5RS environments. --- doc/ref/ChangeLog | 6 ++ doc/ref/scheme-evaluation.texi | 2 + doc/ref/scheme-modules.texi | 104 ++++++++++++++++++++++++--------- 3 files changed, 85 insertions(+), 27 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 8b8ff5a6b..88d4c02d8 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2002-08-02 Gary Houston + + * scheme-modules.texi: split "Scheme and modules" into + "provide and require" and "Environments". Mention R5RS + environments. + 2002-07-16 Neil Jerram * scheme-options.texi (Debugger options): New subsection diff --git a/doc/ref/scheme-evaluation.texi b/doc/ref/scheme-evaluation.texi index fbfcd87a8..b73f8316d 100644 --- a/doc/ref/scheme-evaluation.texi +++ b/doc/ref/scheme-evaluation.texi @@ -182,6 +182,8 @@ this procedure directly, use the procedures @code{read-enable}, @node Fly Evaluation @section Procedures for On the Fly Evaluation +@xref{Environments}. + @rnindex eval @c ARGFIXME environment/environment specifier @deffn {Scheme Procedure} eval exp module diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index 9e3ddf894..c9279258c 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -36,17 +36,15 @@ In addition, Guile offers variables as first-class objects. They can be used for interacting with the module system. @menu -* Scheme and modules:: How modules are handled in standard Scheme. +* provide and require:: The SLIB feature mechanism. +* Environments:: R5RS top-level environments. * The Guile module system:: How Guile does it. * Dynamic Libraries:: Loading libraries of compiled code at run time. * Variables:: First-class variables. @end menu - -@node Scheme and modules -@section Scheme and modules - -Scheme, as defined in R5RS, does @emph{not} have a module system at all. +@node provide and require +@section provide and require Aubrey Jaffer, mostly to support his portable Scheme library SLIB, implemented a provide/require mechanism for many Scheme implementations. @@ -70,10 +68,56 @@ and they would magically become available, @emph{but still have the same names!} So this method is nice, but not as good as a full-featured module system. +When SLIB is used with Guile, provide and require can be used to access +its facilities. + +@node Environments +@section Environments +@cindex environment + +Scheme, as defined in R5RS, does @emph{not} have a full module system. +However it does define the concept of a top-level @dfn{environment}. +Such an environment maps identifiers (symbols) to Scheme objects such +as procedures and lists: @ref{About Closure}. In other words, it +implements a set of @dfn{bindings}. + +Environments in R5RS can be passed as the second argument to +@code{eval} (@pxref{Fly Evaluation}). Three procedures are defined to +return environments: @code{scheme-report-environment}, +@code{null-environment} and @code{interaction-environment} (@pxref{Fly +Evaluation}). + +In addition, in Guile any module can be used as an R5RS environment, +i.e., passed as the second argument to @code{eval}. + +@deffn {Scheme Procedure} scheme-report-environment version +@deffnx {Scheme Procedure} null-environment version +@var{version} must be the exact integer `5', corresponding to revision +5 of the Scheme report (the Revised^5 Report on Scheme). +@code{scheme-report-environment} returns a specifier for an +environment that is empty except for all bindings defined in the +report that are either required or both optional and supported by the +implementation. @code{null-environment} returns a specifier for an +environment that is empty except for the (syntactic) bindings for all +syntactic keywords defined in the report that are either required or +both optional and supported by the implementation. + +Currently Guile does not support values of @var{version} for other +revisions of the report. + +The effect of assigning (through the use of @code{eval}) a variable +bound in a @code{scheme-report-environment} (for example @code{car}) +is unspecified. Currently the environments specified by +@code{scheme-report-environment} are not immutable in Guile. +@end deffn @node The Guile module system @section The Guile module system +The Guile module system extends the concept of environments, discussed +in the previous section, with mechanisms to define, use and customise +sets of bindings. + In 1996 Tom Lord implemented a full-featured module system for Guile which allows loading Scheme source files into a private name space. This system has been in available since at least Guile version 1.1. @@ -101,10 +145,17 @@ there is still some flux. @node General Information about Modules @subsection General Information about Modules -A Guile module is a collection of named procedures, variables and -macros, altogether called the @dfn{bindings}, since they bind, or -associate, a symbol (the name) to a Scheme object (procedure, variable, -or macro). Within a module, all bindings are visible. Certain bindings +A Guile module can be thought of as a collection of named procedures, +variables and macros. More precisely, it is a set of @dfn{bindings} +of symbols (names) to Scheme objects. + +An environment is a mapping from identifiers (or symbols) to locations, +i.e., a set of bindings. +There are top-level environments and lexical environments. +Environment in which a lambda is excuted is remembered as part of its +definition. + +Within a module, all bindings are visible. Certain bindings can be declared @dfn{public}, in which case they are added to the module's so-called @dfn{export list}; this set of public bindings is called the module's @dfn{public interface} (@pxref{Creating Guile @@ -118,16 +169,17 @@ algorithmically @dfn{rename} bindings. In contrast, when using the providing module's public interface, the entire export list is available without renaming (@pxref{Using Guile Modules}). -To use a module, it must be found and loaded. All Guile modules have a -unique @dfn{module name}, which is a list of one or more symbols. -Examples are @code{(ice-9 popen)} or @code{(srfi srfi-11)}. When Guile -searches for the code of a module, it constructs the name of the file to -load by concatenating the name elements with slashes between the -elements and appending a number of file name extensions from the list -@code{%load-extensions} (REFFIXME). The resulting file name is then -searched in all directories in the variable @code{%load-path}. For -example, the @code{(ice-9 popen)} module would result in the filename -@code{ice-9/popen.scm} and searched in the installation directory of +To use a module, it must be found and loaded. All Guile modules have +a unique @dfn{module name}, which is a list of one or more symbols. +Examples are @code{(ice-9 popen)} or @code{(srfi srfi-11)}. When +Guile searches for the code of a module, it constructs the name of the +file to load by concatenating the name elements with slashes between +the elements and appending a number of file name extensions from the +list @code{%load-extensions} (@pxref{Loading}). The resulting file +name is then searched in all directories in the variable +@code{%load-path} (@pxref{Install Config}). For example, the +@code{(ice-9 popen)} module would result in the filename +@code{ice-9/popen.scm} and searched in the installation directories of Guile and in all other directories in the load path. @c FIXME::martin: Not sure about this, maybe someone knows better? @@ -149,10 +201,11 @@ address these eventually. To use a Guile module is to access either its public interface or a custom interface (@pxref{General Information about Modules}). Both types of access are handled by the syntactic form @code{use-modules}, -which accepts one or more interface specifications and, upon evaluation, -arranges for those interfaces to be available to the current module. -This process may include locating and loading code for a given module if -that code has not yet been loaded (REFFIXME %load-path). +which accepts one or more interface specifications and, upon +evaluation, arranges for those interfaces to be available to the +current module. This process may include locating and loading code +for a given module if that code has not yet been loaded, following +%load-path (@pxref{Install Config}). An @dfn{interface specification} has one of two forms. The first variation is simply to name the module, in which case its public @@ -581,9 +634,6 @@ converted to a Scheme number and returned from the call to @code{dynamic-args-call}. @end deffn -When dynamic linking is disabled or not supported on your system, -the above functions throw errors, but they are still available. - Here is a small example that may work on GNU/Linux: @smallexample From c8a1bdc460f892847d0fb3f1321cdeb305160bf8 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 4 Aug 2002 00:17:18 +0000 Subject: [PATCH 085/306] new gc --- libguile/ChangeLog | 10 + libguile/Makefile.am | 10 +- libguile/continuations.c | 2 +- libguile/gc-card.c | 337 ++++++ libguile/gc.c | 2359 ++++---------------------------------- libguile/gc.h | 149 ++- libguile/gdbint.c | 29 +- libguile/guardians.c | 12 +- libguile/init.c | 4 +- libguile/inline.c | 5 +- libguile/inline.h | 111 +- libguile/numbers.c | 6 + libguile/pairs.c | 2 +- libguile/print.c | 2 +- libguile/procs.c | 2 +- libguile/regex-posix.c | 9 +- libguile/struct.c | 6 +- libguile/symbols.c | 11 +- libguile/weaks.c | 17 +- 19 files changed, 796 insertions(+), 2287 deletions(-) create mode 100644 libguile/gc-card.c diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 9522a54c3..7ec6feb57 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,13 @@ +2002-08-04 Han-Wen + + * numbers.c (big2str): return "0" for 0 iso. "" + + * gc-segment.c, gc-malloc.c gc-mark.c, gc-freelist.c, gc-card.c, private-gc.h: + new file + + * gc.c: completely revised and cleaned up the GC. It now uses lazy + sweeping. More documentation in workbook/newgc.text + 2002-07-25 Marius Vollmer * random.c (rstate_free): Return zero. diff --git a/libguile/Makefile.am b/libguile/Makefile.am index c8b16a572..87694b67b 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -64,7 +64,8 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ chars.c continuations.c convert.c debug.c deprecation.c \ dynwind.c environments.c eq.c error.c eval.c evalext.c extensions.c \ feature.c fluids.c fports.c \ - gc.c gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c gh_init.c \ + gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c gc-freelist.c \ + gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c gh_init.c \ gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c guardians.c hash.c \ hashtab.c hooks.c init.c inline.c ioext.c iselect.c keywords.c \ lang.c list.c \ @@ -79,7 +80,7 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \ continuations.x debug.x deprecation.x dynl.x dynwind.x \ environments.x eq.x \ error.x eval.x evalext.x extensions.x feature.x fluids.x fports.x \ - gc.x goops.x \ + gc.x gc-mark.x gc-segment.x gc-malloc.x gc-card.x goops.x \ gsubr.x guardians.x hash.x hashtab.x hooks.x init.x ioext.x iselect.x \ keywords.x lang.x list.x load.x macros.x mallocs.x modules.x \ numbers.x objects.x objprop.x options.x pairs.x ports.x print.x \ @@ -95,7 +96,7 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \ boolean.doc chars.doc continuations.doc debug.doc dynl.doc \ dynwind.doc environments.doc eq.doc error.doc eval.doc evalext.doc \ extensions.doc feature.doc fluids.doc fports.doc gc.doc goops.doc \ - gsubr.doc \ + gsubr.doc gc-mark.doc gc-segment.doc gc-malloc.doc gc-card.doc \ guardians.doc hash.doc hashtab.doc hooks.doc init.doc ioext.doc \ iselect.doc keywords.doc lang.doc list.doc load.doc macros.doc \ mallocs.doc modules.doc numbers.doc objects.doc objprop.doc \ @@ -130,7 +131,8 @@ install-exec-hook: ## working. noinst_HEADERS = coop-threads.c coop-threads.h coop.c \ num2integral.i.c num2float.i.c convert.i.c \ - win32-uname.h win32-dirent.h win32-socket.h + win32-uname.h win32-dirent.h win32-socket.h\ + private-gc.h libguile_la_DEPENDENCIES = @LIBLOBJS@ libguile_la_LIBADD = @LIBLOBJS@ $(LIBLTDL) $(THREAD_LIBS_LOCAL) diff --git a/libguile/continuations.c b/libguile/continuations.c index 0cf76a32a..c44465bcc 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -270,7 +270,7 @@ scm_dynthrow (SCM cont, SCM val) grow_stack (cont, val); #else dst -= continuation->num_stack_items; - if (SCM_PTR_LE (dst, &stack_top_element)) + if (dst <= &stack_top_element) grow_stack (cont, val); #endif /* def SCM_STACK_GROWS_UP */ diff --git a/libguile/gc-card.c b/libguile/gc-card.c new file mode 100644 index 000000000..7daa6df4c --- /dev/null +++ b/libguile/gc-card.c @@ -0,0 +1,337 @@ +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + +#include "libguile/_scm.h" +#include "libguile/eval.h" +#include "libguile/stime.h" +#include "libguile/stackchk.h" +#include "libguile/struct.h" +#include "libguile/smob.h" +#include "libguile/unif.h" +#include "libguile/async.h" +#include "libguile/ports.h" +#include "libguile/root.h" +#include "libguile/strings.h" +#include "libguile/vectors.h" +#include "libguile/weaks.h" +#include "libguile/hashtab.h" +#include "libguile/tags.h" +#include "libguile/private-gc.h" +#include "libguile/validate.h" +#include "libguile/deprecation.h" +#include "libguile/gc.h" + + +#include "libguile/private-gc.h" + +long int scm_i_deprecated_memory_return; + + +/* + Init all the free cells in CARD, prepending to *FREE_LIST. + + Return: number of free cells found in this card. + + It would be cleaner to have a separate function sweep_value(), but + that is too slow (functions with switch statements can't be + inlined). + + */ + +int +scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) +#define FUNC_NAME "sweep_card" +{ + scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p); + scm_t_cell * end = p + SCM_GC_CARD_N_CELLS; + int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); + int free_count = 0; + + /* + I tried something fancy with shifting by one bit every word from + the bitvec in turn, but it wasn't any faster, but quite bit + hairier. + */ + for (p += offset; p < end; p += span, offset += span) + { + SCM scmptr = PTR2SCM(p); + if (SCM_C_BVEC_GET (bitvec, offset)) + continue; + + switch (SCM_TYP7 (scmptr)) + { + case scm_tcs_struct: + { + /* Structs need to be freed in a special order. + * This is handled by GC C hooks in struct.c. + */ + SCM_SET_STRUCT_GC_CHAIN (p, scm_structs_to_free); + scm_structs_to_free = scmptr; + } + continue; + + case scm_tcs_cons_imcar: + case scm_tcs_cons_nimcar: + case scm_tcs_closures: + case scm_tc7_pws: + break; + case scm_tc7_wvect: + case scm_tc7_vector: + { + unsigned long int length = SCM_VECTOR_LENGTH (scmptr); + if (length > 0) + { + scm_gc_free (SCM_VECTOR_BASE (scmptr), + length * sizeof (scm_t_bits), + "vector"); + } + break; + } +#ifdef CCLO + case scm_tc7_cclo: + scm_gc_free (SCM_CCLO_BASE (scmptr), + SCM_CCLO_LENGTH (scmptr) * sizeof (SCM), + "compiled closure"); + break; +#endif +#ifdef HAVE_ARRAYS + case scm_tc7_bvect: + { + unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr); + if (length > 0) + { + scm_gc_free (SCM_BITVECTOR_BASE (scmptr), + (sizeof (long) + * ((length+SCM_LONG_BIT-1) / SCM_LONG_BIT)), + "vector"); + } + } + break; + case scm_tc7_byvect: + case scm_tc7_ivect: + case scm_tc7_uvect: + case scm_tc7_svect: +#ifdef HAVE_LONG_LONGS + case scm_tc7_llvect: +#endif + case scm_tc7_fvect: + case scm_tc7_dvect: + case scm_tc7_cvect: + scm_gc_free (SCM_UVECTOR_BASE (scmptr), + (SCM_UVECTOR_LENGTH (scmptr) + * scm_uniform_element_size (scmptr)), + "vector"); + break; +#endif + case scm_tc7_string: + scm_gc_free (SCM_STRING_CHARS (scmptr), + SCM_STRING_LENGTH (scmptr) + 1, "string"); + break; + case scm_tc7_symbol: + scm_gc_free (SCM_SYMBOL_CHARS (scmptr), + SCM_SYMBOL_LENGTH (scmptr) + 1, "symbol"); + break; + case scm_tc7_variable: + break; + case scm_tcs_subrs: + /* the various "subrs" (primitives) are never freed */ + continue; + case scm_tc7_port: + if SCM_OPENP (scmptr) + { + int k = SCM_PTOBNUM (scmptr); + size_t mm; +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (!(k < scm_numptob)) + SCM_MISC_ERROR ("undefined port type", SCM_EOL); +#endif + /* Keep "revealed" ports alive. */ + if (scm_revealed_count (scmptr) > 0) + continue; + + /* Yes, I really do mean scm_ptobs[k].free */ + /* rather than ftobs[k].close. .close */ + /* is for explicit CLOSE-PORT by user */ + mm = scm_ptobs[k].free (scmptr); + + if (mm != 0) + { +#if SCM_ENABLE_DEPRECATED == 1 + scm_c_issue_deprecation_warning + ("Returning non-0 from a port free function is " + "deprecated. Use scm_gc_free et al instead."); + scm_c_issue_deprecation_warning_fmt + ("(You just returned non-0 while freeing a %s.)", + SCM_PTOBNAME (k)); + scm_i_deprecated_memory_return += mm; +#else + abort (); +#endif + } + + SCM_SETSTREAM (scmptr, 0); + scm_remove_from_port_table (scmptr); + scm_gc_ports_collected++; + SCM_CLR_PORT_OPEN_FLAG (scmptr); + } + break; + case scm_tc7_smob: + switch SCM_TYP16 (scmptr) + { + case scm_tc_free_cell: + case scm_tc16_real: + break; +#ifdef SCM_BIGDIG + case scm_tc16_big: + scm_gc_free (SCM_BDIGITS (scmptr), + ((SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG + / SCM_CHAR_BIT)), "bignum"); + break; +#endif /* def SCM_BIGDIG */ + case scm_tc16_complex: + scm_gc_free (SCM_COMPLEX_MEM (scmptr), 2*sizeof (double), + "complex"); + break; + default: + { + int k; + k = SCM_SMOBNUM (scmptr); +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (!(k < scm_numsmob)) + SCM_MISC_ERROR ("undefined smob type", SCM_EOL); +#endif + if (scm_smobs[k].free) + { + size_t mm; + mm = scm_smobs[k].free (scmptr); + if (mm != 0) + { +#if SCM_ENABLE_DEPRECATED == 1 + scm_c_issue_deprecation_warning + ("Returning non-0 from a smob free function is " + "deprecated. Use scm_gc_free et al instead."); + scm_c_issue_deprecation_warning_fmt + ("(You just returned non-0 while freeing a %s.)", + SCM_SMOBNAME (k)); + scm_i_deprecated_memory_return += mm; +#else + abort(); +#endif + } + } + break; + } + } + break; + default: + SCM_MISC_ERROR ("unknown type", SCM_EOL); + } + + + SCM_SET_CELL_TYPE (p, scm_tc_free_cell); + SCM_SET_FREE_CELL_CDR (p, PTR2SCM (*free_list)); + *free_list = PTR2SCM (p); + free_count ++; + } + return free_count; +} +#undef FUNC_NAME + + +/* + Like sweep, but no complicated logic to do the sweeping. + */ +int +scm_init_card_freelist (scm_t_cell * card, SCM *free_list, int span) +{ + scm_t_cell *end = card + SCM_GC_CARD_N_CELLS; + scm_t_cell *p = end - span; + + /* + ASSUMPTION: n_header_cells <= 2. + */ + for (; p > card; p -= span) + { + SCM_SET_CELL_TYPE (p, scm_tc_free_cell); + SCM_SET_FREE_CELL_CDR (p, PTR2SCM (*free_list)); + *free_list = PTR2SCM (p); + } + + return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS); +} + + +#if 0 +/* + These functions are meant to be called from GDB as a debug aid. + + I've left them as a convenience for future generations. + */ + + +int scm_gc_marked_p (SCM obj); +scm_t_cell * scm_gc_get_card (SCM obj); +long * scm_gc_get_bvec (SCM obj); + +typedef struct scm_t_list_cell_struct { + scm_t_bits car; + struct scm_t_list_cell_struct * cdr; +} scm_t_list_cell; + +int +scm_gc_marked_p (SCM obj) +{ + return SCM_GC_MARK_P(obj); +} + +scm_t_cell * +scm_gc_get_card (SCM obj) +{ + return SCM_GC_CELL_CARD(obj); +} + +long * +scm_gc_get_bvec (SCM obj) +{ + return SCM_GC_CARD_BVEC(SCM_GC_CELL_CARD(obj)); +} +#endif diff --git a/libguile/gc.c b/libguile/gc.c index fd7a0562e..0a4a1cfad 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -42,15 +42,11 @@ /* #define DEBUGINFO */ -/* SECTION: This code is compiled once. - */ -#ifndef MARK_DEPENDENCIES - - #include #include #include +#include #ifdef __ia64__ #include @@ -73,6 +69,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include "libguile/hashtab.h" #include "libguile/tags.h" +#include "libguile/private-gc.h" #include "libguile/validate.h" #include "libguile/deprecation.h" #include "libguile/gc.h" @@ -89,22 +86,10 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include #endif -#ifdef __STDC__ -#include -#define var_start(x, y) va_start(x, y) -#else -#include -#define var_start(x, y) va_start(x) -#endif - - -#define CELL_P(x) (SCM_ITAG3 (x) == scm_tc3_cons) unsigned int scm_gc_running_p = 0; - - #if (SCM_DEBUG_CELL_ACCESSES == 1) /* Set this to != 0 if every cell that is accessed shall be checked: @@ -125,55 +110,60 @@ static unsigned int debug_cells_gc_interval = 0; * find places in the C code where references are dropped for extremely short * periods. */ + void scm_assert_cell_valid (SCM cell) { static unsigned int already_running = 0; - if (scm_debug_cell_accesses_p && !already_running) + if (!already_running) { already_running = 1; /* set to avoid recursion */ - if (!scm_cellp (cell)) + /* + During GC, no user-code should be run, and the guile core should + use non-protected accessors. + */ + if (scm_gc_running_p) + abort(); + + /* + Only scm_in_heap_p is wildly expensive. + */ + if (scm_debug_cell_accesses_p) + if (!scm_in_heap_p (cell)) + { + fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n", + (unsigned long) SCM_UNPACK (cell)); + abort (); + } + + if (!SCM_GC_MARK_P (cell)) { - fprintf (stderr, "scm_assert_cell_valid: Not a cell object: %lux\n", + fprintf (stderr, + "scm_assert_cell_valid: this object is unmarked. \n" + "It has been garbage-collected in the last GC run: " + "%lux\n", (unsigned long) SCM_UNPACK (cell)); abort (); } - else if (!scm_gc_running_p) + + + /* If desired, perform additional garbage collections after a user + * defined number of cell accesses. + */ + if (scm_debug_cell_accesses_p && debug_cells_gc_interval) { - /* Dirk::FIXME:: During garbage collection there occur references to - free cells. This is allright during conservative marking, but - should not happen otherwise (I think). The case of free cells - accessed during conservative marking is handled in function - scm_mark_locations. However, there still occur accesses to free - cells during gc. I don't understand why this happens. If it is - a bug and gets fixed, the following test should also work while - gc is running. - */ - if (SCM_FREE_CELL_P (cell)) + static unsigned int counter = 0; + + if (counter != 0) { - fprintf (stderr, "scm_assert_cell_valid: Accessing free cell: %lux\n", - (unsigned long) SCM_UNPACK (cell)); - abort (); + --counter; } - - /* If desired, perform additional garbage collections after a user - * defined number of cell accesses. - */ - if (debug_cells_gc_interval) + else { - static unsigned int counter = 0; - - if (counter != 0) - { - --counter; - } - else - { - counter = debug_cells_gc_interval; - scm_igc ("scm_assert_cell_valid"); - } + counter = debug_cells_gc_interval; + scm_igc ("scm_assert_cell_valid"); } } already_running = 0; /* re-enable */ @@ -209,154 +199,34 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, return SCM_UNSPECIFIED; } #undef FUNC_NAME +#else + +/* + Provide a stub, so people can use their Scheme code on non-debug + versions of GUILE as well. + */ +SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, + (SCM flag), + "This function is used to turn on checking for a debug version of GUILE. This version does not support this functionality\n") +#define FUNC_NAME s_scm_set_debug_cell_accesses_x +{ + + /* + do nothing + */ + + scm_remember_upto_here (flag); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME #endif /* SCM_DEBUG_CELL_ACCESSES == 1 */ -/* {heap tuning parameters} - * - * These are parameters for controlling memory allocation. The heap - * is the area out of which scm_cons, and object headers are allocated. - * - * Each heap cell is 8 bytes on a 32 bit machine and 16 bytes on a - * 64 bit machine. The units of the _SIZE parameters are bytes. - * Cons pairs and object headers occupy one heap cell. - * - * SCM_INIT_HEAP_SIZE is the initial size of heap. If this much heap is - * allocated initially the heap will grow by half its current size - * each subsequent time more heap is needed. - * - * If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE - * will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more - * heap is needed. SCM_HEAP_SEG_SIZE must fit into type size_t. This code - * is in scm_init_storage() and alloc_some_heap() in sys.c - * - * If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by - * SCM_EXPHEAP(scm_heap_size) when more heap is needed. - * - * SCM_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap - * is needed. - * - * INIT_MALLOC_LIMIT is the initial amount of malloc usage which will - * trigger a GC. - * - * SCM_MTRIGGER_HYSTERESIS is the amount of malloc storage that must - * be reclaimed by a GC triggered by a malloc. If less than this is - * reclaimed, the trigger threshold is raised. [I don't know what a - * good value is. I arbitrarily chose 1/10 of the INIT_MALLOC_LIMIT to - * work around a oscillation that caused almost constant GC.] - */ +SCM scm_i_freelist = SCM_EOL; +SCM scm_i_freelist2 = SCM_EOL; -/* - * Heap size 45000 and 40% min yield gives quick startup and no extra - * heap allocation. Having higher values on min yield may lead to - * large heaps, especially if code behaviour is varying its - * maximum consumption between different freelists. - */ - -#define SCM_DATA_CELLS2CARDS(n) (((n) + SCM_GC_CARD_N_DATA_CELLS - 1) / SCM_GC_CARD_N_DATA_CELLS) -#define SCM_CARDS_PER_CLUSTER SCM_DATA_CELLS2CARDS (2000L) -#define SCM_CLUSTER_SIZE_1 (SCM_CARDS_PER_CLUSTER * SCM_GC_CARD_N_DATA_CELLS) -size_t scm_default_init_heap_size_1 = (((SCM_DATA_CELLS2CARDS (45000L) + SCM_CARDS_PER_CLUSTER - 1) - / SCM_CARDS_PER_CLUSTER) * SCM_GC_CARD_SIZE); -int scm_default_min_yield_1 = 40; - -#define SCM_CLUSTER_SIZE_2 (SCM_CARDS_PER_CLUSTER * (SCM_GC_CARD_N_DATA_CELLS / 2)) -size_t scm_default_init_heap_size_2 = (((SCM_DATA_CELLS2CARDS (2500L * 2) + SCM_CARDS_PER_CLUSTER - 1) - / SCM_CARDS_PER_CLUSTER) * SCM_GC_CARD_SIZE); -/* The following value may seem large, but note that if we get to GC at - * all, this means that we have a numerically intensive application - */ -int scm_default_min_yield_2 = 40; - -size_t scm_default_max_segment_size = 2097000L;/* a little less (adm) than 2 Mb */ - -#define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_CARD_SIZE) -#ifdef _QC -# define SCM_HEAP_SEG_SIZE 32768L -#else -# ifdef sequent -# define SCM_HEAP_SEG_SIZE (7000L * sizeof (scm_t_cell)) -# else -# define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell)) -# endif -#endif -/* Make heap grow with factor 1.5 */ -#define SCM_EXPHEAP(scm_heap_size) (scm_heap_size / 2) -#define SCM_INIT_MALLOC_LIMIT 100000 -#define SCM_MTRIGGER_HYSTERESIS (SCM_INIT_MALLOC_LIMIT/10) - -/* CELL_UP and CELL_DN are used by scm_init_heap_seg to find (scm_t_cell * span) - aligned inner bounds for allocated storage */ - -#ifdef PROT386 -/*in 386 protected mode we must only adjust the offset */ -# define CELL_UP(p, span) MK_FP(FP_SEG(p), ~(8*(span)-1)&(FP_OFF(p)+8*(span)-1)) -# define CELL_DN(p, span) MK_FP(FP_SEG(p), ~(8*(span)-1)&FP_OFF(p)) -#else -# ifdef _UNICOS -# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((long)(p)+(span))) -# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (long)(p)) -# else -# define CELL_UP(p, span) (SCM_CELLPTR)(~(sizeof(scm_t_cell)*(span)-1L) & ((long)(p)+sizeof(scm_t_cell)*(span)-1L)) -# define CELL_DN(p, span) (SCM_CELLPTR)(~(sizeof(scm_t_cell)*(span)-1L) & (long)(p)) -# endif /* UNICOS */ -#endif /* PROT386 */ - -#define DOUBLECELL_ALIGNED_P(x) (((2 * sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0) - -#define ALIGNMENT_SLACK(freelist) (SCM_GC_CARD_SIZE - 1) -#define CLUSTER_SIZE_IN_BYTES(freelist) \ - (((freelist)->cluster_size / (SCM_GC_CARD_N_DATA_CELLS / (freelist)->span)) * SCM_GC_CARD_SIZE) - - -/* scm_freelists - */ - -typedef struct scm_t_freelist { - /* collected cells */ - SCM cells; - /* number of cells left to collect before cluster is full */ - unsigned int left_to_collect; - /* number of clusters which have been allocated */ - unsigned int clusters_allocated; - /* a list of freelists, each of size cluster_size, - * except the last one which may be shorter - */ - SCM clusters; - SCM *clustertail; - /* this is the number of objects in each cluster, including the spine cell */ - unsigned int cluster_size; - /* indicates that we should grow heap instead of GC:ing - */ - int grow_heap_p; - /* minimum yield on this list in order not to grow the heap - */ - long min_yield; - /* defines min_yield as percent of total heap size - */ - int min_yield_fraction; - /* number of cells per object on this list */ - int span; - /* number of collected cells during last GC */ - unsigned long collected; - /* number of collected cells during penultimate GC */ - unsigned long collected_1; - /* total number of cells in heap segments - * belonging to this list. - */ - unsigned long heap_size; -} scm_t_freelist; - -SCM scm_freelist = SCM_EOL; -scm_t_freelist scm_master_freelist = { - SCM_EOL, 0, 0, SCM_EOL, 0, SCM_CLUSTER_SIZE_1, 0, 0, 0, 1, 0, 0, 0 -}; -SCM scm_freelist2 = SCM_EOL; -scm_t_freelist scm_master_freelist2 = { - SCM_EOL, 0, 0, SCM_EOL, 0, SCM_CLUSTER_SIZE_2, 0, 0, 0, 2, 0, 0, 0 -}; /* scm_mtrigger * is the number of bytes of malloc allocation needed to trigger gc. @@ -389,15 +259,13 @@ SCM scm_structs_to_free; unsigned long scm_cells_allocated = 0; unsigned long scm_mallocated = 0; unsigned long scm_gc_cells_collected; -unsigned long scm_gc_yield; -static unsigned long scm_gc_yield_1 = 0; /* previous GC yield */ +unsigned long scm_gc_cells_collected_1 = 0; /* previous GC yield */ unsigned long scm_gc_malloc_collected; unsigned long scm_gc_ports_collected; unsigned long scm_gc_time_taken = 0; static unsigned long t_before_gc; static unsigned long t_before_sweep; unsigned long scm_gc_mark_time_taken = 0; -unsigned long scm_gc_sweep_time_taken = 0; unsigned long scm_gc_times = 0; unsigned long scm_gc_cells_swept = 0; double scm_gc_cells_marked_acc = 0.; @@ -410,321 +278,17 @@ SCM_SYMBOL (sym_mtrigger, "gc-malloc-threshold"); SCM_SYMBOL (sym_heap_segments, "cell-heap-segments"); SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken"); SCM_SYMBOL (sym_gc_mark_time_taken, "gc-mark-time-taken"); -SCM_SYMBOL (sym_gc_sweep_time_taken, "gc-sweep-time-taken"); SCM_SYMBOL (sym_times, "gc-times"); SCM_SYMBOL (sym_cells_marked, "cells-marked"); SCM_SYMBOL (sym_cells_swept, "cells-swept"); -typedef struct scm_t_heap_seg_data -{ - /* lower and upper bounds of the segment */ - SCM_CELLPTR bounds[2]; - - /* address of the head-of-freelist pointer for this segment's cells. - All segments usually point to the same one, scm_freelist. */ - scm_t_freelist *freelist; - - /* number of cells per object in this segment */ - int span; -} scm_t_heap_seg_data; -static size_t init_heap_seg (SCM_CELLPTR, size_t, scm_t_freelist *); - -typedef enum { return_on_error, abort_on_error } policy_on_error; -static void alloc_some_heap (scm_t_freelist *, policy_on_error); - - -#define SCM_HEAP_SIZE \ - (scm_master_freelist.heap_size + scm_master_freelist2.heap_size) -#define SCM_MAX(A, B) ((A) > (B) ? (A) : (B)) - -#define BVEC_GROW_SIZE 256 -#define BVEC_GROW_SIZE_IN_LIMBS (SCM_GC_CARD_BVEC_SIZE_IN_LIMBS * BVEC_GROW_SIZE) -#define BVEC_GROW_SIZE_IN_BYTES (BVEC_GROW_SIZE_IN_LIMBS * sizeof (scm_t_c_bvec_limb)) - -/* mark space allocation */ - -typedef struct scm_t_mark_space -{ - scm_t_c_bvec_limb *bvec_space; - struct scm_t_mark_space *next; -} scm_t_mark_space; - -static scm_t_mark_space *current_mark_space; -static scm_t_mark_space **mark_space_ptr; -static ptrdiff_t current_mark_space_offset; -static scm_t_mark_space *mark_space_head; - -static scm_t_c_bvec_limb * -get_bvec () -#define FUNC_NAME "get_bvec" -{ - scm_t_c_bvec_limb *res; - - if (!current_mark_space) - { - SCM_SYSCALL (current_mark_space = (scm_t_mark_space *) malloc (sizeof (scm_t_mark_space))); - if (!current_mark_space) - SCM_MISC_ERROR ("could not grow heap", SCM_EOL); - - current_mark_space->bvec_space = NULL; - current_mark_space->next = NULL; - - *mark_space_ptr = current_mark_space; - mark_space_ptr = &(current_mark_space->next); - - return get_bvec (); - } - - if (!(current_mark_space->bvec_space)) - { - SCM_SYSCALL (current_mark_space->bvec_space = - (scm_t_c_bvec_limb *) calloc (BVEC_GROW_SIZE_IN_BYTES, 1)); - if (!(current_mark_space->bvec_space)) - SCM_MISC_ERROR ("could not grow heap", SCM_EOL); - - current_mark_space_offset = 0; - - return get_bvec (); - } - - if (current_mark_space_offset == BVEC_GROW_SIZE_IN_LIMBS) - { - current_mark_space = NULL; - - return get_bvec (); - } - - res = current_mark_space->bvec_space + current_mark_space_offset; - current_mark_space_offset += SCM_GC_CARD_BVEC_SIZE_IN_LIMBS; - - return res; -} -#undef FUNC_NAME - - -static void -clear_mark_space () -{ - scm_t_mark_space *ms; - - for (ms = mark_space_head; ms; ms = ms->next) - memset (ms->bvec_space, 0, BVEC_GROW_SIZE_IN_BYTES); -} - - - -/* Debugging functions. */ - -#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST) - -static long int heap_segment (SCM obj); /* forw decl: non-debugging func */ - -static void -map_free_list (scm_t_freelist *master, SCM freelist) -{ - long last_seg = -1, count = 0; - SCM f; - - for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f)) - { - long int this_seg = heap_segment (f); - - if (this_seg == -1) - { - fprintf (stderr, - "map_free_list: can't find segment containing cell %lux\n", - (unsigned long int) SCM_UNPACK (f)); - abort (); - } - else if (this_seg != last_seg) - { - if (last_seg != -1) - fprintf (stderr, " %5ld %d-cells in segment %ld\n", - (long) count, master->span, (long) last_seg); - last_seg = this_seg; - count = 0; - } - count++; - } - if (last_seg != -1) - fprintf (stderr, " %5ld %d-cells in segment %ld\n", - (long) count, master->span, (long) last_seg); -} - -SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0, - (), - "Print debugging information about the free-list.\n" - "@code{map-free-list} is only included in\n" - "@code{--enable-guile-debug} builds of Guile.") -#define FUNC_NAME s_scm_map_free_list -{ - size_t i; - - fprintf (stderr, "%ld segments total (%d:%ld", - (long) scm_n_heap_segs, - scm_heap_table[0].span, - (long) (scm_heap_table[0].bounds[1] - scm_heap_table[0].bounds[0])); - - for (i = 1; i != scm_n_heap_segs; i++) - fprintf (stderr, ", %d:%ld", - scm_heap_table[i].span, - (long) (scm_heap_table[i].bounds[1] - scm_heap_table[i].bounds[0])); - fprintf (stderr, ")\n"); - map_free_list (&scm_master_freelist, scm_freelist); - map_free_list (&scm_master_freelist2, scm_freelist2); - fflush (stderr); - - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -static long last_cluster; -static long last_size; - -static long -free_list_length (char *title, long i, SCM freelist) -{ - SCM ls; - long n = 0; - for (ls = freelist; !SCM_NULLP (ls); ls = SCM_FREE_CELL_CDR (ls)) - if (SCM_FREE_CELL_P (ls)) - ++n; - else - { - fprintf (stderr, "bad cell in %s at position %ld\n", title, (long) n); - abort (); - } - if (n != last_size) - { - if (i > 0) - { - if (last_cluster == i - 1) - fprintf (stderr, "\t%ld\n", (long) last_size); - else - fprintf (stderr, "-%ld\t%ld\n", (long) (i - 1), (long) last_size); - } - if (i >= 0) - fprintf (stderr, "%s %ld", title, (long) i); - else - fprintf (stderr, "%s\t%ld\n", title, (long) n); - last_cluster = i; - last_size = n; - } - return n; -} - -static void -free_list_lengths (char *title, scm_t_freelist *master, SCM freelist) -{ - SCM clusters; - long i = 0, len, n = 0; - fprintf (stderr, "%s\n\n", title); - n += free_list_length ("free list", -1, freelist); - for (clusters = master->clusters; - SCM_NNULLP (clusters); - clusters = SCM_CDR (clusters)) - { - len = free_list_length ("cluster", i++, SCM_CAR (clusters)); - n += len; - } - if (last_cluster == i - 1) - fprintf (stderr, "\t%ld\n", (long) last_size); - else - fprintf (stderr, "-%ld\t%ld\n", (long) (i - 1), (long) last_size); - fprintf (stderr, "\ntotal %ld objects\n\n", (long) n); -} - -SCM_DEFINE (scm_free_list_length, "free-list-length", 0, 0, 0, - (), - "Print debugging information about the free-list.\n" - "@code{free-list-length} is only included in\n" - "@code{--enable-guile-debug} builds of Guile.") -#define FUNC_NAME s_scm_free_list_length -{ - free_list_lengths ("1-cells", &scm_master_freelist, scm_freelist); - free_list_lengths ("2-cells", &scm_master_freelist2, scm_freelist2); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -#endif /* defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST) */ - -#ifdef GUILE_DEBUG_FREELIST - -/* Non-zero if freelist debugging is in effect. Set this via - `gc-set-debug-check-freelist!'. */ -static int scm_debug_check_freelist = 0; - /* Number of calls to SCM_NEWCELL since startup. */ -static unsigned long scm_newcell_count; -static unsigned long scm_newcell2_count; +unsigned scm_newcell_count; +unsigned scm_newcell2_count; -/* Search freelist for anything that isn't marked as a free cell. - Abort if we find something. */ -static void -scm_check_freelist (SCM freelist) -{ - SCM f; - long i = 0; - - for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f), i++) - if (!SCM_FREE_CELL_P (f)) - { - fprintf (stderr, "Bad cell in freelist on newcell %lu: %lu'th elt\n", - (long) scm_newcell_count, (long) i); - abort (); - } -} - -SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1, 0, 0, - (SCM flag), - "If @var{flag} is @code{#t}, check the freelist for consistency\n" - "on each cell allocation. This procedure only exists when the\n" - "@code{GUILE_DEBUG_FREELIST} compile-time flag was selected.") -#define FUNC_NAME s_scm_gc_set_debug_check_freelist_x -{ - /* [cmm] I did a double-take when I read this code the first time. - well, FWIW. */ - SCM_VALIDATE_BOOL_COPY (1, flag, scm_debug_check_freelist); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -#endif /* GUILE_DEBUG_FREELIST */ - - - -static unsigned long -master_cells_allocated (scm_t_freelist *master) -{ - /* the '- 1' below is to ignore the cluster spine cells. */ - long objects = master->clusters_allocated * (master->cluster_size - 1); - if (SCM_NULLP (master->clusters)) - objects -= master->left_to_collect; - return master->span * objects; -} - -static unsigned long -freelist_length (SCM freelist) -{ - long n; - for (n = 0; !SCM_NULLP (freelist); freelist = SCM_FREE_CELL_CDR (freelist)) - ++n; - return n; -} - -static unsigned long -compute_cells_allocated () -{ - return (scm_cells_allocated - + master_cells_allocated (&scm_master_freelist) - + master_cells_allocated (&scm_master_freelist2) - - scm_master_freelist.span * freelist_length (scm_freelist) - - scm_master_freelist2.span * freelist_length (scm_freelist2)); -} /* {Scheme Interface to GC} */ @@ -732,12 +296,11 @@ compute_cells_allocated () SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, (), "Return an association list of statistics about Guile's current\n" - "use of storage.") + "use of storage.\n") #define FUNC_NAME s_scm_gc_stats { - long i; - long n; - SCM heap_segs; + long i = 0; + SCM heap_segs = SCM_EOL ; unsigned long int local_scm_mtrigger; unsigned long int local_scm_mallocated; unsigned long int local_scm_heap_size; @@ -745,26 +308,26 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, unsigned long int local_scm_gc_time_taken; unsigned long int local_scm_gc_times; unsigned long int local_scm_gc_mark_time_taken; - unsigned long int local_scm_gc_sweep_time_taken; double local_scm_gc_cells_swept; double local_scm_gc_cells_marked; SCM answer; - + unsigned long *bounds = 0; + int table_size = scm_i_heap_segment_table_size; SCM_DEFER_INTS; - ++scm_block_gc; + /* + temporarily store the numbers, so as not to cause GC. + */ + + bounds = malloc (sizeof (int) * table_size * 2); + if (!bounds) + abort(); + for (i = table_size; i--; ) + { + bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0]; + bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1]; + } - retry: - heap_segs = SCM_EOL; - n = scm_n_heap_segs; - for (i = scm_n_heap_segs; i--; ) - heap_segs = scm_cons (scm_cons (scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[1]), - scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[0])), - heap_segs); - if (scm_n_heap_segs != n) - goto retry; - - --scm_block_gc; /* Below, we cons to produce the resulting list. We want a snapshot of * the heap situation before consing. @@ -772,14 +335,27 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, local_scm_mtrigger = scm_mtrigger; local_scm_mallocated = scm_mallocated; local_scm_heap_size = SCM_HEAP_SIZE; - local_scm_cells_allocated = compute_cells_allocated (); + + local_scm_cells_allocated = scm_cells_allocated; + local_scm_gc_time_taken = scm_gc_time_taken; local_scm_gc_mark_time_taken = scm_gc_mark_time_taken; - local_scm_gc_sweep_time_taken = scm_gc_sweep_time_taken; local_scm_gc_times = scm_gc_times; - local_scm_gc_cells_swept = scm_gc_cells_swept_acc; - local_scm_gc_cells_marked = scm_gc_cells_marked_acc; + + local_scm_gc_cells_swept = scm_gc_cells_swept_acc + scm_gc_cells_swept; + local_scm_gc_cells_marked = scm_gc_cells_marked_acc + +(double) scm_gc_cells_swept + -(double) scm_gc_cells_collected; + + + for (i = table_size; i--;) + { + heap_segs = scm_cons (scm_cons (scm_ulong2num (bounds[2*i]), + scm_ulong2num (bounds[2*i+1])), + heap_segs); + } + answer = scm_list_n (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)), scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)), scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)), @@ -787,42 +363,46 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)), scm_cons (sym_times, scm_ulong2num (local_scm_gc_times)), scm_cons (sym_gc_mark_time_taken, scm_ulong2num (local_scm_gc_mark_time_taken)), - scm_cons (sym_gc_sweep_time_taken, scm_ulong2num (local_scm_gc_sweep_time_taken)), scm_cons (sym_cells_marked, scm_i_dbl2big (local_scm_gc_cells_marked)), scm_cons (sym_cells_swept, scm_i_dbl2big (local_scm_gc_cells_swept)), scm_cons (sym_heap_segments, heap_segs), SCM_UNDEFINED); SCM_ALLOW_INTS; + + free (bounds); return answer; } #undef FUNC_NAME - static void gc_start_stats (const char *what SCM_UNUSED) { t_before_gc = scm_c_get_internal_run_time (); + + scm_gc_cells_marked_acc += (double) scm_gc_cells_swept + - (double) scm_gc_cells_collected; + scm_gc_cells_swept_acc += scm_gc_cells_swept; + scm_gc_cells_swept = 0; + scm_gc_cells_collected_1 = scm_gc_cells_collected; + + /* + CELLS SWEPT is another word for the number of cells that were + examined during GC. YIELD is the number that we cleaned + out. MARKED is the number that weren't cleaned. + */ scm_gc_cells_collected = 0; - scm_gc_yield_1 = scm_gc_yield; - scm_gc_yield = (scm_cells_allocated - + master_cells_allocated (&scm_master_freelist) - + master_cells_allocated (&scm_master_freelist2)); scm_gc_malloc_collected = 0; scm_gc_ports_collected = 0; } - static void gc_end_stats () { unsigned long t = scm_c_get_internal_run_time (); scm_gc_time_taken += (t - t_before_gc); - scm_gc_sweep_time_taken += (t - t_before_sweep); - ++scm_gc_times; - scm_gc_cells_marked_acc += scm_gc_cells_swept - scm_gc_cells_collected; - scm_gc_cells_swept_acc += scm_gc_cells_swept; + ++scm_gc_times; } @@ -852,155 +432,84 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0, -/* {C Interface For When GC is Triggered} - */ - -static void -adjust_min_yield (scm_t_freelist *freelist) -{ - /* min yield is adjusted upwards so that next predicted total yield - * (allocated cells actually freed by GC) becomes - * `min_yield_fraction' of total heap size. Note, however, that - * the absolute value of min_yield will correspond to `collected' - * on one master (the one which currently is triggering GC). - * - * The reason why we look at total yield instead of cells collected - * on one list is that we want to take other freelists into account. - * On this freelist, we know that (local) yield = collected cells, - * but that's probably not the case on the other lists. - * - * (We might consider computing a better prediction, for example - * by computing an average over multiple GC:s.) - */ - if (freelist->min_yield_fraction) - { - /* Pick largest of last two yields. */ - long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100) - - (long) SCM_MAX (scm_gc_yield_1, scm_gc_yield)); -#ifdef DEBUGINFO - fprintf (stderr, " after GC = %lu, delta = %ld\n", - (long) scm_cells_allocated, - (long) delta); -#endif - if (delta > 0) - freelist->min_yield += delta; - } -} - /* When we get POSIX threads support, the master will be global and * common while the freelist will be individual for each thread. */ SCM -scm_gc_for_newcell (scm_t_freelist *master, SCM *freelist) +scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells) { SCM cell; + ++scm_ints_disabled; - do - { - if (SCM_NULLP (master->clusters)) - { - if (master->grow_heap_p || scm_block_gc) - { - /* In order to reduce gc frequency, try to allocate a new heap - * segment first, even if gc might find some free cells. If we - * can't obtain a new heap segment, we will try gc later. - */ - master->grow_heap_p = 0; - alloc_some_heap (master, return_on_error); - } - if (SCM_NULLP (master->clusters)) - { - /* The heap was not grown, either because it wasn't scheduled to - * grow, or because there was not enough memory available. In - * both cases we have to try gc to get some free cells. - */ -#ifdef DEBUGINFO - fprintf (stderr, "allocated = %lu, ", - (long) (scm_cells_allocated - + master_cells_allocated (&scm_master_freelist) - + master_cells_allocated (&scm_master_freelist2))); -#endif - scm_igc ("cells"); - adjust_min_yield (master); - if (SCM_NULLP (master->clusters)) - { - /* gc could not free any cells. Now, we _must_ allocate a - * new heap segment, because there is no other possibility - * to provide a new cell for the caller. - */ - alloc_some_heap (master, abort_on_error); - } - } - } - cell = SCM_CAR (master->clusters); - master->clusters = SCM_CDR (master->clusters); - ++master->clusters_allocated; - } - while (SCM_NULLP (cell)); -#ifdef GUILE_DEBUG_FREELIST - scm_check_freelist (cell); -#endif + *free_cells = scm_i_sweep_some_segments (freelist); + if (*free_cells == SCM_EOL && scm_i_gc_grow_heap_p (freelist)) + { + freelist->heap_segment_idx = scm_i_get_new_heap_segment (freelist, abort_on_error); + *free_cells = scm_i_sweep_some_segments (freelist); + } + + if (*free_cells == SCM_EOL && !scm_block_gc) + { + /* + with the advent of lazy sweep, GC yield is only know just + before doing the GC. + */ + scm_i_adjust_min_yield (freelist); + + /* + out of fresh cells. Try to get some new ones. + */ + + scm_igc ("cells"); + + *free_cells = scm_i_sweep_some_segments (freelist); + } + + if (*free_cells == SCM_EOL) + { + /* + failed getting new cells. Get new juice or die. + */ + freelist->heap_segment_idx = scm_i_get_new_heap_segment (freelist, abort_on_error); + *free_cells = scm_i_sweep_some_segments (freelist); + } + + if (*free_cells == SCM_EOL) + abort (); + + cell = *free_cells; --scm_ints_disabled; - *freelist = SCM_FREE_CELL_CDR (cell); + + *free_cells = SCM_FREE_CELL_CDR (cell); return cell; } -#if 0 -/* This is a support routine which can be used to reserve a cluster - * for some special use, such as debugging. It won't be useful until - * free cells are preserved between garbage collections. - */ - -void -scm_alloc_cluster (scm_t_freelist *master) -{ - SCM freelist, cell; - cell = scm_gc_for_newcell (master, &freelist); - SCM_SETCDR (cell, freelist); - return cell; -} -#endif - - scm_t_c_hook scm_before_gc_c_hook; scm_t_c_hook scm_before_mark_c_hook; scm_t_c_hook scm_before_sweep_c_hook; scm_t_c_hook scm_after_sweep_c_hook; scm_t_c_hook scm_after_gc_c_hook; -#ifdef __ia64__ -# define SCM_MARK_BACKING_STORE() do { \ - ucontext_t ctx; \ - SCM_STACKITEM * top, * bot; \ - getcontext (&ctx); \ - scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \ - ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \ - / sizeof (SCM_STACKITEM))); \ - bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \ - top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \ - scm_mark_locations (bot, top - bot); } while (0) -#else -# define SCM_MARK_BACKING_STORE() -#endif - void scm_igc (const char *what) { - long j; - ++scm_gc_running_p; scm_c_hook_run (&scm_before_gc_c_hook, 0); + #ifdef DEBUGINFO + fprintf (stderr,"gc reason %s\n", what); + fprintf (stderr, - SCM_NULLP (scm_freelist) + SCM_NULLP (scm_i_freelist) ? "*" - : (SCM_NULLP (scm_freelist2) ? "o" : "m")); + : (SCM_NULLP (scm_i_freelist2) ? "o" : "m")); #endif + /* During the critical section, only the current thread may run. */ SCM_CRITICAL_SECTION_START; @@ -1019,828 +528,12 @@ scm_igc (const char *what) ++scm_gc_heap_lock; - scm_c_hook_run (&scm_before_mark_c_hook, 0); - - clear_mark_space (); - -#ifndef USE_THREADS - - /* Mark objects on the C stack. */ - SCM_FLUSH_REGISTER_WINDOWS; - /* This assumes that all registers are saved into the jmp_buf */ - setjmp (scm_save_regs_gc_mark); - scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, - ( (size_t) (sizeof (SCM_STACKITEM) - 1 + - sizeof scm_save_regs_gc_mark) - / sizeof (SCM_STACKITEM))); - - { - unsigned long stack_len = scm_stack_size (scm_stack_base); -#ifdef SCM_STACK_GROWS_UP - scm_mark_locations (scm_stack_base, stack_len); -#else - scm_mark_locations (scm_stack_base - stack_len, stack_len); -#endif - } - SCM_MARK_BACKING_STORE(); - -#else /* USE_THREADS */ - - /* Mark every thread's stack and registers */ - scm_threads_mark_stacks (); - -#endif /* USE_THREADS */ - - j = SCM_NUM_PROTECTS; - while (j--) - scm_gc_mark (scm_sys_protects[j]); - - /* mark the registered roots */ - { - size_t i; - for (i = 0; i < SCM_VECTOR_LENGTH (scm_gc_registered_roots); ++i) { - SCM l = SCM_VELTS (scm_gc_registered_roots)[i]; - for (; !SCM_NULLP (l); l = SCM_CDR (l)) { - SCM *p = (SCM *) (scm_num2long (SCM_CAAR (l), 0, NULL)); - scm_gc_mark (*p); - } - } - } - - /* FIXME: we should have a means to register C functions to be run - * in different phases of GC + /* + Let's finish the sweep. The conservative GC might point into the + garbage, and marking that would create a mess. */ - scm_mark_subr_table (); - -#ifndef USE_THREADS - scm_gc_mark (scm_root->handle); -#endif - - t_before_sweep = scm_c_get_internal_run_time (); - scm_gc_mark_time_taken += (t_before_sweep - t_before_gc); - - scm_c_hook_run (&scm_before_sweep_c_hook, 0); - - scm_gc_sweep (); - - scm_c_hook_run (&scm_after_sweep_c_hook, 0); - - --scm_gc_heap_lock; - gc_end_stats (); - - SCM_CRITICAL_SECTION_END; - scm_c_hook_run (&scm_after_gc_c_hook, 0); - --scm_gc_running_p; -} - - - -/* {Mark/Sweep} - */ - -#define MARK scm_gc_mark -#define FNAME "scm_gc_mark" - -#endif /*!MARK_DEPENDENCIES*/ - -/* Mark an object precisely. - */ -void -MARK (SCM p) -#define FUNC_NAME FNAME -{ - register long i; - register SCM ptr; - scm_t_bits cell_type; - -#ifndef MARK_DEPENDENCIES -# define RECURSE scm_gc_mark -#else - /* go through the usual marking, but not for self-cycles. */ -# define RECURSE(x) do { if ((x) != p) scm_gc_mark (x); } while (0) -#endif - ptr = p; - -#ifdef MARK_DEPENDENCIES - goto gc_mark_loop_first_time; -#endif - -/* A simple hack for debugging. Chose the second branch to get a - meaningful backtrace for crashes inside the GC. -*/ -#if 1 -#define goto_gc_mark_loop goto gc_mark_loop -#define goto_gc_mark_nimp goto gc_mark_nimp -#else -#define goto_gc_mark_loop RECURSE(ptr); return -#define goto_gc_mark_nimp RECURSE(ptr); return -#endif - -gc_mark_loop: - if (SCM_IMP (ptr)) - return; - -gc_mark_nimp: - -#ifdef MARK_DEPENDENCIES - if (SCM_EQ_P (ptr, p)) - return; - - scm_gc_mark (ptr); - return; - -gc_mark_loop_first_time: -#endif - -#if (SCM_DEBUG_CELL_ACCESSES == 1) || (defined (GUILE_DEBUG_FREELIST)) - /* We are in debug mode. Check the ptr exhaustively. */ - if (!scm_cellp (ptr)) - SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL); -#else - /* In non-debug mode, do at least some cheap testing. */ - if (!CELL_P (ptr)) - SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL); -#endif - -#ifndef MARK_DEPENDENCIES - - if (SCM_GCMARKP (ptr)) - return; - - SCM_SETGCMARK (ptr); - -#endif - - cell_type = SCM_GC_CELL_TYPE (ptr); - switch (SCM_ITAG7 (cell_type)) - { - case scm_tcs_cons_nimcar: - if (SCM_IMP (SCM_CDR (ptr))) - { - ptr = SCM_CAR (ptr); - goto_gc_mark_nimp; - } - RECURSE (SCM_CAR (ptr)); - ptr = SCM_CDR (ptr); - goto_gc_mark_nimp; - case scm_tcs_cons_imcar: - ptr = SCM_CDR (ptr); - goto_gc_mark_loop; - case scm_tc7_pws: - RECURSE (SCM_SETTER (ptr)); - ptr = SCM_PROCEDURE (ptr); - goto_gc_mark_loop; - case scm_tcs_struct: - { - /* XXX - use less explicit code. */ - scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_struct; - scm_t_bits * vtable_data = (scm_t_bits *) word0; - SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]); - long len = SCM_SYMBOL_LENGTH (layout); - char * fields_desc = SCM_SYMBOL_CHARS (layout); - scm_t_bits * struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr); - - if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) - { - RECURSE (SCM_PACK (struct_data[scm_struct_i_procedure])); - RECURSE (SCM_PACK (struct_data[scm_struct_i_setter])); - } - if (len) - { - long x; - - for (x = 0; x < len - 2; x += 2, ++struct_data) - if (fields_desc[x] == 'p') - RECURSE (SCM_PACK (*struct_data)); - if (fields_desc[x] == 'p') - { - if (SCM_LAYOUT_TAILP (fields_desc[x + 1])) - for (x = *struct_data++; x; --x, ++struct_data) - RECURSE (SCM_PACK (*struct_data)); - else - RECURSE (SCM_PACK (*struct_data)); - } - } - /* mark vtable */ - ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]); - goto_gc_mark_loop; - } - break; - case scm_tcs_closures: - if (SCM_IMP (SCM_ENV (ptr))) - { - ptr = SCM_CLOSCAR (ptr); - goto_gc_mark_nimp; - } - RECURSE (SCM_CLOSCAR (ptr)); - ptr = SCM_ENV (ptr); - goto_gc_mark_nimp; - case scm_tc7_vector: - i = SCM_VECTOR_LENGTH (ptr); - if (i == 0) - break; - while (--i > 0) - if (SCM_NIMP (SCM_VELTS (ptr)[i])) - RECURSE (SCM_VELTS (ptr)[i]); - ptr = SCM_VELTS (ptr)[0]; - goto_gc_mark_loop; -#ifdef CCLO - case scm_tc7_cclo: - { - size_t i = SCM_CCLO_LENGTH (ptr); - size_t j; - for (j = 1; j != i; ++j) - { - SCM obj = SCM_CCLO_REF (ptr, j); - if (!SCM_IMP (obj)) - RECURSE (obj); - } - ptr = SCM_CCLO_REF (ptr, 0); - goto_gc_mark_loop; - } -#endif -#ifdef HAVE_ARRAYS - case scm_tc7_bvect: - case scm_tc7_byvect: - case scm_tc7_ivect: - case scm_tc7_uvect: - case scm_tc7_fvect: - case scm_tc7_dvect: - case scm_tc7_cvect: - case scm_tc7_svect: -#ifdef HAVE_LONG_LONGS - case scm_tc7_llvect: -#endif -#endif - case scm_tc7_string: - break; - - case scm_tc7_wvect: - SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors); - scm_weak_vectors = ptr; - if (SCM_IS_WHVEC_ANY (ptr)) - { - long x; - long len; - int weak_keys; - int weak_values; - - len = SCM_VECTOR_LENGTH (ptr); - weak_keys = SCM_IS_WHVEC (ptr) || SCM_IS_WHVEC_B (ptr); - weak_values = SCM_IS_WHVEC_V (ptr) || SCM_IS_WHVEC_B (ptr); - - for (x = 0; x < len; ++x) - { - SCM alist; - alist = SCM_VELTS (ptr)[x]; - - /* mark everything on the alist except the keys or - * values, according to weak_values and weak_keys. */ - while ( SCM_CONSP (alist) - && !SCM_GCMARKP (alist) - && SCM_CONSP (SCM_CAR (alist))) - { - SCM kvpair; - SCM next_alist; - - kvpair = SCM_CAR (alist); - next_alist = SCM_CDR (alist); - /* - * Do not do this: - * SCM_SETGCMARK (alist); - * SCM_SETGCMARK (kvpair); - * - * It may be that either the key or value is protected by - * an escaped reference to part of the spine of this alist. - * If we mark the spine here, and only mark one or neither of the - * key and value, they may never be properly marked. - * This leads to a horrible situation in which an alist containing - * freelist cells is exported. - * - * So only mark the spines of these arrays last of all marking. - * If somebody confuses us by constructing a weak vector - * with a circular alist then we are hosed, but at least we - * won't prematurely drop table entries. - */ - if (!weak_keys) - RECURSE (SCM_CAR (kvpair)); - if (!weak_values) - RECURSE (SCM_CDR (kvpair)); - alist = next_alist; - } - if (SCM_NIMP (alist)) - RECURSE (alist); - } - } - break; - - case scm_tc7_symbol: - ptr = SCM_PROP_SLOTS (ptr); - goto_gc_mark_loop; - case scm_tc7_variable: - ptr = SCM_CELL_OBJECT_1 (ptr); - goto_gc_mark_loop; - case scm_tcs_subrs: - break; - case scm_tc7_port: - i = SCM_PTOBNUM (ptr); -#if (SCM_DEBUG_CELL_ACCESSES == 1) || (defined (GUILE_DEBUG_FREELIST)) - if (!(i < scm_numptob)) - SCM_MISC_ERROR ("undefined port type", SCM_EOL); -#endif - if (SCM_PTAB_ENTRY(ptr)) - RECURSE (SCM_FILENAME (ptr)); - if (scm_ptobs[i].mark) - { - ptr = (scm_ptobs[i].mark) (ptr); - goto_gc_mark_loop; - } - else - return; - break; - case scm_tc7_smob: - switch (SCM_TYP16 (ptr)) - { /* should be faster than going through scm_smobs */ - case scm_tc_free_cell: - /* We have detected a free cell. This can happen if non-object data - * on the C stack points into guile's heap and is scanned during - * conservative marking. */ - break; - case scm_tc16_big: - case scm_tc16_real: - case scm_tc16_complex: - break; - default: - i = SCM_SMOBNUM (ptr); -#if (SCM_DEBUG_CELL_ACCESSES == 1) || (defined (GUILE_DEBUG_FREELIST)) - if (!(i < scm_numsmob)) - SCM_MISC_ERROR ("undefined smob type", SCM_EOL); -#endif - if (scm_smobs[i].mark) - { - ptr = (scm_smobs[i].mark) (ptr); - goto_gc_mark_loop; - } - else - return; - } - break; - default: - SCM_MISC_ERROR ("unknown type", SCM_EOL); - } -#undef RECURSE -} -#undef FUNC_NAME - -#ifndef MARK_DEPENDENCIES - -#undef MARK -#undef FNAME - -/* And here we define `scm_gc_mark_dependencies', by including this - * same file in itself. - */ -#define MARK scm_gc_mark_dependencies -#define FNAME "scm_gc_mark_dependencies" -#define MARK_DEPENDENCIES -#include "gc.c" -#undef MARK_DEPENDENCIES -#undef MARK -#undef FNAME - - -/* Determine whether the given value does actually represent a cell in some - * heap segment. If this is the case, the number of the heap segment is - * returned. Otherwise, -1 is returned. Binary search is used in order to - * determine the heap segment that contains the cell.*/ -/* FIXME: To be used within scm_mark_locations and scm_cellp this function - * should be an inline function. */ -static long int -heap_segment (SCM obj) -{ - if (!CELL_P (obj)) - return -1; - else - { - SCM_CELLPTR ptr = SCM2PTR (obj); - unsigned long int i = 0; - unsigned long int j = scm_n_heap_segs - 1; - - if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[0])) - return -1; - else if (SCM_PTR_LE (scm_heap_table[j].bounds[1], ptr)) - return -1; - else - { - while (i < j) - { - if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[1])) - { - break; - } - else if (SCM_PTR_LE (scm_heap_table[j].bounds[0], ptr)) - { - i = j; - break; - } - else - { - unsigned long int k = (i + j) / 2; - - if (k == i) - return -1; - else if (SCM_PTR_LT (ptr, scm_heap_table[k].bounds[1])) - { - j = k; - ++i; - if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[0])) - return -1; - } - else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) - { - i = k; - --j; - if (SCM_PTR_LE (scm_heap_table[j].bounds[1], ptr)) - return -1; - } - } - } - - if (!DOUBLECELL_ALIGNED_P (obj) && scm_heap_table[i].span == 2) - return -1; - else if (SCM_GC_IN_CARD_HEADERP (ptr)) - return -1; - else - return i; - } - } -} - - -/* Mark a region conservatively */ -void -scm_mark_locations (SCM_STACKITEM x[], unsigned long n) -{ - unsigned long m; - - for (m = 0; m < n; ++m) - { - SCM obj = * (SCM *) &x[m]; - long int segment = heap_segment (obj); - if (segment >= 0) - scm_gc_mark (obj); - } -} - - -/* The function scm_cellp determines whether an SCM value can be regarded as a - * pointer to a cell on the heap. - */ -int -scm_cellp (SCM value) -{ - long int segment = heap_segment (value); - return (segment >= 0); -} - - -static void -gc_sweep_freelist_start (scm_t_freelist *freelist) -{ - freelist->cells = SCM_EOL; - freelist->left_to_collect = freelist->cluster_size; - freelist->clusters_allocated = 0; - freelist->clusters = SCM_EOL; - freelist->clustertail = &freelist->clusters; - freelist->collected_1 = freelist->collected; - freelist->collected = 0; -} - -static void -gc_sweep_freelist_finish (scm_t_freelist *freelist) -{ - long collected; - *freelist->clustertail = freelist->cells; - if (!SCM_NULLP (freelist->cells)) - { - SCM c = freelist->cells; - SCM_SET_CELL_WORD_0 (c, SCM_FREE_CELL_CDR (c)); - SCM_SET_CELL_WORD_1 (c, SCM_EOL); - freelist->collected += - freelist->span * (freelist->cluster_size - freelist->left_to_collect); - } - scm_gc_cells_collected += freelist->collected; - - /* Although freelist->min_yield is used to test freelist->collected - * (which is the local GC yield for freelist), it is adjusted so - * that *total* yield is freelist->min_yield_fraction of total heap - * size. This means that a too low yield is compensated by more - * heap on the list which is currently doing most work, which is - * just what we want. - */ - collected = SCM_MAX (freelist->collected_1, freelist->collected); - freelist->grow_heap_p = (collected < freelist->min_yield); -} - -#define NEXT_DATA_CELL(ptr, span) \ - do { \ - scm_t_cell *nxt__ = CELL_UP ((char *) (ptr) + 1, (span)); \ - (ptr) = (SCM_GC_IN_CARD_HEADERP (nxt__) ? \ - CELL_UP (SCM_GC_CELL_CARD (nxt__) + SCM_GC_CARD_N_HEADER_CELLS, span) \ - : nxt__); \ - } while (0) - -void -scm_gc_sweep () -#define FUNC_NAME "scm_gc_sweep" -{ - register SCM_CELLPTR ptr; - register SCM nfreelist; - register scm_t_freelist *freelist; - register unsigned long m; - register int span; - size_t i; - size_t seg_size; - - m = 0; - - gc_sweep_freelist_start (&scm_master_freelist); - gc_sweep_freelist_start (&scm_master_freelist2); - - for (i = 0; i < scm_n_heap_segs; i++) - { - register long left_to_collect; - register size_t j; - - /* Unmarked cells go onto the front of the freelist this heap - segment points to. Rather than updating the real freelist - pointer as we go along, we accumulate the new head in - nfreelist. Then, if it turns out that the entire segment is - free, we free (i.e., malloc's free) the whole segment, and - simply don't assign nfreelist back into the real freelist. */ - freelist = scm_heap_table[i].freelist; - nfreelist = freelist->cells; - left_to_collect = freelist->left_to_collect; - span = scm_heap_table[i].span; - - ptr = CELL_UP (scm_heap_table[i].bounds[0], span); - seg_size = CELL_DN (scm_heap_table[i].bounds[1], span) - ptr; - - /* use only data cells in seg_size */ - seg_size = (seg_size / SCM_GC_CARD_N_CELLS) * (SCM_GC_CARD_N_DATA_CELLS / span) * span; - - scm_gc_cells_swept += seg_size; - - for (j = seg_size + span; j -= span; ptr += span) - { - SCM scmptr; - - if (SCM_GC_IN_CARD_HEADERP (ptr)) - { - SCM_CELLPTR nxt; - - /* cheat here */ - nxt = ptr; - NEXT_DATA_CELL (nxt, span); - j += span; - - ptr = nxt - span; - continue; - } - - scmptr = PTR2SCM (ptr); - - if (SCM_GCMARKP (scmptr)) - continue; - - switch SCM_TYP7 (scmptr) - { - case scm_tcs_struct: - { - /* Structs need to be freed in a special order. - * This is handled by GC C hooks in struct.c. - */ - SCM_SET_STRUCT_GC_CHAIN (scmptr, scm_structs_to_free); - scm_structs_to_free = scmptr; - } - continue; - case scm_tcs_cons_imcar: - case scm_tcs_cons_nimcar: - case scm_tcs_closures: - case scm_tc7_pws: - break; - case scm_tc7_wvect: - case scm_tc7_vector: - { - unsigned long int length = SCM_VECTOR_LENGTH (scmptr); - if (length > 0) - { - scm_gc_free (SCM_VECTOR_BASE (scmptr), - length * sizeof (scm_t_bits), - "vector"); - } - break; - } -#ifdef CCLO - case scm_tc7_cclo: - scm_gc_free (SCM_CCLO_BASE (scmptr), - SCM_CCLO_LENGTH (scmptr) * sizeof (SCM), - "compiled closure"); - break; -#endif -#ifdef HAVE_ARRAYS - case scm_tc7_bvect: - { - unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr); - if (length > 0) - { - scm_gc_free (SCM_BITVECTOR_BASE (scmptr), - (sizeof (long) - * ((length+SCM_LONG_BIT-1) / SCM_LONG_BIT)), - "vector"); - } - } - break; - case scm_tc7_byvect: - case scm_tc7_ivect: - case scm_tc7_uvect: - case scm_tc7_svect: -#ifdef HAVE_LONG_LONGS - case scm_tc7_llvect: -#endif - case scm_tc7_fvect: - case scm_tc7_dvect: - case scm_tc7_cvect: - scm_gc_free (SCM_UVECTOR_BASE (scmptr), - (SCM_UVECTOR_LENGTH (scmptr) - * scm_uniform_element_size (scmptr)), - "vector"); - break; -#endif - case scm_tc7_string: - scm_gc_free (SCM_STRING_CHARS (scmptr), - SCM_STRING_LENGTH (scmptr) + 1, "string"); - break; - case scm_tc7_symbol: - scm_gc_free (SCM_SYMBOL_CHARS (scmptr), - SCM_SYMBOL_LENGTH (scmptr) + 1, "symbol"); - break; - case scm_tc7_variable: - break; - case scm_tcs_subrs: - /* the various "subrs" (primitives) are never freed */ - continue; - case scm_tc7_port: - if SCM_OPENP (scmptr) - { - int k = SCM_PTOBNUM (scmptr); - size_t mm; -#if (SCM_DEBUG_CELL_ACCESSES == 1) || (defined (GUILE_DEBUG_FREELIST)) - if (!(k < scm_numptob)) - SCM_MISC_ERROR ("undefined port type", SCM_EOL); -#endif - /* Keep "revealed" ports alive. */ - if (scm_revealed_count (scmptr) > 0) - continue; - /* Yes, I really do mean scm_ptobs[k].free */ - /* rather than ftobs[k].close. .close */ - /* is for explicit CLOSE-PORT by user */ - mm = scm_ptobs[k].free (scmptr); - - if (mm != 0) - { -#if SCM_ENABLE_DEPRECATED == 1 - scm_c_issue_deprecation_warning - ("Returning non-0 from a port free function is " - "deprecated. Use scm_gc_free et al instead."); - scm_c_issue_deprecation_warning_fmt - ("(You just returned non-0 while freeing a %s.)", - SCM_PTOBNAME (k)); - m += mm; -#else - abort (); -#endif - } - - SCM_SETSTREAM (scmptr, 0); - scm_remove_from_port_table (scmptr); - scm_gc_ports_collected++; - SCM_CLR_PORT_OPEN_FLAG (scmptr); - } - break; - case scm_tc7_smob: - switch SCM_TYP16 (scmptr) - { - case scm_tc_free_cell: - case scm_tc16_real: - break; -#ifdef SCM_BIGDIG - case scm_tc16_big: - scm_gc_free (SCM_BDIGITS (scmptr), - ((SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG - / SCM_CHAR_BIT)), "bignum"); - break; -#endif /* def SCM_BIGDIG */ - case scm_tc16_complex: - scm_gc_free (SCM_COMPLEX_MEM (scmptr), 2*sizeof (double), - "complex"); - break; - default: - { - int k; - k = SCM_SMOBNUM (scmptr); -#if (SCM_DEBUG_CELL_ACCESSES == 1) || (defined (GUILE_DEBUG_FREELIST)) - if (!(k < scm_numsmob)) - SCM_MISC_ERROR ("undefined smob type", SCM_EOL); -#endif - if (scm_smobs[k].free) - { - size_t mm; - mm = scm_smobs[k].free (scmptr); - if (mm != 0) - { -#if SCM_ENABLE_DEPRECATED == 1 - scm_c_issue_deprecation_warning - ("Returning non-0 from a smob free function is " - "deprecated. Use scm_gc_free et al instead."); - scm_c_issue_deprecation_warning_fmt - ("(You just returned non-0 while freeing a %s.)", - SCM_SMOBNAME (k)); - m += mm; -#else - abort(); -#endif - } - } - break; - } - } - break; - default: - SCM_MISC_ERROR ("unknown type", SCM_EOL); - } - - if (!--left_to_collect) - { - SCM_SET_CELL_WORD_0 (scmptr, nfreelist); - *freelist->clustertail = scmptr; - freelist->clustertail = SCM_CDRLOC (scmptr); - - nfreelist = SCM_EOL; - freelist->collected += span * freelist->cluster_size; - left_to_collect = freelist->cluster_size; - } - else - { - /* Stick the new cell on the front of nfreelist. It's - critical that we mark this cell as freed; otherwise, the - conservative collector might trace it as some other type - of object. */ - SCM_SET_CELL_TYPE (scmptr, scm_tc_free_cell); - SCM_SET_FREE_CELL_CDR (scmptr, nfreelist); - nfreelist = scmptr; - } - } - -#ifdef GC_FREE_SEGMENTS - if (n == seg_size) - { - register long j; - - freelist->heap_size -= seg_size; - free ((char *) scm_heap_table[i].bounds[0]); - scm_heap_table[i].bounds[0] = 0; - for (j = i + 1; j < scm_n_heap_segs; j++) - scm_heap_table[j - 1] = scm_heap_table[j]; - scm_n_heap_segs -= 1; - i--; /* We need to scan the segment just moved. */ - } - else -#endif /* ifdef GC_FREE_SEGMENTS */ - { - /* Update the real freelist pointer to point to the head of - the list of free cells we've built for this segment. */ - freelist->cells = nfreelist; - freelist->left_to_collect = left_to_collect; - } - -#ifdef GUILE_DEBUG_FREELIST - scm_map_free_list (); -#endif - } - - gc_sweep_freelist_finish (&scm_master_freelist); - gc_sweep_freelist_finish (&scm_master_freelist2); - - /* When we move to POSIX threads private freelists should probably - be GC-protected instead. */ - scm_freelist = SCM_EOL; - scm_freelist2 = SCM_EOL; - - scm_cells_allocated = (SCM_HEAP_SIZE - scm_gc_cells_collected); - scm_gc_yield -= scm_cells_allocated; - - if (scm_mallocated < m) + scm_i_sweep_all_segments("GC"); + if (scm_mallocated < scm_i_deprecated_memory_return) { /* The byte count of allocated objects has underflowed. This is probably because you forgot to report the sizes of objects you @@ -1853,535 +546,43 @@ scm_gc_sweep () "about object sizes\n"); abort (); } + scm_mallocated -= scm_i_deprecated_memory_return; - scm_mallocated -= m; - scm_gc_malloc_collected = m; + + + scm_c_hook_run (&scm_before_mark_c_hook, 0); + + scm_mark_all (); + + t_before_sweep = scm_c_get_internal_run_time (); + scm_gc_mark_time_taken += (t_before_sweep - t_before_gc); + + scm_c_hook_run (&scm_before_sweep_c_hook, 0); + + /* + Moved this lock upwards so that we can alloc new heap at the end of a sweep. + + DOCME: why should the heap be locked anyway? + */ + --scm_gc_heap_lock; + + scm_gc_sweep (); + + scm_c_hook_run (&scm_after_sweep_c_hook, 0); + gc_end_stats (); + + SCM_CRITICAL_SECTION_END; + scm_c_hook_run (&scm_after_gc_c_hook, 0); + --scm_gc_running_p; } -#undef FUNC_NAME + + + + + -/* Function for non-cell memory management. - */ - -void * -scm_malloc (size_t size) -{ - void *ptr; - - if (size == 0) - return NULL; - - SCM_SYSCALL (ptr = malloc (size)); - if (ptr) - return ptr; - - scm_igc ("malloc"); - SCM_SYSCALL (ptr = malloc (size)); - if (ptr) - return ptr; - - scm_memory_error ("malloc"); -} - -void * -scm_realloc (void *mem, size_t size) -{ - void *ptr; - - SCM_SYSCALL (ptr = realloc (mem, size)); - if (ptr) - return ptr; - - scm_igc ("realloc"); - SCM_SYSCALL (ptr = realloc (mem, size)); - if (ptr) - return ptr; - - scm_memory_error ("realloc"); -} - -char * -scm_strndup (const char *str, size_t n) -{ - char *dst = scm_malloc (n+1); - memcpy (dst, str, n); - dst[n] = 0; - return dst; -} - -char * -scm_strdup (const char *str) -{ - return scm_strndup (str, strlen (str)); -} - -void -scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) -{ - scm_mallocated += size; - - if (scm_mallocated > scm_mtrigger) - { - scm_igc (what); - if (scm_mallocated > scm_mtrigger - SCM_MTRIGGER_HYSTERESIS) - { - if (scm_mallocated > scm_mtrigger) - scm_mtrigger = scm_mallocated + scm_mallocated / 2; - else - scm_mtrigger += scm_mtrigger / 2; - } - } - -#ifdef GUILE_DEBUG_MALLOC - if (mem) - scm_malloc_register (mem, what); -#endif -} - -void -scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what) -{ - scm_mallocated -= size; - -#ifdef GUILE_DEBUG_MALLOC - if (mem) - scm_malloc_unregister (mem); -#endif -} - -void * -scm_gc_malloc (size_t size, const char *what) -{ - /* XXX - The straightforward implementation below has the problem - that it might call the GC twice, once in scm_malloc and then - again in scm_gc_register_collectable_memory. We don't really - want the second GC since it will not find new garbage. - */ - - void *ptr = scm_malloc (size); - scm_gc_register_collectable_memory (ptr, size, what); - return ptr; -} - -void * -scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what) -{ - /* XXX - see scm_gc_malloc. */ - - void *ptr = scm_realloc (mem, new_size); - scm_gc_unregister_collectable_memory (mem, old_size, what); - scm_gc_register_collectable_memory (ptr, new_size, what); - return ptr; -} - -void -scm_gc_free (void *mem, size_t size, const char *what) -{ - scm_gc_unregister_collectable_memory (mem, size, what); - free (mem); -} - -char * -scm_gc_strndup (const char *str, size_t n, const char *what) -{ - char *dst = scm_gc_malloc (n+1, what); - memcpy (dst, str, n); - dst[n] = 0; - return dst; -} - -char * -scm_gc_strdup (const char *str, const char *what) -{ - return scm_gc_strndup (str, strlen (str), what); -} - -#if SCM_ENABLE_DEPRECATED == 1 - -/* {Deprecated front end to malloc} - * - * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc, - * scm_done_free - * - * These functions provide services comparable to malloc, realloc, and - * free. They should be used when allocating memory that will be under - * control of the garbage collector, i.e., if the memory may be freed - * during garbage collection. - * - * They are deprecated because they weren't really used the way - * outlined above, and making sure to return the right amount from - * smob free routines was sometimes difficult when dealing with nested - * data structures. We basically want everybody to review their code - * and use the more symmetrical scm_gc_malloc/scm_gc_free functions - * instead. In some cases, where scm_must_malloc has been used - * incorrectly (i.e. for non-GC-able memory), use scm_malloc/free. - */ - -void * -scm_must_malloc (size_t size, const char *what) -{ - scm_c_issue_deprecation_warning - ("scm_must_malloc is deprecated. " - "Use scm_gc_malloc and scm_gc_free instead."); - - return scm_gc_malloc (size, what); -} - -void * -scm_must_realloc (void *where, - size_t old_size, - size_t size, - const char *what) -{ - scm_c_issue_deprecation_warning - ("scm_must_realloc is deprecated. " - "Use scm_gc_realloc and scm_gc_free instead."); - - return scm_gc_realloc (where, old_size, size, what); -} - -char * -scm_must_strndup (const char *str, size_t length) -{ - scm_c_issue_deprecation_warning - ("scm_must_strndup is deprecated. " - "Use scm_gc_strndup and scm_gc_free instead."); - - return scm_gc_strndup (str, length, "string"); -} - -char * -scm_must_strdup (const char *str) -{ - scm_c_issue_deprecation_warning - ("scm_must_strdup is deprecated. " - "Use scm_gc_strdup and scm_gc_free instead."); - - return scm_gc_strdup (str, "string"); -} - -void -scm_must_free (void *obj) -#define FUNC_NAME "scm_must_free" -{ - scm_c_issue_deprecation_warning - ("scm_must_free is deprecated. " - "Use scm_gc_malloc and scm_gc_free instead."); - -#ifdef GUILE_DEBUG_MALLOC - scm_malloc_unregister (obj); -#endif - if (obj) - free (obj); - else - SCM_MISC_ERROR ("freeing NULL pointer", SCM_EOL); -} -#undef FUNC_NAME - - -void -scm_done_malloc (long size) -{ - scm_c_issue_deprecation_warning - ("scm_done_malloc is deprecated. " - "Use scm_gc_register_collectable_memory instead."); - - scm_gc_register_collectable_memory (NULL, size, "foreign mallocs"); -} - -void -scm_done_free (long size) -{ - scm_c_issue_deprecation_warning - ("scm_done_free is deprecated. " - "Use scm_gc_unregister_collectable_memory instead."); - - scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs"); -} - -#endif /* SCM_ENABLE_DEPRECATED == 1 */ - - -/* {Heap Segments} - * - * Each heap segment is an array of objects of a particular size. - * Every segment has an associated (possibly shared) freelist. - * A table of segment records is kept that records the upper and - * lower extents of the segment; this is used during the conservative - * phase of gc to identify probably gc roots (because they point - * into valid segments at reasonable offsets). */ - -/* scm_expmem - * is true if the first segment was smaller than INIT_HEAP_SEG. - * If scm_expmem is set to one, subsequent segment allocations will - * allocate segments of size SCM_EXPHEAP(scm_heap_size). - */ -int scm_expmem = 0; - -size_t scm_max_segment_size; - -/* scm_heap_org - * is the lowest base address of any heap segment. - */ -SCM_CELLPTR scm_heap_org; - -scm_t_heap_seg_data * scm_heap_table = 0; -static size_t heap_segment_table_size = 0; -size_t scm_n_heap_segs = 0; - -/* init_heap_seg - * initializes a new heap segment and returns the number of objects it contains. - * - * The segment origin and segment size in bytes are input parameters. - * The freelist is both input and output. - * - * This function presumes that the scm_heap_table has already been expanded - * to accomodate a new segment record and that the markbit space was reserved - * for all the cards in this segment. - */ - -#define INIT_CARD(card, span) \ - do { \ - SCM_GC_SET_CARD_BVEC (card, get_bvec ()); \ - if ((span) == 2) \ - SCM_GC_SET_CARD_DOUBLECELL (card); \ - } while (0) - -static size_t -init_heap_seg (SCM_CELLPTR seg_org, size_t size, scm_t_freelist *freelist) -{ - register SCM_CELLPTR ptr; - SCM_CELLPTR seg_end; - size_t new_seg_index; - ptrdiff_t n_new_cells; - int span = freelist->span; - - if (seg_org == NULL) - return 0; - - /* Align the begin ptr up. - */ - ptr = SCM_GC_CARD_UP (seg_org); - - /* Compute the ceiling on valid object pointers w/in this segment. - */ - seg_end = SCM_GC_CARD_DOWN ((char *)seg_org + size); - - /* Find the right place and insert the segment record. - */ - new_seg_index = 0; - while (new_seg_index < scm_n_heap_segs - && SCM_PTR_LE (scm_heap_table[new_seg_index].bounds[0], seg_org)) - new_seg_index++; - - { - int i; - for (i = scm_n_heap_segs; i > new_seg_index; --i) - scm_heap_table[i] = scm_heap_table[i - 1]; - } - - ++scm_n_heap_segs; - - scm_heap_table[new_seg_index].span = span; - scm_heap_table[new_seg_index].freelist = freelist; - scm_heap_table[new_seg_index].bounds[0] = ptr; - scm_heap_table[new_seg_index].bounds[1] = seg_end; - - /*n_new_cells*/ - n_new_cells = seg_end - ptr; - - freelist->heap_size += n_new_cells; - - /* Partition objects in this segment into clusters */ - { - SCM clusters; - SCM *clusterp = &clusters; - - NEXT_DATA_CELL (ptr, span); - while (ptr < seg_end) - { - scm_t_cell *nxt = ptr; - scm_t_cell *prv = NULL; - scm_t_cell *last_card = NULL; - int n_data_cells = (SCM_GC_CARD_N_DATA_CELLS / span) * SCM_CARDS_PER_CLUSTER - 1; - NEXT_DATA_CELL(nxt, span); - - /* Allocate cluster spine - */ - *clusterp = PTR2SCM (ptr); - SCM_SETCAR (*clusterp, PTR2SCM (nxt)); - clusterp = SCM_CDRLOC (*clusterp); - ptr = nxt; - - while (n_data_cells--) - { - scm_t_cell *card = SCM_GC_CELL_CARD (ptr); - SCM scmptr = PTR2SCM (ptr); - nxt = ptr; - NEXT_DATA_CELL (nxt, span); - prv = ptr; - - if (card != last_card) - { - INIT_CARD (card, span); - last_card = card; - } - - SCM_SET_CELL_TYPE (scmptr, scm_tc_free_cell); - SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (nxt)); - - ptr = nxt; - } - - SCM_SET_FREE_CELL_CDR (PTR2SCM (prv), SCM_EOL); - } - - /* sanity check */ - { - scm_t_cell *ref = seg_end; - NEXT_DATA_CELL (ref, span); - if (ref != ptr) - /* [cmm] looks like the segment size doesn't divide cleanly by - cluster size. bad cmm! */ - abort(); - } - - /* Patch up the last cluster pointer in the segment - * to join it to the input freelist. - */ - *clusterp = freelist->clusters; - freelist->clusters = clusters; - } - -#ifdef DEBUGINFO - fprintf (stderr, "H"); -#endif - return size; -} - -static size_t -round_to_cluster_size (scm_t_freelist *freelist, size_t len) -{ - size_t cluster_size_in_bytes = CLUSTER_SIZE_IN_BYTES (freelist); - - return - (len + cluster_size_in_bytes - 1) / cluster_size_in_bytes * cluster_size_in_bytes - + ALIGNMENT_SLACK (freelist); -} - -static void -alloc_some_heap (scm_t_freelist *freelist, policy_on_error error_policy) -#define FUNC_NAME "alloc_some_heap" -{ - SCM_CELLPTR ptr; - size_t len; - - if (scm_gc_heap_lock) - { - /* Critical code sections (such as the garbage collector) aren't - * supposed to add heap segments. - */ - fprintf (stderr, "alloc_some_heap: Can not extend locked heap.\n"); - abort (); - } - - if (scm_n_heap_segs == heap_segment_table_size) - { - /* We have to expand the heap segment table to have room for the new - * segment. Do not yet increment scm_n_heap_segs -- that is done by - * init_heap_seg only if the allocation of the segment itself succeeds. - */ - size_t new_table_size = scm_n_heap_segs + 1; - size_t size = new_table_size * sizeof (scm_t_heap_seg_data); - scm_t_heap_seg_data *new_heap_table; - - SCM_SYSCALL (new_heap_table = ((scm_t_heap_seg_data *) - realloc ((char *)scm_heap_table, size))); - if (!new_heap_table) - { - if (error_policy == abort_on_error) - { - fprintf (stderr, "alloc_some_heap: Could not grow heap segment table.\n"); - abort (); - } - else - { - return; - } - } - else - { - scm_heap_table = new_heap_table; - heap_segment_table_size = new_table_size; - } - } - - /* Pick a size for the new heap segment. - * The rule for picking the size of a segment is explained in - * gc.h - */ - { - /* Assure that the new segment is predicted to be large enough. - * - * New yield should at least equal GC fraction of new heap size, i.e. - * - * y + dh > f * (h + dh) - * - * y : yield - * f : min yield fraction - * h : heap size - * dh : size of new heap segment - * - * This gives dh > (f * h - y) / (1 - f) - */ - int f = freelist->min_yield_fraction; - unsigned long h = SCM_HEAP_SIZE; - size_t min_cells = (f * h - 100 * (long) scm_gc_yield) / (99 - f); - len = SCM_EXPHEAP (freelist->heap_size); -#ifdef DEBUGINFO - fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells); -#endif - if (len < min_cells) - len = min_cells + freelist->cluster_size; - len *= sizeof (scm_t_cell); - /* force new sampling */ - freelist->collected = LONG_MAX; - } - - if (len > scm_max_segment_size) - len = scm_max_segment_size; - - { - size_t smallest; - - smallest = CLUSTER_SIZE_IN_BYTES (freelist); - - if (len < smallest) - len = smallest; - - /* Allocate with decaying ambition. */ - while ((len >= SCM_MIN_HEAP_SEG_SIZE) - && (len >= smallest)) - { - size_t rounded_len = round_to_cluster_size (freelist, len); - SCM_SYSCALL (ptr = (SCM_CELLPTR) malloc (rounded_len)); - if (ptr) - { - init_heap_seg (ptr, rounded_len, freelist); - return; - } - len /= 2; - } - } - - if (error_policy == abort_on_error) - { - fprintf (stderr, "alloc_some_heap: Could not grow heap.\n"); - abort (); - } -} -#undef FUNC_NAME /* {GC Protection Helper Functions} @@ -2607,58 +808,19 @@ cleanup (int status, void *arg) } -static int -make_initial_segment (size_t init_heap_size, scm_t_freelist *freelist) -{ - size_t rounded_size = round_to_cluster_size (freelist, init_heap_size); - if (!init_heap_seg ((SCM_CELLPTR) malloc (rounded_size), - rounded_size, - freelist)) - { - rounded_size = round_to_cluster_size (freelist, SCM_HEAP_SEG_SIZE); - if (!init_heap_seg ((SCM_CELLPTR) malloc (rounded_size), - rounded_size, - freelist)) - return 1; - } - else - scm_expmem = 1; - - if (freelist->min_yield_fraction) - freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction - / 100); - freelist->grow_heap_p = (freelist->heap_size < freelist->min_yield); - - return 0; -} - - -static void -init_freelist (scm_t_freelist *freelist, - int span, - long cluster_size, - int min_yield) -{ - freelist->clusters = SCM_EOL; - freelist->cluster_size = cluster_size + 1; - freelist->left_to_collect = 0; - freelist->clusters_allocated = 0; - freelist->min_yield = 0; - freelist->min_yield_fraction = min_yield; - freelist->span = span; - freelist->collected = 0; - freelist->collected_1 = 0; - freelist->heap_size = 0; -} +/* + MOVE THIS FUNCTION. IT DOES NOT HAVE ANYTHING TODO WITH GC. + */ /* Get an integer from an environment variable. */ -static int -scm_i_getenv_int (const char *var, int def) +int +scm_getenv_int (const char *var, int def) { - char *end, *val = getenv (var); - long res; + char *end = 0; + char *val = getenv (var); + long res = def; if (!val) return def; res = strtol (val, &end, 10); @@ -2671,10 +833,6 @@ scm_i_getenv_int (const char *var, int def) int scm_init_storage () { - unsigned long gc_trigger_1; - unsigned long gc_trigger_2; - size_t init_heap_size_1; - size_t init_heap_size_2; size_t j; j = SCM_NUM_PROTECTS; @@ -2682,32 +840,12 @@ scm_init_storage () scm_sys_protects[--j] = SCM_BOOL_F; scm_block_gc = 1; - scm_freelist = SCM_EOL; - scm_freelist2 = SCM_EOL; - gc_trigger_1 = scm_i_getenv_int ("GUILE_MIN_YIELD_1", scm_default_min_yield_1); - init_freelist (&scm_master_freelist, 1, SCM_CLUSTER_SIZE_1, gc_trigger_1); - gc_trigger_2 = scm_i_getenv_int ("GUILE_MIN_YIELD_2", scm_default_min_yield_2); - init_freelist (&scm_master_freelist2, 2, SCM_CLUSTER_SIZE_2, gc_trigger_2); - scm_max_segment_size = scm_i_getenv_int ("GUILE_MAX_SEGMENT_SIZE", scm_default_max_segment_size); - - scm_expmem = 0; + scm_gc_init_freelist(); + scm_gc_init_malloc (); j = SCM_HEAP_SEG_SIZE; - scm_mtrigger = SCM_INIT_MALLOC_LIMIT; - scm_heap_table = ((scm_t_heap_seg_data *) - scm_malloc (sizeof (scm_t_heap_seg_data) * 2)); - heap_segment_table_size = 2; - mark_space_ptr = &mark_space_head; - - init_heap_size_1 = scm_i_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", scm_default_init_heap_size_1); - init_heap_size_2 = scm_i_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", scm_default_init_heap_size_2); - if (make_initial_segment (init_heap_size_1, &scm_master_freelist) || - make_initial_segment (init_heap_size_2, &scm_master_freelist2)) - return 1; - - /* scm_hplims[0] can change. do not remove scm_heap_org */ - scm_heap_org = CELL_UP (scm_heap_table[0].bounds[0], 1); + scm_c_hook_init (&scm_before_gc_c_hook, 0, SCM_C_HOOK_NORMAL); scm_c_hook_init (&scm_before_mark_c_hook, 0, SCM_C_HOOK_NORMAL); @@ -2799,63 +937,13 @@ mark_gc_async (void * hook_data SCM_UNUSED, return NULL; } -#if SCM_ENABLE_DEPRECATED == 1 - -/* If an allocated cell is detected during garbage collection, this - * means that some code has just obtained the object but was preempted - * before the initialization of the object was completed. This meanst - * that some entries of the allocated cell may already contain SCM - * objects. Therefore, allocated cells are scanned conservatively. - */ - -scm_t_bits scm_tc16_allocated; - -static SCM -allocated_mark (SCM cell) -{ - unsigned long int cell_segment = heap_segment (cell); - unsigned int span = scm_heap_table[cell_segment].span; - unsigned int i; - - for (i = 1; i != span * 2; ++i) - { - SCM obj = SCM_CELL_OBJECT (cell, i); - long int obj_segment = heap_segment (obj); - if (obj_segment >= 0) - scm_gc_mark (obj); - } - return SCM_BOOL_F; -} - -SCM -scm_deprecated_newcell (void) -{ - scm_c_issue_deprecation_warning - ("SCM_NEWCELL is deprecated. Use `scm_cell' instead.\n"); - - return scm_cell (scm_tc16_allocated, 0); -} - -SCM -scm_deprecated_newcell2 (void) -{ - scm_c_issue_deprecation_warning - ("SCM_NEWCELL2 is deprecated. Use `scm_double_cell' instead.\n"); - - return scm_double_cell (scm_tc16_allocated, 0, 0, 0); -} - -#endif /* SCM_ENABLE_DEPRECATED == 1 */ - void scm_init_gc () { SCM after_gc_thunk; -#if SCM_ENABLE_DEPRECATED == 1 - scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0); - scm_set_smob_mark (scm_tc16_allocated, allocated_mark); -#endif + + scm_gc_init_mark (); scm_after_gc_hook = scm_permanent_object (scm_make_hook (SCM_INUM0)); scm_c_define ("after-gc-hook", scm_after_gc_hook); @@ -2869,7 +957,30 @@ scm_init_gc () #include "libguile/gc.x" } -#endif /*MARK_DEPENDENCIES*/ + +void +scm_gc_sweep (void) +#define FUNC_NAME "scm_gc_sweep" +{ + scm_i_deprecated_memory_return = 0; + + scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist); + scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2); + + /* + NOTHING HERE: LAZY SWEEPING ! + */ + scm_i_reset_segments (); + + /* When we move to POSIX threads private freelists should probably + be GC-protected instead. */ + scm_i_freelist = SCM_EOL; + scm_i_freelist2 = SCM_EOL; +} + +#undef FUNC_NAME + + /* Local Variables: diff --git a/libguile/gc.h b/libguile/gc.h index 0296ea0e0..bd86ad1f0 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -58,11 +58,17 @@ typedef struct scm_t_cell scm_t_bits word_1; } scm_t_cell; +/* + CARDS + + A card is a small `page' of memory; it will be the unit for lazy + sweeping, generations, etc. The first cell of a card contains a + pointer to the mark bitvector, so that we can find the bitvector efficiently: we + knock off some lowerorder bits. + + The size on a 32 bit machine is 256 cells = 2kb. The card +*/ -/* SCM_CELLPTR is a pointer to a cons cell which may be compared or - * differenced. - */ -typedef scm_t_cell * SCM_CELLPTR; /* Cray machines have pointers that are incremented once for each word, @@ -73,39 +79,32 @@ typedef scm_t_cell * SCM_CELLPTR; * pointers to scm_vector elts, functions, &c are not munged. */ #ifdef _UNICOS -# define SCM2PTR(x) ((SCM_CELLPTR) (SCM_UNPACK (x) >> 3)) +# define SCM2PTR(x) ((scm_t_cell *) (SCM_UNPACK (x) >> 3)) # define PTR2SCM(x) (SCM_PACK (((scm_t_bits) (x)) << 3)) #else -# define SCM2PTR(x) ((SCM_CELLPTR) (SCM_UNPACK (x))) +# define SCM2PTR(x) ((scm_t_cell *) (SCM_UNPACK (x))) # define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) #endif /* def _UNICOS */ + #define SCM_GC_CARD_N_HEADER_CELLS 1 #define SCM_GC_CARD_N_CELLS 256 +#define SCM_GC_SIZEOF_CARD SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell) -#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) +#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_long *) ((card)->word_0)) #define SCM_GC_SET_CARD_BVEC(card, bvec) \ ((card)->word_0 = (scm_t_bits) (bvec)) -#define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)) -#define SCM_GC_CARD_N_DATA_CELLS (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) - -#define SCM_GC_CARD_BVEC_SIZE_IN_LIMBS \ - ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LIMB_BITS - 1) / SCM_C_BVEC_LIMB_BITS) - -#define SCM_GC_IN_CARD_HEADERP(x) \ - SCM_PTR_LT ((scm_t_cell *) (x), SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS) - #define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1)) #define SCM_GC_SET_CARD_FLAGS(card, flags) \ ((card)->word_1 = (scm_t_bits) (flags)) -#define SCM_GC_CLR_CARD_FLAGS(card) (SCM_GC_SET_CARD_FLAGS (card, 0L)) +#define SCM_GC_CLEAR_CARD_FLAGS(card) (SCM_GC_SET_CARD_FLAGS (card, 0L)) #define SCM_GC_GET_CARD_FLAG(card, shift) (SCM_GC_GET_CARD_FLAGS (card) & (1L << (shift))) #define SCM_GC_SET_CARD_FLAG(card, shift) \ (SCM_GC_SET_CARD_FLAGS (card, SCM_GC_GET_CARD_FLAGS(card) | (1L << (shift)))) -#define SCM_GC_CLR_CARD_FLAG(card, shift) \ +#define SCM_GC_CLEAR_CARD_FLAG(card, shift) \ (SCM_GC_SET_CARD_FLAGS (card, SCM_GC_GET_CARD_FLAGS(card) & ~(1L << (shift)))) #define SCM_GC_CARDF_DOUBLECELL 0 @@ -116,31 +115,31 @@ typedef scm_t_cell * SCM_CELLPTR; /* card addressing. for efficiency, cards are *always* aligned to SCM_GC_CARD_SIZE. */ -#define SCM_GC_CARD_SIZE_MASK (SCM_GC_CARD_SIZE - 1) +#define SCM_GC_CARD_SIZE_MASK (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell) - 1) #define SCM_GC_CARD_ADDR_MASK (~SCM_GC_CARD_SIZE_MASK) -#define SCM_GC_CELL_CARD(x) ((SCM_CELLPTR) ((long) (x) & SCM_GC_CARD_ADDR_MASK)) -#define SCM_GC_CELL_SPAN(x) ((SCM_GC_CARD_DOUBLECELLP (SCM_GC_CELL_CARD (x))) ? 2 : 1) +#define SCM_GC_CELL_CARD(x) ((scm_t_cell *) ((long) (x) & SCM_GC_CARD_ADDR_MASK)) #define SCM_GC_CELL_OFFSET(x) (((long) (x) & SCM_GC_CARD_SIZE_MASK) >> SCM_CELL_SIZE_SHIFT) #define SCM_GC_CELL_BVEC(x) SCM_GC_CARD_BVEC (SCM_GC_CELL_CARD (x)) #define SCM_GC_CELL_GET_BIT(x) SCM_C_BVEC_GET (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x)) #define SCM_GC_CELL_SET_BIT(x) SCM_C_BVEC_SET (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x)) -#define SCM_GC_CELL_CLR_BIT(x) SCM_C_BVEC_CLR (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x)) +#define SCM_GC_CELL_CLEAR_BIT(x) SCM_C_BVEC_CLEAR (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x)) -#define SCM_GC_CARD_UP(x) SCM_GC_CELL_CARD ((char *) (x) + SCM_GC_CARD_SIZE - 1) +#define SCM_GC_CARD_UP(x) SCM_GC_CELL_CARD ((char *) (x) + SCM_GC_SIZEOF_CARD - 1) #define SCM_GC_CARD_DOWN SCM_GC_CELL_CARD /* low level bit banging aids */ - -typedef unsigned long scm_t_c_bvec_limb; +typedef unsigned long scm_t_c_bvec_long; #if (SIZEOF_LONG == 8) -# define SCM_C_BVEC_LIMB_BITS 64 +# define SCM_C_BVEC_LONG_BITS 64 # define SCM_C_BVEC_OFFSET_SHIFT 6 # define SCM_C_BVEC_POS_MASK 63 # define SCM_CELL_SIZE_SHIFT 4 +# define SCM_SIZEOF_LONG SIZEOF_LONG #else -# define SCM_C_BVEC_LIMB_BITS 32 +# define SCM_C_BVEC_LONG_BITS 32 +# define SCM_SIZEOF_LONG SIZEOF_LONG # define SCM_C_BVEC_OFFSET_SHIFT 5 # define SCM_C_BVEC_POS_MASK 31 # define SCM_CELL_SIZE_SHIFT 3 @@ -150,23 +149,12 @@ typedef unsigned long scm_t_c_bvec_limb; #define SCM_C_BVEC_GET(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] & (1L << (pos & SCM_C_BVEC_POS_MASK))) #define SCM_C_BVEC_SET(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] |= (1L << (pos & SCM_C_BVEC_POS_MASK))) -#define SCM_C_BVEC_CLR(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] &= ~(1L << (pos & SCM_C_BVEC_POS_MASK))) - -#define SCM_C_BVEC_BITS2BYTES(bits) \ - (sizeof (scm_t_c_bvec_limb) * ((((bits) & SCM_C_BVEC_POS_MASK) ? 1L : 0L) + SCM_C_BVEC_OFFSET (bits))) - -#define SCM_C_BVEC_SET_BYTES(bvec, bytes) (memset (bvec, 0xff, bytes)) -#define SCM_C_BVEC_SET_ALL_BITS(bvec, bits) SCM_C_BVEC_SET_BYTES (bvec, SCM_C_BVEC_BITS2BYTES (bits)) - -#define SCM_C_BVEC_CLR_BYTES(bvec, bytes) (memset (bvec, 0, bytes)) -#define SCM_C_BVEC_CLR_ALL_BITS(bvec, bits) SCM_C_BVEC_CLR_BYTES (bvec, SCM_C_BVEC_BITS2BYTES (bits)) +#define SCM_C_BVEC_CLEAR(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] &= ~(1L << (pos & SCM_C_BVEC_POS_MASK))) /* testing and changing GC marks */ - -#define SCM_GCMARKP(x) SCM_GC_CELL_GET_BIT (x) -#define SCM_SETGCMARK(x) SCM_GC_CELL_SET_BIT (x) -#define SCM_CLRGCMARK(x) SCM_GC_CELL_CLR_BIT (x) - +#define SCM_GC_MARK_P(x) SCM_GC_CELL_GET_BIT (x) +#define SCM_SET_GC_MARK(x) SCM_GC_CELL_SET_BIT (x) +#define SCM_CLEAR_GC_MARK(x) SCM_GC_CELL_CLEAR_BIT (x) /* Low level cell data accessing macros. These macros should only be used * from within code related to garbage collection issues, since they will @@ -181,7 +169,7 @@ typedef unsigned long scm_t_c_bvec_limb; #define SCM_GC_SET_CELL_WORD(x, n, v) \ (((scm_t_bits *) SCM2PTR (x)) [n] = (scm_t_bits) (v)) #define SCM_GC_SET_CELL_OBJECT(x, n, v) \ - (((scm_t_bits *) SCM2PTR (x)) [n] = SCM_UNPACK (v)) + (((scm_t_bits *) SCM2PTR (x)) [n] = SCM_UNPACK (v)) #define SCM_GC_CELL_TYPE(x) SCM_GC_CELL_WORD (x, 0) @@ -235,8 +223,14 @@ typedef unsigned long scm_t_c_bvec_limb; * the freelist. Due to this structure, freelist cells are not cons cells * and thus may not be accessed using SCM_CAR and SCM_CDR. */ -#define SCM_FREE_CELL_P(x) \ - (!SCM_IMP (x) && (SCM_GC_CELL_TYPE (x) == scm_tc_free_cell)) +/* + SCM_FREECELL_P removed ; the semantics are ambiguous with lazy + sweeping. Could mean "this cell is no longer in use (will be swept)" + or "this cell has just been swept, and is not yet in use". + */ + +#define SCM_FREECELL_P this_macro_has_been_removed_see_gc_header_file + #define SCM_FREE_CELL_CDR(x) \ (SCM_GC_CELL_OBJECT ((x), 1)) #define SCM_SET_FREE_CELL_CDR(x, v) \ @@ -248,49 +242,54 @@ typedef unsigned long scm_t_c_bvec_limb; #define SCM_CDRLOC(x) ((SCM *) SCM_CELL_WORD_LOC ((x), 1)) -/* SCM_PTR_LT and friends define how to compare two SCM_CELLPTRs (which may - * point to cells in different heap segments). - */ -#define SCM_PTR_LT(x, y) ((x) < (y)) -#define SCM_PTR_GT(x, y) (SCM_PTR_LT (y, x)) -#define SCM_PTR_LE(x, y) (!SCM_PTR_GT (x, y)) -#define SCM_PTR_GE(x, y) (!SCM_PTR_LT (x, y)) -#define SCM_MARKEDP SCM_GCMARKP -#define SCM_NMARKEDP(x) (!SCM_MARKEDP (x)) - #if (SCM_DEBUG_CELL_ACCESSES == 1) SCM_API unsigned int scm_debug_cell_accesses_p; #endif -SCM_API struct scm_t_heap_seg_data *scm_heap_table; -SCM_API size_t scm_n_heap_segs; SCM_API int scm_block_gc; SCM_API int scm_gc_heap_lock; SCM_API unsigned int scm_gc_running_p; +#if (SCM_ENABLE_DEPRECATED == 1) SCM_API size_t scm_default_init_heap_size_1; SCM_API int scm_default_min_yield_1; SCM_API size_t scm_default_init_heap_size_2; SCM_API int scm_default_min_yield_2; SCM_API size_t scm_default_max_segment_size; +#else +#define scm_default_init_heap_size_1 deprecated +#define scm_default_min_yield_1 deprecated +#define scm_default_init_heap_size_2 deprecated +#define scm_default_min_yield_2 deprecated +#define scm_default_max_segment_size deprecated +#endif + SCM_API size_t scm_max_segment_size; -SCM_API SCM_CELLPTR scm_heap_org; -SCM_API SCM scm_freelist; -SCM_API struct scm_t_freelist scm_master_freelist; -SCM_API SCM scm_freelist2; -SCM_API struct scm_t_freelist scm_master_freelist2; + +/* + Deprecated scm_freelist, scm_master_freelist. + No warning; this is not a user serviceable part. + */ +SCM_API SCM scm_i_freelist; +SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist; +SCM_API SCM scm_i_freelist2; +SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2; + +SCM_API unsigned long scm_gc_cells_swept; +SCM_API unsigned long scm_gc_cells_collected; SCM_API unsigned long scm_gc_cells_collected; -SCM_API unsigned long scm_gc_yield; SCM_API unsigned long scm_gc_malloc_collected; SCM_API unsigned long scm_gc_ports_collected; SCM_API unsigned long scm_cells_allocated; SCM_API unsigned long scm_mallocated; SCM_API unsigned long scm_mtrigger; + + SCM_API SCM scm_after_gc_hook; SCM_API scm_t_c_hook scm_before_gc_c_hook; @@ -300,32 +299,32 @@ SCM_API scm_t_c_hook scm_after_sweep_c_hook; SCM_API scm_t_c_hook scm_after_gc_c_hook; #if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST) -SCM_API SCM scm_map_free_list (void); -SCM_API SCM scm_free_list_length (void); -#endif -#ifdef GUILE_DEBUG_FREELIST -SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag); +#define scm_map_free_list deprecated +#define scm_free_list_length deprecated #endif +#if (SCM_ENABLE_DEPRECATED == 1) && defined (GUILE_DEBUG_FREELIST) +SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag); +#endif #if (SCM_DEBUG_CELL_ACCESSES == 1) SCM_API void scm_assert_cell_valid (SCM); -SCM_API SCM scm_set_debug_cell_accesses_x (SCM flag); #endif + +SCM_API SCM scm_set_debug_cell_accesses_x (SCM flag); + + SCM_API SCM scm_object_address (SCM obj); SCM_API SCM scm_gc_stats (void); SCM_API SCM scm_gc (void); -SCM_API void scm_gc_for_alloc (struct scm_t_freelist *freelist); -SCM_API SCM scm_gc_for_newcell (struct scm_t_freelist *master, SCM *freelist); -#if 0 -SCM_API void scm_alloc_cluster (struct scm_t_freelist *master); -#endif +SCM_API void scm_gc_for_alloc (struct scm_t_cell_type_statistics *freelist); +SCM_API SCM scm_gc_for_newcell (struct scm_t_cell_type_statistics *master, SCM *freelist); SCM_API void scm_igc (const char *what); SCM_API void scm_gc_mark (SCM p); SCM_API void scm_gc_mark_dependencies (SCM p); SCM_API void scm_mark_locations (SCM_STACKITEM x[], unsigned long n); -SCM_API int scm_cellp (SCM value); +SCM_API int scm_in_heap_p (SCM value); SCM_API void scm_gc_sweep (void); SCM_API void *scm_malloc (size_t size); diff --git a/libguile/gdbint.c b/libguile/gdbint.c index 54e594e51..5a4caebe8 100644 --- a/libguile/gdbint.c +++ b/libguile/gdbint.c @@ -142,14 +142,14 @@ static void unmark_port (SCM port) { SCM stream, string; - port_mark_p = SCM_GCMARKP (port); - SCM_CLRGCMARK (port); + port_mark_p = SCM_GC_MARK_P (port); + SCM_CLEAR_GC_MARK (port); stream = SCM_PACK (SCM_STREAM (port)); - stream_mark_p = SCM_GCMARKP (stream); - SCM_CLRGCMARK (stream); + stream_mark_p = SCM_GC_MARK_P (stream); + SCM_CLEAR_GC_MARK (stream); string = SCM_CDR (stream); - string_mark_p = SCM_GCMARKP (string); - SCM_CLRGCMARK (string); + string_mark_p = SCM_GC_MARK_P (string); + SCM_CLEAR_GC_MARK (string); } @@ -158,16 +158,19 @@ remark_port (SCM port) { SCM stream = SCM_PACK (SCM_STREAM (port)); SCM string = SCM_CDR (stream); - if (string_mark_p) SCM_SETGCMARK (string); - if (stream_mark_p) SCM_SETGCMARK (stream); - if (port_mark_p) SCM_SETGCMARK (port); + if (string_mark_p) + SCM_SET_GC_MARK (string); + if (stream_mark_p) + SCM_SET_GC_MARK (stream); + if (port_mark_p) + SCM_SET_GC_MARK (port); } int gdb_maybe_valid_type_p (SCM value) { - return SCM_IMP (value) || scm_cellp (value); + return SCM_IMP (value) || scm_in_heap_p (value); } @@ -211,8 +214,8 @@ gdb_read (char *str) scm_truncate_file (gdb_input_port, SCM_UNDEFINED); scm_seek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET)); /* Read one object */ - tok_buf_mark_p = SCM_GCMARKP (tok_buf); - SCM_CLRGCMARK (tok_buf); + tok_buf_mark_p = SCM_GC_MARK_P (tok_buf); + SCM_CLEAR_GC_MARK (tok_buf); ans = scm_lreadr (&tok_buf, gdb_input_port, &ans); if (SCM_GC_P) { @@ -229,7 +232,7 @@ gdb_read (char *str) scm_permanent_object (ans); exit: if (tok_buf_mark_p) - SCM_SETGCMARK (tok_buf); + SCM_SET_GC_MARK (tok_buf); remark_port (gdb_input_port); SCM_END_FOREIGN_BLOCK; return status; diff --git a/libguile/guardians.c b/libguile/guardians.c index b69d0f5e9..e0651f8e2 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -447,19 +447,19 @@ mark_dependencies_in_tconc (t_tconc *tc) SCM obj = SCM_CAR (pair); next_pair = SCM_CDR (pair); - if (! SCM_MARKEDP (obj)) + if (! SCM_GC_MARK_P (obj)) { /* a candidate for finalizing */ scm_gc_mark_dependencies (obj); - if (SCM_MARKEDP (obj)) + if (SCM_GC_MARK_P (obj)) { /* uh oh. a cycle. transfer this object (the spine cell, to be exact) to self_centered_zombies, so we'll be able to complain about it later. */ *prev_ptr = next_pair; - SCM_SETGCMARK (pair); + SCM_SET_GC_MARK (pair); SCM_SETCDR (pair, self_centered_zombies); self_centered_zombies = pair; } @@ -494,7 +494,7 @@ mark_and_zombify (t_guardian *g) { SCM next_pair = SCM_CDR (pair); - if (!SCM_MARKEDP (SCM_CAR (pair))) + if (!SCM_GC_MARK_P (SCM_CAR (pair))) { /* got you, zombie! */ @@ -504,7 +504,7 @@ mark_and_zombify (t_guardian *g) if (GREEDY_P (g)) /* if the guardian is greedy, mark this zombie now. this way it won't be zombified again this time around. */ - SCM_SETGCMARK (SCM_CAR (pair)); + SCM_SET_GC_MARK (SCM_CAR (pair)); /* into the zombie list! */ TCONC_IN (g->zombies, SCM_CAR (pair), pair); @@ -519,7 +519,7 @@ mark_and_zombify (t_guardian *g) don't care about objects pointed to by the list cars, since we know they are already marked). */ for (pair = g->live.head; !SCM_NULLP (pair); pair = SCM_CDR (pair)) - SCM_SETGCMARK (pair); + SCM_SET_GC_MARK (pair); } diff --git a/libguile/init.c b/libguile/init.c index 432983ea3..80e36cb5c 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -453,7 +453,9 @@ scm_init_guile_1 (SCM_STACKITEM *base) #ifdef GUILE_DEBUG_MALLOC scm_debug_malloc_prehistory (); #endif - scm_init_storage (); /* requires smob_prehistory */ + if (scm_init_storage ()) /* requires smob_prehistory */ + abort (); + scm_struct_prehistory (); /* requires storage */ scm_symbols_prehistory (); /* requires storage */ scm_weaks_prehistory (); /* requires storage */ diff --git a/libguile/inline.c b/libguile/inline.c index 3ec21e55c..914f309b2 100644 --- a/libguile/inline.c +++ b/libguile/inline.c @@ -41,9 +41,10 @@ #include "libguile/scmconfig.h" -#ifndef HAVE_INLINE #define HAVE_INLINE +#define EXTERN_INLINE +#undef SCM_INLINE_H + #include "libguile/inline.h" -#endif diff --git a/libguile/inline.h b/libguile/inline.h index 19566bcce..c1df037c3 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -49,35 +49,73 @@ "inline.c". */ + +#if (SCM_DEBUG_CELL_ACCESSES == 1) +#include +#endif + #include "libguile/pairs.h" #include "libguile/gc.h" + +SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr); +SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, + scm_t_bits ccr, scm_t_bits cdr); + #ifdef HAVE_INLINE -static inline SCM + + +#ifndef EXTERN_INLINE +#define EXTERN_INLINE extern inline +#endif + +extern unsigned scm_newcell2_count; +extern unsigned scm_newcell_count; + + +EXTERN_INLINE +SCM scm_cell (scm_t_bits car, scm_t_bits cdr) { SCM z; -#ifdef GUILE_DEBUG_FREELIST - scm_newcell_count++; - if (scm_debug_check_freelist) + if (SCM_NULLP (scm_i_freelist)) { - scm_check_freelist (scm_freelist); - scm_gc(); - } -#endif - - if (SCM_NULLP (scm_freelist)) - { - z = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist); + z = scm_gc_for_newcell (&scm_i_master_freelist, &scm_i_freelist); } else { - z = scm_freelist; - scm_freelist = SCM_FREE_CELL_CDR (scm_freelist); + z = scm_i_freelist; + scm_i_freelist = SCM_FREE_CELL_CDR (scm_i_freelist); } + /* + We update scm_cells_allocated from this function. If we don't + update this explicitly, we will have to walk a freelist somewhere + later on, which seems a lot more expensive. + */ + scm_cells_allocated += 1; + +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (scm_debug_cell_accesses_p) + { + if (SCM_GC_MARK_P (z)) + { + fprintf(stderr, "scm_cell tried to allocate a marked cell.\n"); + abort(); + } + else if (SCM_GC_CELL_TYPE(z) != scm_tc_free_cell) + { + fprintf(stderr, "cell from freelist is not a free cell.\n"); + abort(); + } + + SCM_SET_GC_MARK (z); + } +#endif + + /* Initialize the type slot last so that the cell is ignored by the GC until it is completely initialized. This is only relevant when the GC can actually run during this code, which it can't for @@ -98,34 +136,31 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) #endif #endif + + return z; } -static inline SCM +EXTERN_INLINE +SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, scm_t_bits ccr, scm_t_bits cdr) { SCM z; -#ifdef GUILE_DEBUG_FREELIST - scm_newcell2_count++; - if (scm_debug_check_freelist) - { - scm_check_freelist (scm_freelist2); - scm_gc(); - } -#endif - if (SCM_NULLP (scm_freelist2)) + if (SCM_NULLP (scm_i_freelist2)) { - z = scm_gc_for_newcell (&scm_master_freelist2, &scm_freelist2); + z = scm_gc_for_newcell (&scm_i_master_freelist2, &scm_i_freelist2); } else { - z = scm_freelist2; - scm_freelist2 = SCM_FREE_CELL_CDR (scm_freelist2); + z = scm_i_freelist2; + scm_i_freelist2 = SCM_FREE_CELL_CDR (scm_i_freelist2); } + scm_cells_allocated += 2; + /* Initialize the type slot last so that the cell is ignored by the GC until it is completely initialized. This is only relevant when the GC can actually run during this code, which it can't for @@ -148,15 +183,23 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, #endif #endif + +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (scm_debug_cell_accesses_p) + { + if (SCM_GC_MARK_P (z)) + { + fprintf(stderr, + "scm_double_cell tried to allocate a marked cell.\n"); + abort(); + } + + SCM_SET_GC_MARK (z); + } +#endif + return z; } -#else /* !HAVE_INLINE */ - -SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr); -SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, - scm_t_bits ccr, scm_t_bits cdr); - #endif - #endif diff --git a/libguile/numbers.c b/libguile/numbers.c index 09b81c7da..53a40a0bd 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -2288,6 +2288,12 @@ big2str (SCM b, unsigned int radix) SCM_BIGDIG radpow = 1, radmod = 0; SCM ss = scm_allocate_string (j); char *s = SCM_STRING_CHARS (ss), c; + + if (i == 0) + { + return scm_makfrom0str ("0"); + } + while ((long) radpow * radix < SCM_BIGRAD) { radpow *= radix; diff --git a/libguile/pairs.c b/libguile/pairs.c index 0b66ee5ca..5fed8d078 100644 --- a/libguile/pairs.c +++ b/libguile/pairs.c @@ -54,7 +54,7 @@ #if (SCM_DEBUG_PAIR_ACCESSES == 1) -#include "libguile/ports.h" +/~#include "libguile/ports.h" #include "libguile/strings.h" void scm_error_pair_access (SCM non_pair) diff --git a/libguile/print.c b/libguile/print.c index 63389f1f5..a5e0fc818 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -739,7 +739,7 @@ scm_ipruk (char *hdr, SCM ptr, SCM port) { scm_puts ("# Date: Sun, 4 Aug 2002 00:18:33 +0000 Subject: [PATCH 086/306] more code --- libguile/gc-freelist.c | 210 +++++++++++++++ libguile/gc-malloc.c | 407 +++++++++++++++++++++++++++++ libguile/gc-mark.c | 562 +++++++++++++++++++++++++++++++++++++++++ libguile/gc-segment.c | 562 +++++++++++++++++++++++++++++++++++++++++ libguile/private-gc.h | 239 ++++++++++++++++++ 5 files changed, 1980 insertions(+) create mode 100644 libguile/gc-freelist.c create mode 100644 libguile/gc-malloc.c create mode 100644 libguile/gc-mark.c create mode 100644 libguile/gc-segment.c create mode 100644 libguile/private-gc.h diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c new file mode 100644 index 000000000..21720534a --- /dev/null +++ b/libguile/gc-freelist.c @@ -0,0 +1,210 @@ +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + +#include + +#include "libguile/private-gc.h" +#include "libguile/gc.h" +#include "libguile/deprecation.h" +#include "libguile/private-gc.h" + +scm_t_cell_type_statistics scm_i_master_freelist; +scm_t_cell_type_statistics scm_i_master_freelist2; + + + + +/* + +In older versions of GUILE GC there was extensive support for +debugging freelists. This was useful, since the freelist was kept +inside the heap, and writing to an object that was GC'd would mangle +the list. Mark bits are now separate, and checking for sane cell +access can be done much more easily by simply checking if the mark bit +is unset before allocation. --hwn + + + +*/ + +#if (SCM_ENABLE_DEPRECATED == 1) +#if defined(GUILE_DEBUG_FREELIST) + +SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0, + (), + "DEPRECATED\n") +#define FUNC_NAME s_scm_map_free_list +{ + scm_c_issue_deprecation_warning ("map-free-list has been removed from GUILE. Doing nothing\n"); + return SCM_UNSPECIFIED; +} + +SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1, 0, 0, + (SCM flag), + "DEPRECATED.\n") +#define FUNC_NAME s_scm_gc_set_debug_check_freelist_x +{ + scm_c_issue_deprecation_warning ("gc-set-debug-check-freelist! has been removed from GUILE. Doing nothing\n"); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + + +#endif /* defined (GUILE_DEBUG) */ +#endif /* deprecated */ + + + + +/* + This adjust FREELIST variables to decide wether or not to allocate + more heap in the next GC run. It uses scm_gc_cells_collected and scm_gc_cells_collected1 + */ + +void +scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist) +{ + /* min yield is adjusted upwards so that next predicted total yield + * (allocated cells actually freed by GC) becomes + * `min_yield_fraction' of total heap size. Note, however, that + * the absolute value of min_yield will correspond to `collected' + * on one master (the one which currently is triggering GC). + * + * The reason why we look at total yield instead of cells collected + * on one list is that we want to take other freelists into account. + * On this freelist, we know that (local) yield = collected cells, + * but that's probably not the case on the other lists. + * + * (We might consider computing a better prediction, for example + * by computing an average over multiple GC:s.) + */ + if (freelist->min_yield_fraction) + { + /* Pick largest of last two yields. */ + long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100) + - (long) SCM_MAX (scm_gc_cells_collected_1, scm_gc_cells_collected)); +#ifdef DEBUGINFO + fprintf (stderr, " after GC = %lu, delta = %ld\n", + (long) scm_cells_allocated, + (long) delta); +#endif + if (delta > 0) + freelist->min_yield += delta; + } +} + + +static void +scm_init_freelist (scm_t_cell_type_statistics *freelist, + int span, + int min_yield) +{ + freelist->heap_segment_idx = -1; + freelist->min_yield = 0; + freelist->min_yield_fraction = min_yield; + freelist->span = span; + freelist->collected = 0; + freelist->collected_1 = 0; + freelist->heap_size = 0; +} + +#if (SCM_ENABLE_DEPRECATED == 1) + size_t scm_default_init_heap_size_1; + int scm_default_min_yield_1; + size_t scm_default_init_heap_size_2; + int scm_default_min_yield_2; + size_t scm_default_max_segment_size; +#endif + +void +scm_gc_init_freelist (void) +{ + size_t init_heap_size_1 + = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1); + + size_t init_heap_size_2 + = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", SCM_DEFAULT_INIT_HEAP_SIZE_2); + + scm_i_freelist = SCM_EOL; + scm_i_freelist2 = SCM_EOL; + + scm_init_freelist (&scm_i_master_freelist2, 2, + scm_getenv_int ("GUILE_MIN_YIELD_2", SCM_DEFAULT_MIN_YIELD_2)); + scm_init_freelist (&scm_i_master_freelist, 1, + scm_getenv_int ("GUILE_MIN_YIELD_1", SCM_DEFAULT_MIN_YIELD_1)); + + + scm_max_segment_size = scm_getenv_int ("GUILE_MAX_SEGMENT_SIZE", SCM_DEFAULT_MAX_SEGMENT_SIZE); + + scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist); + scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2); + + +#if (SCM_ENABLE_DEPRECATED == 1) + if ( scm_default_init_heap_size_1 || + scm_default_min_yield_1|| + scm_default_init_heap_size_2|| + scm_default_min_yield_2|| + scm_default_max_segment_size) + { + scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead."); + } +#endif +} + + +void +scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist) +{ + freelist->collected_1 = freelist->collected; + freelist->collected = 0; + + /* + at the end we simply start with the lowest segment again. + */ + freelist->heap_segment_idx = -1; +} + +int +scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist) +{ + return SCM_MAX (freelist->collected,freelist->collected_1) < freelist->min_yield; +} diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c new file mode 100644 index 000000000..40d4ef907 --- /dev/null +++ b/libguile/gc-malloc.c @@ -0,0 +1,407 @@ +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + +#include +#include +#include + +#ifdef __ia64__ +#include +extern unsigned long * __libc_ia64_register_backing_store_base; +#endif + +#include "libguile/_scm.h" +#include "libguile/eval.h" +#include "libguile/stime.h" +#include "libguile/stackchk.h" +#include "libguile/struct.h" +#include "libguile/smob.h" +#include "libguile/unif.h" +#include "libguile/async.h" +#include "libguile/ports.h" +#include "libguile/root.h" +#include "libguile/strings.h" +#include "libguile/vectors.h" +#include "libguile/weaks.h" +#include "libguile/hashtab.h" +#include "libguile/tags.h" + +#include "libguile/validate.h" +#include "libguile/deprecation.h" +#include "libguile/gc.h" + +#include "libguile/private-gc.h" + +#ifdef GUILE_DEBUG_MALLOC +#include "libguile/debug-malloc.h" +#endif + +#ifdef HAVE_MALLOC_H +#include +#endif + +#ifdef HAVE_UNISTD_H +#include +#endif + +/* + INIT_MALLOC_LIMIT is the initial amount of malloc usage which will + trigger a GC. + + After startup (at the guile> prompt), we have approximately 100k of + alloced memory, which won't go away on GC. Let's set the init such + that we get a nice yield on the next allocation: +*/ +#define SCM_DEFAULT_INIT_MALLOC_LIMIT 200000 +#define SCM_DEFAULT_MALLOC_MINYIELD 40 + + +static int scm_i_minyield_malloc; + +void +scm_gc_init_malloc (void) +{ + scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT", + SCM_DEFAULT_INIT_MALLOC_LIMIT); + scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC", + SCM_DEFAULT_MALLOC_MINYIELD); +} + + + +/* Function for non-cell memory management. + */ + +void * +scm_malloc (size_t size) +{ + void *ptr; + + if (size == 0) + return NULL; + + SCM_SYSCALL (ptr = malloc (size)); + if (ptr) + return ptr; + + scm_i_sweep_all_segments ("malloc"); + SCM_SYSCALL (ptr = malloc (size)); + if (ptr) + return ptr; + + scm_igc ("malloc"); + scm_i_sweep_all_segments ("malloc/gc"); + + SCM_SYSCALL (ptr = malloc (size)); + if (ptr) + return ptr; + + scm_memory_error ("malloc"); +} + +void * +scm_realloc (void *mem, size_t size) +{ + void *ptr; + + SCM_SYSCALL (ptr = realloc (mem, size)); + if (ptr) + return ptr; + + scm_i_sweep_all_segments ("realloc"); + + SCM_SYSCALL (ptr = realloc (mem, size)); + if (ptr) + return ptr; + + scm_igc ("realloc"); + scm_i_sweep_all_segments ("realloc"); + + SCM_SYSCALL (ptr = realloc (mem, size)); + if (ptr) + return ptr; + + scm_memory_error ("realloc"); +} + +char * +scm_strndup (const char *str, size_t n) +{ + char *dst = scm_malloc (n+1); + memcpy (dst, str, n); + dst[n] = 0; + return dst; +} + +char * +scm_strdup (const char *str) +{ + return scm_strndup (str, strlen (str)); +} + +void +scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) +{ + scm_mallocated += size; + + /* + we could finish the full sweep (without mark) here, but in + practice this turns out to be ineffective. + */ + + /* + A program that uses a lot of malloced collectable memory (vectors, + strings), will use a lot of memory off the cell-heap; it needs to + do GC more often (before cells are exhausted), otherwise swapping + and malloc management will tie it down. + */ + if (scm_mallocated > scm_mtrigger) + { + long prev_alloced = scm_mallocated; + float yield; + + scm_igc (what); + scm_i_sweep_all_segments("mtrigger"); + + yield = (prev_alloced - scm_mallocated) / (float) prev_alloced; + + /* + fprintf (stderr, "prev %lud , now %lud, yield %4.2lf, want %d", + prev_alloced, scm_mallocated, 100.0*yield, scm_i_minyield_malloc); + */ + + if (yield < scm_i_minyield_malloc / 100.0) + { + /* + We make the trigger a little larger, even; If you have a + program that builds up a lot of data in strings, then the + desired yield will never be satisfied. + + Instead of getting bogged down, we let the mtrigger grow + strongly with it. + */ + scm_mtrigger = (scm_mallocated * 110) / (100 - scm_i_minyield_malloc); + + /* + fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n", scm_mtrigger); + */ + + + } + } + +#ifdef GUILE_DEBUG_MALLOC + if (mem) + scm_malloc_register (mem, what); +#endif +} + +void +scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what) +{ + scm_mallocated -= size; + scm_gc_malloc_collected += size; + +#ifdef GUILE_DEBUG_MALLOC + if (mem) + scm_malloc_unregister (mem); +#endif +} + +void * +scm_gc_malloc (size_t size, const char *what) +{ + /* + The straightforward implementation below has the problem + that it might call the GC twice, once in scm_malloc and then + again in scm_gc_register_collectable_memory. We don't really + want the second GC since it will not find new garbage. + + + Note: this is a theoretical peeve. In reality, malloc() never + returns NULL. Usually, memory is overcommitted, and when you try + to write it the program is killed with signal 11. --hwn + */ + + void *ptr = scm_malloc (size); + scm_gc_register_collectable_memory (ptr, size, what); + return ptr; +} + +void * +scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what) +{ + /* XXX - see scm_gc_malloc. */ + + void *ptr = scm_realloc (mem, new_size); + scm_gc_unregister_collectable_memory (mem, old_size, what); + scm_gc_register_collectable_memory (ptr, new_size, what); + return ptr; +} + +void +scm_gc_free (void *mem, size_t size, const char *what) +{ + scm_gc_unregister_collectable_memory (mem, size, what); + free (mem); +} + +char * +scm_gc_strndup (const char *str, size_t n, const char *what) +{ + char *dst = scm_gc_malloc (n+1, what); + memcpy (dst, str, n); + dst[n] = 0; + return dst; +} + +char * +scm_gc_strdup (const char *str, const char *what) +{ + return scm_gc_strndup (str, strlen (str), what); +} + +#if SCM_ENABLE_DEPRECATED == 1 + +/* {Deprecated front end to malloc} + * + * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc, + * scm_done_free + * + * These functions provide services comparable to malloc, realloc, and + * free. They should be used when allocating memory that will be under + * control of the garbage collector, i.e., if the memory may be freed + * during garbage collection. + * + * They are deprecated because they weren't really used the way + * outlined above, and making sure to return the right amount from + * smob free routines was sometimes difficult when dealing with nested + * data structures. We basically want everybody to review their code + * and use the more symmetrical scm_gc_malloc/scm_gc_free functions + * instead. In some cases, where scm_must_malloc has been used + * incorrectly (i.e. for non-GC-able memory), use scm_malloc/free. + */ + +void * +scm_must_malloc (size_t size, const char *what) +{ + scm_c_issue_deprecation_warning + ("scm_must_malloc is deprecated. " + "Use scm_gc_malloc and scm_gc_free instead."); + + return scm_gc_malloc (size, what); +} + +void * +scm_must_realloc (void *where, + size_t old_size, + size_t size, + const char *what) +{ + scm_c_issue_deprecation_warning + ("scm_must_realloc is deprecated. " + "Use scm_gc_realloc and scm_gc_free instead."); + + return scm_gc_realloc (where, old_size, size, what); +} + +char * +scm_must_strndup (const char *str, size_t length) +{ + scm_c_issue_deprecation_warning + ("scm_must_strndup is deprecated. " + "Use scm_gc_strndup and scm_gc_free instead."); + + return scm_gc_strndup (str, length, "string"); +} + +char * +scm_must_strdup (const char *str) +{ + scm_c_issue_deprecation_warning + ("scm_must_strdup is deprecated. " + "Use scm_gc_strdup and scm_gc_free instead."); + + return scm_gc_strdup (str, "string"); +} + +void +scm_must_free (void *obj) +#define FUNC_NAME "scm_must_free" +{ + scm_c_issue_deprecation_warning + ("scm_must_free is deprecated. " + "Use scm_gc_malloc and scm_gc_free instead."); + +#ifdef GUILE_DEBUG_MALLOC + scm_malloc_unregister (obj); +#endif + if (obj) + free (obj); + else + SCM_MISC_ERROR ("freeing NULL pointer", SCM_EOL); +} +#undef FUNC_NAME + + +void +scm_done_malloc (long size) +{ + scm_c_issue_deprecation_warning + ("scm_done_malloc is deprecated. " + "Use scm_gc_register_collectable_memory instead."); + + scm_gc_register_collectable_memory (NULL, size, "foreign mallocs"); +} + +void +scm_done_free (long size) +{ + scm_c_issue_deprecation_warning + ("scm_done_free is deprecated. " + "Use scm_gc_unregister_collectable_memory instead."); + + scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs"); +} + +#endif /* SCM_ENABLE_DEPRECATED == 1 */ diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c new file mode 100644 index 000000000..49cb77e29 --- /dev/null +++ b/libguile/gc-mark.c @@ -0,0 +1,562 @@ +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + +#include +#include +#include +#include + +#ifdef __ia64__ +#include +extern unsigned long * __libc_ia64_register_backing_store_base; +#endif + +#include "libguile/_scm.h" +#include "libguile/eval.h" +#include "libguile/stime.h" +#include "libguile/stackchk.h" +#include "libguile/struct.h" +#include "libguile/smob.h" +#include "libguile/unif.h" +#include "libguile/async.h" +#include "libguile/ports.h" +#include "libguile/root.h" +#include "libguile/strings.h" +#include "libguile/vectors.h" +#include "libguile/weaks.h" +#include "libguile/hashtab.h" +#include "libguile/tags.h" +#include "libguile/private-gc.h" +#include "libguile/validate.h" +#include "libguile/deprecation.h" +#include "libguile/gc.h" + +#ifdef GUILE_DEBUG_MALLOC +#include "libguile/debug-malloc.h" +#endif + +#ifdef HAVE_MALLOC_H +#include +#endif + +#ifdef HAVE_UNISTD_H +#include +#endif + + + + +#ifdef __ia64__ +# define SCM_MARK_BACKING_STORE() do { \ + ucontext_t ctx; \ + SCM_STACKITEM * top, * bot; \ + getcontext (&ctx); \ + scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \ + ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \ + / sizeof (SCM_STACKITEM))); \ + bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \ + top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \ + scm_mark_locations (bot, top - bot); } while (0) +#else +# define SCM_MARK_BACKING_STORE() +#endif + +/* + Entry point for this file. + */ +void +scm_mark_all (void) +{ + long j; + + + scm_i_clear_mark_space (); + +#ifndef USE_THREADS + + /* Mark objects on the C stack. */ + SCM_FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, + ( (size_t) (sizeof (SCM_STACKITEM) - 1 + + sizeof scm_save_regs_gc_mark) + / sizeof (SCM_STACKITEM))); + + { + unsigned long stack_len = scm_stack_size (scm_stack_base); +#ifdef SCM_STACK_GROWS_UP + scm_mark_locations (scm_stack_base, stack_len); +#else + scm_mark_locations (scm_stack_base - stack_len, stack_len); +#endif + } + SCM_MARK_BACKING_STORE(); + +#else /* USE_THREADS */ + + /* Mark every thread's stack and registers */ + scm_threads_mark_stacks (); + +#endif /* USE_THREADS */ + + j = SCM_NUM_PROTECTS; + while (j--) + scm_gc_mark (scm_sys_protects[j]); + + /* mark the registered roots */ + { + size_t i; + for (i = 0; i < SCM_VECTOR_LENGTH (scm_gc_registered_roots); ++i) + { + SCM l = SCM_VELTS (scm_gc_registered_roots)[i]; + for (; !SCM_NULLP (l); l = SCM_CDR (l)) + { + SCM *p = (SCM *) (scm_num2long (SCM_CAAR (l), 0, NULL)); + scm_gc_mark (*p); + } + } + } + + /* FIXME: we should have a means to register C functions to be run + * in different phases of GC + */ + scm_mark_subr_table (); + +#ifndef USE_THREADS + scm_gc_mark (scm_root->handle); +#endif +} + +/* {Mark/Sweep} + */ + + +/* + Mark an object precisely, then recurse. + */ +void +scm_gc_mark (SCM ptr) +{ + if (SCM_IMP (ptr)) + return ; + + if (SCM_GC_MARK_P (ptr)) + return; + + SCM_SET_GC_MARK (ptr); + scm_gc_mark_dependencies (ptr); +} + +/* + +Mark the dependencies of an object. + +TODO: + +Should prefetch objects before marking, i.e. if marking a cell, we +should prefetch the car, and then mark the cdr. This will improve CPU +cache misses, because the car is more likely to be in core when we +finish the cdr. + +See http://www.hpl.hp.com/techreports/2000/HPL-2000-99.pdf, reducing +garbage collector cache misses. + +Prefetch is supported on GCC >= 3.1 + + */ +void +scm_gc_mark_dependencies (SCM p) +#define FUNC_NAME "scm_gc_mark_dependencies" +{ + register long i; + register SCM ptr; + scm_t_bits cell_type; + + ptr = p; + scm_mark_dependencies_again: + + cell_type = SCM_GC_CELL_TYPE (ptr); + switch (SCM_ITAG7 (cell_type)) + { + case scm_tcs_cons_nimcar: + if (SCM_IMP (SCM_CDR (ptr))) + { + ptr = SCM_CAR (ptr); + goto gc_mark_nimp; + } + scm_gc_mark (SCM_CAR (ptr)); + ptr = SCM_CDR (ptr); + goto gc_mark_nimp; + case scm_tcs_cons_imcar: + ptr = SCM_CDR (ptr); + goto gc_mark_loop; + case scm_tc7_pws: + scm_gc_mark (SCM_SETTER (ptr)); + ptr = SCM_PROCEDURE (ptr); + goto gc_mark_loop; + case scm_tcs_struct: + { + /* XXX - use less explicit code. */ + scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_struct; + scm_t_bits * vtable_data = (scm_t_bits *) word0; + SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]); + long len = SCM_SYMBOL_LENGTH (layout); + char * fields_desc = SCM_SYMBOL_CHARS (layout); + scm_t_bits * struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr); + + if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) + { + scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_procedure])); + scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_setter])); + } + if (len) + { + long x; + + for (x = 0; x < len - 2; x += 2, ++struct_data) + if (fields_desc[x] == 'p') + scm_gc_mark (SCM_PACK (*struct_data)); + if (fields_desc[x] == 'p') + { + if (SCM_LAYOUT_TAILP (fields_desc[x + 1])) + for (x = *struct_data++; x; --x, ++struct_data) + scm_gc_mark (SCM_PACK (*struct_data)); + else + scm_gc_mark (SCM_PACK (*struct_data)); + } + } + /* mark vtable */ + ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]); + goto gc_mark_loop; + } + break; + case scm_tcs_closures: + if (SCM_IMP (SCM_ENV (ptr))) + { + ptr = SCM_CLOSCAR (ptr); + goto gc_mark_nimp; + } + scm_gc_mark (SCM_CLOSCAR (ptr)); + ptr = SCM_ENV (ptr); + goto gc_mark_nimp; + case scm_tc7_vector: + i = SCM_VECTOR_LENGTH (ptr); + if (i == 0) + break; + while (--i > 0) + if (SCM_NIMP (SCM_VELTS (ptr)[i])) + scm_gc_mark (SCM_VELTS (ptr)[i]); + ptr = SCM_VELTS (ptr)[0]; + goto gc_mark_loop; +#ifdef CCLO + case scm_tc7_cclo: + { + size_t i = SCM_CCLO_LENGTH (ptr); + size_t j; + for (j = 1; j != i; ++j) + { + SCM obj = SCM_CCLO_REF (ptr, j); + if (!SCM_IMP (obj)) + scm_gc_mark (obj); + } + ptr = SCM_CCLO_REF (ptr, 0); + goto gc_mark_loop; + } +#endif +#ifdef HAVE_ARRAYS + case scm_tc7_bvect: + case scm_tc7_byvect: + case scm_tc7_ivect: + case scm_tc7_uvect: + case scm_tc7_fvect: + case scm_tc7_dvect: + case scm_tc7_cvect: + case scm_tc7_svect: +#ifdef HAVE_LONG_LONGS + case scm_tc7_llvect: +#endif +#endif + case scm_tc7_string: + break; + + case scm_tc7_wvect: + SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors); + scm_weak_vectors = ptr; + if (SCM_IS_WHVEC_ANY (ptr)) + { + long x; + long len; + int weak_keys; + int weak_values; + + len = SCM_VECTOR_LENGTH (ptr); + weak_keys = SCM_IS_WHVEC (ptr) || SCM_IS_WHVEC_B (ptr); + weak_values = SCM_IS_WHVEC_V (ptr) || SCM_IS_WHVEC_B (ptr); + + for (x = 0; x < len; ++x) + { + SCM alist; + alist = SCM_VELTS (ptr)[x]; + + /* mark everything on the alist except the keys or + * values, according to weak_values and weak_keys. */ + while ( SCM_CONSP (alist) + && !SCM_GC_MARK_P (alist) + && SCM_CONSP (SCM_CAR (alist))) + { + SCM kvpair; + SCM next_alist; + + kvpair = SCM_CAR (alist); + next_alist = SCM_CDR (alist); + /* + * Do not do this: + * SCM_SET_GC_MARK (alist); + * SCM_SET_GC_MARK (kvpair); + * + * It may be that either the key or value is protected by + * an escaped reference to part of the spine of this alist. + * If we mark the spine here, and only mark one or neither of the + * key and value, they may never be properly marked. + * This leads to a horrible situation in which an alist containing + * freelist cells is exported. + * + * So only mark the spines of these arrays last of all marking. + * If somebody confuses us by constructing a weak vector + * with a circular alist then we are hosed, but at least we + * won't prematurely drop table entries. + */ + if (!weak_keys) + scm_gc_mark (SCM_CAR (kvpair)); + if (!weak_values) + scm_gc_mark (SCM_CDR (kvpair)); + alist = next_alist; + } + if (SCM_NIMP (alist)) + scm_gc_mark (alist); + } + } + break; + + case scm_tc7_symbol: + ptr = SCM_PROP_SLOTS (ptr); + goto gc_mark_loop; + case scm_tc7_variable: + ptr = SCM_CELL_OBJECT_1 (ptr); + goto gc_mark_loop; + case scm_tcs_subrs: + break; + case scm_tc7_port: + i = SCM_PTOBNUM (ptr); +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (!(i < scm_numptob)) + SCM_MISC_ERROR ("undefined port type", SCM_EOL); +#endif + if (SCM_PTAB_ENTRY(ptr)) + scm_gc_mark (SCM_FILENAME (ptr)); + if (scm_ptobs[i].mark) + { + ptr = (scm_ptobs[i].mark) (ptr); + goto gc_mark_loop; + } + else + return; + break; + case scm_tc7_smob: + switch (SCM_TYP16 (ptr)) + { /* should be faster than going through scm_smobs */ + case scm_tc_free_cell: + /* We have detected a free cell. This can happen if non-object data + * on the C stack points into guile's heap and is scanned during + * conservative marking. */ + break; + case scm_tc16_big: + case scm_tc16_real: + case scm_tc16_complex: + break; + default: + i = SCM_SMOBNUM (ptr); +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (!(i < scm_numsmob)) + SCM_MISC_ERROR ("undefined smob type", SCM_EOL); +#endif + if (scm_smobs[i].mark) + { + ptr = (scm_smobs[i].mark) (ptr); + goto gc_mark_loop; + } + else + return; + } + break; + default: + SCM_MISC_ERROR ("unknown type", SCM_EOL); + } + + /* + If we got here, then exhausted recursion options for PTR. we + return (careful not to mark PTR, it might be the argument that we + were called with.) + */ + return ; + +gc_mark_loop: + if (SCM_IMP (ptr)) + return; + + gc_mark_nimp: + { + int valid_cell = CELL_P (ptr); + + +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (scm_debug_cell_accesses_p) + { + /* We are in debug mode. Check the ptr exhaustively. */ + + valid_cell = valid_cell && (scm_i_find_heap_segment_containing_object (ptr) >= 0); + } + +#endif + if (!valid_cell) + SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL); + } + + if (SCM_GC_MARK_P (ptr)) + return; + + SCM_SET_GC_MARK (ptr); + goto scm_mark_dependencies_again; + +} +#undef FUNC_NAME + + + +/* Mark a region conservatively */ +void +scm_mark_locations (SCM_STACKITEM x[], unsigned long n) +{ + unsigned long m; + + for (m = 0; m < n; ++m) + { + SCM obj = * (SCM *) &x[m]; + long int segment = scm_i_find_heap_segment_containing_object (obj); + if (segment >= 0) + scm_gc_mark (obj); + } +} + + +/* The function scm_in_heap_p determines whether an SCM value can be regarded as a + * pointer to a cell on the heap. + */ +int +scm_in_heap_p (SCM value) +{ + long int segment = scm_i_find_heap_segment_containing_object (value); + return (segment >= 0); +} + + +#if SCM_ENABLE_DEPRECATED == 1 + +/* If an allocated cell is detected during garbage collection, this + * means that some code has just obtained the object but was preempted + * before the initialization of the object was completed. This meanst + * that some entries of the allocated cell may already contain SCM + * objects. Therefore, allocated cells are scanned conservatively. + */ + +scm_t_bits scm_tc16_allocated; + +static SCM +allocated_mark (SCM cell) +{ + unsigned long int cell_segment = scm_i_find_heap_segment_containing_object (cell); + unsigned int span = scm_i_heap_segment_table[cell_segment]->span; + unsigned int i; + + for (i = 1; i != span * 2; ++i) + { + SCM obj = SCM_CELL_OBJECT (cell, i); + long int obj_segment = scm_i_find_heap_segment_containing_object (obj); + if (obj_segment >= 0) + scm_gc_mark (obj); + } + return SCM_BOOL_F; +} + +SCM +scm_deprecated_newcell (void) +{ + scm_c_issue_deprecation_warning + ("SCM_NEWCELL is deprecated. Use `scm_cell' instead.\n"); + + return scm_cell (scm_tc16_allocated, 0); +} + +SCM +scm_deprecated_newcell2 (void) +{ + scm_c_issue_deprecation_warning + ("SCM_NEWCELL2 is deprecated. Use `scm_double_cell' instead.\n"); + + return scm_double_cell (scm_tc16_allocated, 0, 0, 0); +} + +#endif /* SCM_ENABLE_DEPRECATED == 1 */ + + +void +scm_gc_init_mark(void) +{ +#if SCM_ENABLE_DEPRECATED == 1 + scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0); + scm_set_smob_mark (scm_tc16_allocated, allocated_mark); +#endif +} + + diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c new file mode 100644 index 000000000..a3859df7b --- /dev/null +++ b/libguile/gc-segment.c @@ -0,0 +1,562 @@ +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + +#include +#include +#include + +#include "libguile/_scm.h" +#include "libguile/pairs.h" +#include "libguile/gc.h" +#include "libguile/private-gc.h" + + + +#define SCM_GC_CARD_BVEC_SIZE_IN_LONGS \ + ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LONG_BITS - 1) / SCM_C_BVEC_LONG_BITS) +#define SCM_GC_IN_CARD_HEADERP(x) \ + (scm_t_cell *) (x) < SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS + + +size_t scm_max_segment_size; + +scm_t_heap_segment * +scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl) +{ + scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment)); + + if (!shs) + { + fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n"); + abort (); + } + + shs->bounds[0] = NULL; + shs->bounds[1] = NULL; + shs->malloced = NULL; + shs->span = fl->span; + shs->freelist = fl; + shs->next_free_card = NULL; + + return shs; +} + + +/* + Fill SEGMENT with memory both for data and mark bits. + + RETURN: 1 on success, 0 failure + */ +int +scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested) +{ + /* + round upwards + */ + int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); + int card_count =1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count; + + /* + one card extra due to alignment + */ + size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD + + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG + ; + scm_t_c_bvec_long * bvec_ptr = 0; + scm_t_cell * memory = 0; + + /* + We use malloc to alloc the heap. On GNU libc this is + equivalent to mmapping /dev/zero + */ + SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed)); + + if (memory == NULL) + return 0; + + segment->malloced = memory; + segment->bounds[0] = SCM_GC_CARD_UP (memory); + segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS; + + segment->freelist->heap_size += scm_i_segment_cell_count (segment); + + bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1]; + + + { + scm_t_cell * ptr = segment->bounds [0]; + + for (; + ptr < segment->bounds[1]; ptr += SCM_GC_CARD_N_CELLS) + { + SCM_GC_CELL_BVEC (ptr) = bvec_ptr; + if (segment->span == 2) + SCM_GC_SET_CARD_DOUBLECELL (ptr); + + bvec_ptr += SCM_GC_CARD_BVEC_SIZE_IN_LONGS; + + /* + Don't init the mem. This is handled by lazy sweeping. + */ + } + } + + segment->next_free_card = segment->bounds[0]; + segment->first_time = 1; + return 1; +} + +int +scm_i_segment_card_count (scm_t_heap_segment * seg) +{ + return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; +} + +/* + Return the number of available single-cell data cells. + */ +int +scm_i_segment_cell_count (scm_t_heap_segment * seg) +{ + return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) + + ((seg->span == 2) ? -1 : 0); +} + +void +scm_i_clear_segment_mark_space (scm_t_heap_segment *seg) +{ + scm_t_cell * markspace = seg->bounds[1]; + + memset (markspace, 0x00, + scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG); +} + +/* + RETURN: + + Freelist. +*/ +SCM +scm_i_sweep_some_cards (scm_t_heap_segment *seg) +{ + SCM cells = SCM_EOL; + int threshold = 512; + int collected = 0; + int (*sweeper) (scm_t_cell *, SCM *, int ) + = (seg->first_time) ? &scm_init_card_freelist : &scm_i_sweep_card; + + scm_t_cell * next_free = seg->next_free_card; + int cards_swept = 0; + + while (collected < threshold && next_free < seg->bounds[1]) + { + collected += (*sweeper) (next_free, &cells, seg->span); + next_free += SCM_GC_CARD_N_CELLS; + cards_swept ++; + } + + scm_gc_cells_swept += cards_swept * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); + scm_gc_cells_collected += collected * seg->span; + seg->freelist->collected += collected * seg->span; + + if(next_free == seg->bounds[1]) + { + seg->first_time = 0; + } + + seg->next_free_card = next_free; + return cells; +} + + +/* + Force a sweep of this entire segment. This doesn't modify sweep + statistics, it just frees the memory pointed to by to-be-swept + cells. + + Implementation is slightly ugh, and how do we handle the swept_cells + statistic? + */ +void +scm_i_sweep_segment (scm_t_heap_segment * seg) +{ + scm_t_cell * p = seg->next_free_card; + int yield = scm_gc_cells_collected; + int coll = seg->freelist->collected; + + while (scm_i_sweep_some_cards (seg) != SCM_EOL) + ; + + scm_gc_cells_collected = yield; + seg->freelist->collected = coll; + + seg->next_free_card =p; +} + +void +scm_i_sweep_all_segments (char const *reason) +{ + int i= 0; + + for (i = 0; i < scm_i_heap_segment_table_size; i++) + { + scm_i_sweep_segment (scm_i_heap_segment_table[i]); + } +} + + +/* + Heap segment table. + + The table is sorted by the address of the data itself. This makes + for easy lookups. This is not portable: according to ANSI C, + pointers can only be compared within the same object (i.e. the same + block of malloced memory.). For machines with weird architectures, + this should be revised. + + (Apparently, for this reason 1.6 and earlier had macros for pointer + comparison. ) + + perhaps it is worthwhile to remove the 2nd level of indirection in + the table, but this certainly makes for cleaner code. +*/ +scm_t_heap_segment ** scm_i_heap_segment_table; +size_t scm_i_heap_segment_table_size; +scm_t_cell *lowest_cell; +scm_t_cell *highest_cell; + + +void +scm_i_clear_mark_space (void) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]); + } +} + + +/* + RETURN: index of inserted segment. + */ +int +scm_i_insert_segment (scm_t_heap_segment * seg) +{ + size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *); + SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **) + realloc ((char *)scm_i_heap_segment_table, size))); + + /* + We can't alloc 4 more bytes. This is hopeless. + */ + if (!scm_i_heap_segment_table) + { + fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n"); + abort (); + } + + if (!lowest_cell) + { + lowest_cell = seg->bounds[0]; + highest_cell = seg->bounds[1]; + } + else + { + lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]); + highest_cell = SCM_MAX (highest_cell, seg->bounds[1]); + } + + + { + int i = 0; + int j = 0; + + while (i < scm_i_heap_segment_table_size + && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0]) + i++; + for (j = scm_i_heap_segment_table_size; j > i; --j) + scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1]; + + scm_i_heap_segment_table [i] = seg; + scm_i_heap_segment_table_size ++; + + return i; + } +} + +SCM +scm_i_sweep_some_segments (scm_t_cell_type_statistics * fl) +{ + int i = fl->heap_segment_idx; + SCM collected =SCM_EOL; + + if (i == -1) + i++; + + for (; + i < scm_i_heap_segment_table_size; i++) + { + if (scm_i_heap_segment_table[i]->freelist != fl) + continue; + + collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i]); + + + if (collected != SCM_EOL) /* Don't increment i */ + break; + } + + fl->heap_segment_idx = i; + + return collected; +} + + + + +void +scm_i_reset_segments (void) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_t_heap_segment * seg = scm_i_heap_segment_table[i]; + seg->next_free_card = seg->bounds[0]; + } +} + + +/* + Determine whether the given value does actually represent a cell in + some heap segment. If this is the case, the number of the heap + segment is returned. Otherwise, -1 is returned. Binary search is + used to determine the heap segment that contains the cell. + + + I think this function is too long to be inlined. --hwn +*/ +long int +scm_i_find_heap_segment_containing_object (SCM obj) +{ + if (!CELL_P (obj)) + return -1; + + if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell) + return -1; + + + { + scm_t_cell * ptr = SCM2PTR (obj); + unsigned long int i = 0; + unsigned long int j = scm_i_heap_segment_table_size - 1; + + if (ptr < scm_i_heap_segment_table[i]->bounds[0]) + return -1; + else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) + return -1; + else + { + while (i < j) + { + if (ptr < scm_i_heap_segment_table[i]->bounds[1]) + { + break; + } + else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr) + { + i = j; + break; + } + else + { + unsigned long int k = (i + j) / 2; + + if (k == i) + return -1; + else if (ptr < scm_i_heap_segment_table[k]->bounds[1]) + { + j = k; + ++i; + if (ptr < scm_i_heap_segment_table[i]->bounds[0]) + return -1; + } + else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr) + { + i = k; + --j; + if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) + return -1; + } + } + } + + if (!DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2) + return -1; + else if (SCM_GC_IN_CARD_HEADERP (ptr)) + return -1; + else + return i; + } + } +} + + +/* + Important entry point: try to grab some memory, and make it into a + segment. + + RETURN: the index of the segment. + */ +int +scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_error error_policy) +{ + size_t len; + + if (scm_gc_heap_lock) + { + /* Critical code sections (such as the garbage collector) aren't + * supposed to add heap segments. + */ + fprintf (stderr, "scm_i_get_new_heap_segment: Can not extend locked heap.\n"); + abort (); + } + + + /* Pick a size for the new heap segment. + * The rule for picking the size of a segment is explained in + * gc.h + */ + { + /* Assure that the new segment is predicted to be large enough. + * + * New yield should at least equal GC fraction of new heap size, i.e. + * + * y + dh > f * (h + dh) + * + * y : yield + * f : min yield fraction + * h : heap size + * dh : size of new heap segment + * + * This gives dh > (f * h - y) / (1 - f) + */ + + /* + where is is this explanation supposed to be? --hwn + */ + int f = freelist->min_yield_fraction; + unsigned long h = SCM_HEAP_SIZE; + size_t min_cells = (f * h - 100 * (long) scm_gc_cells_collected) / (99 - f); + + /* Make heap grow with factor 1.5 */ + len = freelist->heap_size / 2; +#ifdef DEBUGINFO + fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells); +#endif + + /* + Original code adds freelist->cluster_size here. + */ + if (len < min_cells) + len = min_cells; + len *= sizeof (scm_t_cell); + /* force new sampling */ + freelist->collected = LONG_MAX; + } + + if (len > scm_max_segment_size) + len = scm_max_segment_size; + + { + size_t smallest; + scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); + + smallest = 1024 * 10; /* UGH. */ + + if (len < smallest) + len = smallest; + + /* Allocate with decaying ambition. */ + while ((len >= SCM_MIN_HEAP_SEG_SIZE) + && (len >= smallest)) + { + if (scm_i_initialize_heap_segment_data (seg, len)) + { + return scm_i_insert_segment (seg); + } + + len /= 2; + } + } + + if (error_policy == abort_on_error) + { + fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n"); + abort (); + } + return -1; +} + + +void +scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist) +{ + scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); + + if (scm_i_initialize_heap_segment_data (seg, init_heap_size)) + { + freelist->heap_segment_idx = scm_i_insert_segment (seg); + } + + /* + Why the fuck try twice? --hwn + */ + if (!seg->malloced) + { + scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE); + } + + if (freelist->min_yield_fraction) + freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction + / 100); +} + diff --git a/libguile/private-gc.h b/libguile/private-gc.h new file mode 100644 index 000000000..52556bee6 --- /dev/null +++ b/libguile/private-gc.h @@ -0,0 +1,239 @@ +/* + (c) FSF 2002. +*/ + + +#ifndef PRIVATE_GC +#define PRIVATE_GC + +#include "_scm.h" + +/* {heap tuning parameters} + * + * These are parameters for controlling memory allocation. The heap + * is the area out of which scm_cons, and object headers are allocated. + * + * Each heap cell is 8 bytes on a 32 bit machine and 16 bytes on a + * 64 bit machine. The units of the _SIZE parameters are bytes. + * Cons pairs and object headers occupy one heap cell. + * + * SCM_INIT_HEAP_SIZE is the initial size of heap. If this much heap is + * allocated initially the heap will grow by half its current size + * each subsequent time more heap is needed. + * + * If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE + * will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more + * heap is needed. SCM_HEAP_SEG_SIZE must fit into type size_t. This code + * is in scm_init_storage() and alloc_some_heap() in sys.c + * + * If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by + * SCM_EXPHEAP(scm_heap_size) when more heap is needed. + * + * SCM_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap + * is needed. + */ + + +/* + * Heap size 45000 and 40% min yield gives quick startup and no extra + * heap allocation. Having higher values on min yield may lead to + * large heaps, especially if code behaviour is varying its + * maximum consumption between different freelists. + */ + +/* + These values used to be global C variables. However, they're also + available through the environment, and having a double interface is + confusing. Now they're #defines --hwn. + */ + +#define SCM_DEFAULT_INIT_HEAP_SIZE_1 256*1024 +#define SCM_DEFAULT_MIN_YIELD_1 40 +#define SCM_DEFAULT_INIT_HEAP_SIZE_2 32*1024 + +/* The following value may seem large, but note that if we get to GC at + * all, this means that we have a numerically intensive application + */ +#define SCM_DEFAULT_MIN_YIELD_2 40 +#define SCM_DEFAULT_MAX_SEGMENT_SIZE 2097000L /* a little less (adm) than 2 Mb */ + + + +#define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_SIZEOF_CARD) +#define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell)) + + +#define DOUBLECELL_ALIGNED_P(x) (((2 * sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0) + + + + +int scm_getenv_int (const char *var, int def); + + +typedef enum { return_on_error, abort_on_error } policy_on_error; + +/* gc-freelist*/ + +/* + FREELIST: + + A struct holding GC statistics on a particular type of cells. +*/ +typedef struct scm_t_cell_type_statistics { + + /* + heap segment where the last cell was allocated + */ + int heap_segment_idx; + + /* minimum yield on this list in order not to grow the heap + */ + long min_yield; + + /* defines min_yield as percent of total heap size + */ + int min_yield_fraction; + + /* number of cells per object on this list */ + int span; + + /* number of collected cells during last GC */ + unsigned long collected; + + /* number of collected cells during penultimate GC */ + unsigned long collected_1; + + /* total number of cells in heap segments + * belonging to this list. + */ + unsigned long heap_size; + +} scm_t_cell_type_statistics; + + +extern scm_t_cell_type_statistics scm_i_master_freelist; +extern scm_t_cell_type_statistics scm_i_master_freelist2; +extern unsigned long scm_gc_cells_collected_1; + +void scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist); +void scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist); +int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist); + +#define SCM_HEAP_SIZE \ + (scm_i_master_freelist.heap_size + scm_i_master_freelist2.heap_size) + + +#define SCM_MAX(A, B) ((A) > (B) ? (A) : (B)) +#define SCM_MIN(A, B) ((A) < (B) ? (A) : (B)) + +#define CELL_P(x) (SCM_ITAG3 (x) == scm_tc3_cons) + +/* + gc-mark + */ + + +void scm_mark_all (void); + + + +/* +gc-segment: +*/ + + + + +/* + + Cells are stored in a heap-segment: it is a contiguous chunk of + memory, that associated with one freelist. +*/ + +typedef struct scm_t_heap_segment +{ + /* + {lower, upper} bounds of the segment + + The upper bound is also the start of the mark space. + */ + scm_t_cell *bounds[2]; + + /* + If we ever decide to give it back, we could do it with this ptr. + + Note that giving back memory is not very useful; as long we don't + touch a chunk of memory, the virtual memory system will keep it + swapped out. We could simply forget about a block. + + (not that we do that, but anyway.) + */ + + void* malloced; + + scm_t_cell * next_free_card; + + /* address of the head-of-freelist pointer for this segment's cells. + All segments usually point to the same one, scm_i_freelist. */ + scm_t_cell_type_statistics *freelist; + + /* number of cells per object in this segment */ + int span; + + + /* + Is this the first time that the cells are accessed? + */ + int first_time; + +} scm_t_heap_segment; + + + +/* + + A table of segment records is kept that records the upper and + lower extents of the segment; this is used during the conservative + phase of gc to identify probably gc roots (because they point + into valid segments at reasonable offsets). + +*/ +extern scm_t_heap_segment ** scm_i_heap_segment_table; +extern size_t scm_i_heap_segment_table_size; + + +int scm_init_card_freelist (scm_t_cell * card, SCM *free_list,int); +int scm_i_sweep_card (scm_t_cell * card, SCM *free_list,int); +int scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested); +int scm_i_segment_card_count (scm_t_heap_segment * seg); +int scm_i_segment_cell_count (scm_t_heap_segment * seg); + +void scm_i_clear_segment_mark_space (scm_t_heap_segment *seg); +scm_t_heap_segment * scm_i_make_empty_heap_segment (scm_t_cell_type_statistics*); +SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg); +void scm_i_sweep_segment (scm_t_heap_segment * seg); + + +int scm_i_insert_segment (scm_t_heap_segment * seg); +long int scm_i_find_heap_segment_containing_object (SCM obj); +int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *, policy_on_error); +void scm_i_clear_mark_space (void); +void scm_i_sweep_segments (void); +SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics * fl); +void scm_i_reset_segments (void); +void scm_i_sweep_all_segments (char const *reason); +void scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist); + +extern long int scm_i_deprecated_memory_return; + + +/* + global init funcs. + */ +void scm_gc_init_malloc (void); +void scm_gc_init_freelist (void); +void scm_gc_init_segments (void); +void scm_gc_init_mark (void); + +#endif From c2cbcc57687ca716fb3e2166859b7be5880d80e2 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 4 Aug 2002 14:09:14 +0000 Subject: [PATCH 087/306] gc statistic tweaks --- ChangeLog | 4 ++++ NEWS | 23 +++++++++++++++++++++++ libguile/ChangeLog | 7 +++++-- libguile/dynl.c | 13 +++++++------ libguile/gc-malloc.c | 10 +++++----- libguile/gc-segment.c | 15 ++++++++++++--- libguile/gc.c | 35 +++++++++++++++++++++++------------ libguile/gc.h | 4 +++- libguile/private-gc.h | 1 + 9 files changed, 83 insertions(+), 29 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9f3b87388..fd4a89dc1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2002-08-04 Han-Wen + + * NEWS: add entries for GC and vector WB. + 2002-07-22 Han-Wen * autogen.sh (mscripts): find and check version number of diff --git a/NEWS b/NEWS index 1655989ff..611ca7239 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,29 @@ Changes since the stable branch: * Changes to the standalone interpreter +** SCM_VELTS macros is now read-only. For writing, use the new macros +SCM_WRITABLE_VELTS, SCM_SET_VECTOR_LENGTH. The use of +SCM_WRITABLE_VELTS is discouraged, though. + +** Garbage collector rewrite. + +The garbage collector is cleaned up a lot, and now uses lazy +sweeping. This is reflected in the output of (gc-stats); since cells +are being freed when they are allocated, the cells-allocated field +stays roughly constant. + +For malloc related triggers, the behavior is changed. It uses the same +heuristic as the cell-triggered collections. It may be tuned with the +environment variables GUILE_MIN_YIELD_MALLOC. This is the percentage +for minimum yield of malloc related triggers; (default: 40) +GUILE_INIT_MALLOC_LIMIT is the trigger for doing a GC. The default is +200 kb. + +Debugging operations for the freelist have been deprecated, along with +the C variables that control garbage collection. The environment +variables GUILE_MAX_SEGMENT_SIZE, GUILE_INIT_SEGMENT_SIZE_2, +GUILE_INIT_SEGMENT_SIZE_1, and GUILE_MIN_YIELD_2 should be used. + ** New command line option `--no-debug'. Specifying `--no-debug' on the command line will keep the debugging diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7ec6feb57..8bbe74abb 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,9 +1,12 @@ 2002-08-04 Han-Wen + * gc.c (s_scm_gc_stats): add cell-yield and malloc-yield statistic + to gc-stats. + * numbers.c (big2str): return "0" for 0 iso. "" - * gc-segment.c, gc-malloc.c gc-mark.c, gc-freelist.c, gc-card.c, private-gc.h: - new file + * gc-segment.c, gc-malloc.c gc-mark.c, gc-freelist.c, gc-card.c, + private-gc.h: new file * gc.c: completely revised and cleaned up the GC. It now uses lazy sweeping. More documentation in workbook/newgc.text diff --git a/libguile/dynl.c b/libguile/dynl.c index 4cc46d1e3..cb1e71fbd 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -77,13 +77,14 @@ maybe_drag_in_eprintf () #include "libltdl/ltdl.h" -/* From the libtool manual: "Note that libltdl is not threadsafe, - i.e. a multithreaded application has to use a mutex for libltdl.". +/* + From the libtool manual: "Note that libltdl is not threadsafe, + i.e. a multithreaded application has to use a mutex for libltdl.". - Guile does not currently support pre-emptive threads, so there is - no mutex. Previously SCM_DEFER_INTS and SCM_ALLOW_INTS were used: - they are mentioned here in case somebody is grepping for thread - problems ;) + Guile does not currently support pre-emptive threads, so there is + no mutex. Previously SCM_DEFER_INTS and SCM_ALLOW_INTS were used: + they are mentioned here in case somebody is grepping for thread + problems ;) */ static void * diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 40d4ef907..a1d8f2dc8 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -92,7 +92,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base; alloced memory, which won't go away on GC. Let's set the init such that we get a nice yield on the next allocation: */ -#define SCM_DEFAULT_INIT_MALLOC_LIMIT 200000 +#define SCM_DEFAULT_INIT_MALLOC_LIMIT 200*1024 #define SCM_DEFAULT_MALLOC_MINYIELD 40 @@ -203,8 +203,8 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) scm_igc (what); scm_i_sweep_all_segments("mtrigger"); - yield = (prev_alloced - scm_mallocated) / (float) prev_alloced; - + yield = (prev_alloced - scm_mallocated) / (float) prev_alloced; + scm_gc_malloc_yield_percentage = (int) (100 * yield); /* fprintf (stderr, "prev %lud , now %lud, yield %4.2lf, want %d", prev_alloced, scm_mallocated, 100.0*yield, scm_i_minyield_malloc); @@ -225,9 +225,9 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) /* fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n", scm_mtrigger); */ - - } + + } #ifdef GUILE_DEBUG_MALLOC diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index a3859df7b..d3a48f2ab 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -195,7 +195,12 @@ scm_i_sweep_some_cards (scm_t_heap_segment *seg) scm_gc_cells_swept += cards_swept * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); scm_gc_cells_collected += collected * seg->span; + + if (!seg->first_time) + scm_cells_allocated -= collected * seg->span; + seg->freelist->collected += collected * seg->span; + if(next_free == seg->bounds[1]) { @@ -212,8 +217,10 @@ scm_i_sweep_some_cards (scm_t_heap_segment *seg) statistics, it just frees the memory pointed to by to-be-swept cells. - Implementation is slightly ugh, and how do we handle the swept_cells - statistic? + Implementation is slightly ugh. + + FIXME: if you do scm_i_sweep_segment(), and then allocate from this + segment again, the statistics are off. */ void scm_i_sweep_segment (scm_t_heap_segment * seg) @@ -221,11 +228,13 @@ scm_i_sweep_segment (scm_t_heap_segment * seg) scm_t_cell * p = seg->next_free_card; int yield = scm_gc_cells_collected; int coll = seg->freelist->collected; - + int alloc = scm_cells_allocated ; + while (scm_i_sweep_some_cards (seg) != SCM_EOL) ; scm_gc_cells_collected = yield; + scm_cells_allocated = alloc; seg->freelist->collected = coll; seg->next_free_card =p; diff --git a/libguile/gc.c b/libguile/gc.c index 0a4a1cfad..58ede2266 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -256,7 +256,7 @@ SCM scm_structs_to_free; /* GC Statistics Keeping */ -unsigned long scm_cells_allocated = 0; +long scm_cells_allocated = 0; unsigned long scm_mallocated = 0; unsigned long scm_gc_cells_collected; unsigned long scm_gc_cells_collected_1 = 0; /* previous GC yield */ @@ -264,12 +264,14 @@ unsigned long scm_gc_malloc_collected; unsigned long scm_gc_ports_collected; unsigned long scm_gc_time_taken = 0; static unsigned long t_before_gc; -static unsigned long t_before_sweep; unsigned long scm_gc_mark_time_taken = 0; unsigned long scm_gc_times = 0; unsigned long scm_gc_cells_swept = 0; double scm_gc_cells_marked_acc = 0.; double scm_gc_cells_swept_acc = 0.; +int scm_gc_cell_yield_percentage =0; +int scm_gc_malloc_yield_percentage = 0; + SCM_SYMBOL (sym_cells_allocated, "cells-allocated"); SCM_SYMBOL (sym_heap_size, "cell-heap-size"); @@ -281,6 +283,8 @@ SCM_SYMBOL (sym_gc_mark_time_taken, "gc-mark-time-taken"); SCM_SYMBOL (sym_times, "gc-times"); SCM_SYMBOL (sym_cells_marked, "cells-marked"); SCM_SYMBOL (sym_cells_swept, "cells-swept"); +SCM_SYMBOL (sym_malloc_yield, "malloc-yield"); +SCM_SYMBOL (sym_cell_yield, "cell-yield"); @@ -292,7 +296,7 @@ unsigned scm_newcell2_count; /* {Scheme Interface to GC} */ - +extern int scm_gc_malloc_yield_percentage; SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, (), "Return an association list of statistics about Guile's current\n" @@ -304,7 +308,9 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, unsigned long int local_scm_mtrigger; unsigned long int local_scm_mallocated; unsigned long int local_scm_heap_size; - unsigned long int local_scm_cells_allocated; + int local_scm_gc_cell_yield_percentage; + int local_scm_gc_malloc_yield_percentage; + long int local_scm_cells_allocated; unsigned long int local_scm_gc_time_taken; unsigned long int local_scm_gc_times; unsigned long int local_scm_gc_mark_time_taken; @@ -341,14 +347,16 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, local_scm_gc_time_taken = scm_gc_time_taken; local_scm_gc_mark_time_taken = scm_gc_mark_time_taken; local_scm_gc_times = scm_gc_times; - - - local_scm_gc_cells_swept = scm_gc_cells_swept_acc + scm_gc_cells_swept; + local_scm_gc_malloc_yield_percentage = scm_gc_malloc_yield_percentage; + local_scm_gc_cell_yield_percentage= scm_gc_cell_yield_percentage; + + local_scm_gc_cells_swept = + (double) scm_gc_cells_swept_acc + + (double) scm_gc_cells_swept; local_scm_gc_cells_marked = scm_gc_cells_marked_acc +(double) scm_gc_cells_swept -(double) scm_gc_cells_collected; - for (i = table_size; i--;) { heap_segs = scm_cons (scm_cons (scm_ulong2num (bounds[2*i]), @@ -357,7 +365,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, } answer = scm_list_n (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)), - scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)), + scm_cons (sym_cells_allocated, scm_long2num (local_scm_cells_allocated)), scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)), scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)), scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)), @@ -365,6 +373,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_cons (sym_gc_mark_time_taken, scm_ulong2num (local_scm_gc_mark_time_taken)), scm_cons (sym_cells_marked, scm_i_dbl2big (local_scm_gc_cells_marked)), scm_cons (sym_cells_swept, scm_i_dbl2big (local_scm_gc_cells_swept)), + scm_cons (sym_malloc_yield, scm_long2num (local_scm_gc_malloc_yield_percentage)), + scm_cons (sym_cell_yield, scm_long2num (local_scm_gc_cell_yield_percentage)), scm_cons (sym_heap_segments, heap_segs), SCM_UNDEFINED); SCM_ALLOW_INTS; @@ -381,8 +391,10 @@ gc_start_stats (const char *what SCM_UNUSED) scm_gc_cells_marked_acc += (double) scm_gc_cells_swept - (double) scm_gc_cells_collected; - scm_gc_cells_swept_acc += scm_gc_cells_swept; + scm_gc_cells_swept_acc += (double) scm_gc_cells_swept; + scm_gc_cell_yield_percentage = ( scm_gc_cells_collected * 100 ) / SCM_HEAP_SIZE; + scm_gc_cells_swept = 0; scm_gc_cells_collected_1 = scm_gc_cells_collected; @@ -554,8 +566,7 @@ scm_igc (const char *what) scm_mark_all (); - t_before_sweep = scm_c_get_internal_run_time (); - scm_gc_mark_time_taken += (t_before_sweep - t_before_gc); + scm_gc_mark_time_taken += (scm_c_get_internal_run_time () - t_before_gc); scm_c_hook_run (&scm_before_sweep_c_hook, 0); diff --git a/libguile/gc.h b/libguile/gc.h index bd86ad1f0..1e688d65a 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -284,7 +284,9 @@ SCM_API unsigned long scm_gc_cells_collected; SCM_API unsigned long scm_gc_cells_collected; SCM_API unsigned long scm_gc_malloc_collected; SCM_API unsigned long scm_gc_ports_collected; -SCM_API unsigned long scm_cells_allocated; +SCM_API long scm_cells_allocated; +SCM_API int scm_gc_cell_yield_percentage; +SCM_API int scm_gc_malloc_yield_percentage; SCM_API unsigned long scm_mallocated; SCM_API unsigned long scm_mtrigger; diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 52556bee6..3924e5044 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -109,6 +109,7 @@ typedef struct scm_t_cell_type_statistics { */ unsigned long heap_size; + } scm_t_cell_type_statistics; From 402788a93821879d278afd2f8309eed7e7e2e9c4 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 4 Aug 2002 15:25:07 +0000 Subject: [PATCH 088/306] port GC fix --- libguile/ChangeLog | 10 +++++++++- libguile/fports.c | 9 ++++----- libguile/ports.c | 39 +++++++++++++++++++-------------------- libguile/ports.h | 2 +- libguile/strports.c | 4 +++- libguile/vports.c | 8 +++++--- 6 files changed, 41 insertions(+), 31 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 8bbe74abb..d4f91408e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,4 +1,12 @@ -2002-08-04 Han-Wen + +2002-08-04 Han-Wen Nienhuys + + * ports.c (scm_new_port_table_entry): change function from + scm_add_to_port_table. This prevents cells with null-pointers from + being exposed to GC. + + * vports.c (s_scm_make_soft_port) strports.c (scm_mkstrport), + fports.c (scm_fdes_to_port): Use scm_new_port_table_entry(). * gc.c (s_scm_gc_stats): add cell-yield and malloc-yield statistic to gc-stats. diff --git a/libguile/fports.c b/libguile/fports.c index 8424f2e2e..36ea33115 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -436,12 +436,11 @@ scm_fdes_to_port (int fdes, char *mode, SCM name) SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL); } - port = scm_cell (scm_tc16_fport, 0); SCM_DEFER_INTS; - pt = scm_add_to_port_table (port); - SCM_SETPTAB_ENTRY (port, pt); - SCM_SET_CELL_TYPE (port, (scm_tc16_fport | mode_bits)); - + pt = scm_new_port_table_entry (); + port = scm_cell (scm_tc16_fport | mode_bits, (scm_t_bits) pt); + pt->port = port; + { scm_t_fport *fp = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port"); diff --git a/libguile/ports.c b/libguile/ports.c index 057327460..6372e8f67 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -451,13 +451,12 @@ scm_t_port **scm_port_table; long scm_port_table_size = 0; /* Number of ports in scm_port_table. */ long scm_port_table_room = 20; /* Size of the array. */ -/* Add a port to the table. */ scm_t_port * -scm_add_to_port_table (SCM port) -#define FUNC_NAME "scm_add_to_port_table" +scm_new_port_table_entry (void) +#define FUNC_NAME "scm_new_port_table_entry" { - scm_t_port *entry; + scm_t_port *entry = (scm_t_port *) scm_gc_malloc (sizeof (scm_t_port), "port"); if (scm_port_table_size == scm_port_table_room) { @@ -469,9 +468,8 @@ scm_add_to_port_table (SCM port) scm_port_table = (scm_t_port **) newt; scm_port_table_room *= 2; } - entry = (scm_t_port *) scm_gc_malloc (sizeof (scm_t_port), "port"); - entry->port = port; + entry->port = SCM_EOL; entry->entry = scm_port_table_size; entry->revealed = 0; entry->stream = 0; @@ -491,7 +489,6 @@ scm_add_to_port_table (SCM port) #undef FUNC_NAME /* Remove a port from the table and destroy it. */ - void scm_remove_from_port_table (SCM port) #define FUNC_NAME "scm_remove_from_port_table" @@ -1527,20 +1524,22 @@ write_void_port (SCM port SCM_UNUSED, SCM scm_void_port (char *mode_str) { - int mode_bits; - SCM answer; - scm_t_port * pt; - - answer = scm_cell (scm_tc16_void_port, 0); SCM_DEFER_INTS; - mode_bits = scm_mode_bits (mode_str); - pt = scm_add_to_port_table (answer); - scm_port_non_buffer (pt); - SCM_SETPTAB_ENTRY (answer, pt); - SCM_SETSTREAM (answer, 0); - SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits); - SCM_ALLOW_INTS; - return answer; + { + int mode_bits = scm_mode_bits (mode_str); + scm_t_port * pt = scm_new_port_table_entry (); + SCM answer; + + scm_port_non_buffer (pt); + answer = scm_cell (scm_tc16_void_port, 0); + SCM_SETPTAB_ENTRY (answer, pt); + pt->port = answer; + + SCM_SETSTREAM (answer, 0); + SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits); + SCM_ALLOW_INTS; + return answer; + } } SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 1, 0, 0, diff --git a/libguile/ports.h b/libguile/ports.h index 500a3802a..3e7a0dfcb 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -257,7 +257,7 @@ SCM_API SCM scm_current_load_port (void); SCM_API SCM scm_set_current_input_port (SCM port); SCM_API SCM scm_set_current_output_port (SCM port); SCM_API SCM scm_set_current_error_port (SCM port); -SCM_API scm_t_port * scm_add_to_port_table (SCM port); +SCM_API scm_t_port * scm_new_port_table_entry (void); SCM_API void scm_remove_from_port_table (SCM port); SCM_API void scm_grow_port_cbuf (SCM port, size_t requested); SCM_API SCM scm_pt_size (void); diff --git a/libguile/strports.c b/libguile/strports.c index 0d00047fc..5c3634314 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -281,9 +281,11 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); z = scm_cell (scm_tc16_strport, 0); SCM_DEFER_INTS; - pt = scm_add_to_port_table (z); + pt = scm_new_port_table_entry (); SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes); SCM_SETPTAB_ENTRY (z, pt); + pt->port = z; + SCM_SETSTREAM (z, SCM_UNPACK (str)); pt->write_buf = pt->read_buf = SCM_STRING_UCHARS (str); pt->read_pos = pt->write_pos = pt->read_buf + SCM_INUM (pos); diff --git a/libguile/vports.c b/libguile/vports.c index ce5ea7925..6addd2b0c 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -189,12 +189,14 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, SCM z; SCM_VALIDATE_VECTOR_LEN (1, pv,5); SCM_VALIDATE_STRING (2, modes); - z = scm_cell (scm_tc16_sfport, 0); + SCM_DEFER_INTS; - pt = scm_add_to_port_table (z); + pt = scm_new_port_table_entry (); scm_port_non_buffer (pt); - SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_STRING_CHARS (modes))); + z = scm_cell (scm_tc16_sfport | scm_mode_bits (SCM_STRING_CHARS (modes)), 0); SCM_SETPTAB_ENTRY (z, pt); + pt->port = z; + SCM_SETSTREAM (z, SCM_UNPACK (pv)); SCM_ALLOW_INTS; return z; From 5f16b8973e5bd36e7bf7c0e0f44966c5134f2c70 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 4 Aug 2002 16:10:19 +0000 Subject: [PATCH 089/306] init port entry --- libguile/ChangeLog | 4 +++- libguile/ports.c | 10 +++------- libguile/strports.c | 6 ++++-- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d4f91408e..0c0c8042f 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,7 @@ +2002-08-04 Han-Wen -2002-08-04 Han-Wen Nienhuys + * ports.c (scm_new_port_table_entry): init port entry to 0 + completely. * ports.c (scm_new_port_table_entry): change function from scm_add_to_port_table. This prevents cells with null-pointers from diff --git a/libguile/ports.c b/libguile/ports.c index 6372e8f67..70f402651 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -457,6 +457,7 @@ scm_new_port_table_entry (void) #define FUNC_NAME "scm_new_port_table_entry" { scm_t_port *entry = (scm_t_port *) scm_gc_malloc (sizeof (scm_t_port), "port"); + memset (entry, 0x0, sizeof (scm_t_port)); if (scm_port_table_size == scm_port_table_room) { @@ -471,15 +472,10 @@ scm_new_port_table_entry (void) entry->port = SCM_EOL; entry->entry = scm_port_table_size; - entry->revealed = 0; - entry->stream = 0; + entry->file_name = SCM_BOOL_F; - entry->line_number = 0; - entry->column_number = 0; - entry->putback_buf = 0; - entry->putback_buf_size = 0; entry->rw_active = SCM_PORT_NEITHER; - entry->rw_random = 0; + scm_port_table[scm_port_table_size] = entry; scm_port_table_size++; diff --git a/libguile/strports.c b/libguile/strports.c index 5c3634314..94aa928f5 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -279,12 +279,14 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) scm_out_of_range (caller, pos); if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); - z = scm_cell (scm_tc16_strport, 0); + SCM_DEFER_INTS; pt = scm_new_port_table_entry (); - SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes); + z = scm_cell (scm_tc16_strport | modes, 0); + SCM_SETPTAB_ENTRY (z, pt); pt->port = z; + SCM_SETSTREAM (z, SCM_UNPACK (str)); pt->write_buf = pt->read_buf = SCM_STRING_UCHARS (str); From f5f45abe9feaae199857a70484c5275722352b79 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sun, 4 Aug 2002 19:49:56 +0000 Subject: [PATCH 090/306] minor help-line edit --- configure.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.in b/configure.in index e052141cc..787f2429c 100644 --- a/configure.in +++ b/configure.in @@ -112,7 +112,7 @@ AC_ARG_ENABLE(htmldoc, AM_CONDITIONAL(HTMLDOC, test x$htmldoc_enabled = xyes) AC_ARG_ENABLE(deprecated, - [ --disable-deprecated omit deprecated features [no]]) + [ --disable-deprecated omit deprecated features]) AH_TEMPLATE([SCM_ENABLE_DEPRECATED], [Define this to 1 if you want to include deprecated features.]) From 39e8f371e20c99381b9270307539121c76358294 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 4 Aug 2002 23:33:28 +0000 Subject: [PATCH 091/306] (INPUT_ERROR): Prepare for file:line:column error messages for errors in scm_lreadr() and friends. --- ChangeLog | 4 +++ NEWS | 48 +++++++++++++-------------- configure.in | 1 + libguile/ChangeLog | 11 +++++++ libguile/gc-malloc.c | 43 +++++++++---------------- libguile/gc.h | 1 + libguile/ports.c | 4 +-- libguile/read.c | 77 ++++++++++++++++++++++++++++++++++++++------ 8 files changed, 126 insertions(+), 63 deletions(-) diff --git a/ChangeLog b/ChangeLog index fd4a89dc1..26554f651 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2002-08-05 Han-Wen Nienhuys + + * configure.in: add snprintf + 2002-08-04 Han-Wen * NEWS: add entries for GC and vector WB. diff --git a/NEWS b/NEWS index 611ca7239..0734b3bfd 100644 --- a/NEWS +++ b/NEWS @@ -8,29 +8,6 @@ Changes since the stable branch: * Changes to the standalone interpreter -** SCM_VELTS macros is now read-only. For writing, use the new macros -SCM_WRITABLE_VELTS, SCM_SET_VECTOR_LENGTH. The use of -SCM_WRITABLE_VELTS is discouraged, though. - -** Garbage collector rewrite. - -The garbage collector is cleaned up a lot, and now uses lazy -sweeping. This is reflected in the output of (gc-stats); since cells -are being freed when they are allocated, the cells-allocated field -stays roughly constant. - -For malloc related triggers, the behavior is changed. It uses the same -heuristic as the cell-triggered collections. It may be tuned with the -environment variables GUILE_MIN_YIELD_MALLOC. This is the percentage -for minimum yield of malloc related triggers; (default: 40) -GUILE_INIT_MALLOC_LIMIT is the trigger for doing a GC. The default is -200 kb. - -Debugging operations for the freelist have been deprecated, along with -the C variables that control garbage collection. The environment -variables GUILE_MAX_SEGMENT_SIZE, GUILE_INIT_SEGMENT_SIZE_2, -GUILE_INIT_SEGMENT_SIZE_1, and GUILE_MIN_YIELD_2 should be used. - ** New command line option `--no-debug'. Specifying `--no-debug' on the command line will keep the debugging @@ -126,6 +103,29 @@ during evaluation, but prior to evaluation. * Changes to the C interface +** The SCM_VELTS macros now returns a read-only vector. For writing, +use the new macros SCM_WRITABLE_VELTS, SCM_SET_VECTOR_LENGTH. The use +of SCM_WRITABLE_VELTS is discouraged, though. + +** Garbage collector rewrite. + +The garbage collector is cleaned up a lot, and now uses lazy +sweeping. This is reflected in the output of (gc-stats); since cells +are being freed when they are allocated, the cells-allocated field +stays roughly constant. + +For malloc related triggers, the behavior is changed. It uses the same +heuristic as the cell-triggered collections. It may be tuned with the +environment variables GUILE_MIN_YIELD_MALLOC. This is the percentage +for minimum yield of malloc related triggers. The default is 40. +GUILE_INIT_MALLOC_LIMIT sets the initial trigger for doing a GC. The +default is 200 kb. + +Debugging operations for the freelist have been deprecated, along with +the C variables that control garbage collection. The environment +variables GUILE_MAX_SEGMENT_SIZE, GUILE_INIT_SEGMENT_SIZE_2, +GUILE_INIT_SEGMENT_SIZE_1, and GUILE_MIN_YIELD_2 should be used. + ** The struct scm_cell has been renamed to scm_t_cell This is in accordance to Guile's naming scheme for types. Note that @@ -143,7 +143,7 @@ The new functions are more symmetrical and do not need cooperation from smob free routines, among other improvements. The new functions are scm_malloc, scm_realloc, scm_strdup, -scm_strndup, scm_gc_malloc, scm_gc_realloc, scm_gc_free, +scm_strndup, scm_gc_malloc, scm_gc_calloc, scm_gc_realloc, scm_gc_free, scm_gc_register_collectable_memory, and scm_gc_unregister_collectable_memory. Refer to the manual for more details and for upgrading instructions. diff --git a/configure.in b/configure.in index 787f2429c..01f1a1b5a 100644 --- a/configure.in +++ b/configure.in @@ -276,6 +276,7 @@ AC_CHECK_FUNCS(gethostbyname) if test $ac_cv_func_gethostbyname = no; then AC_CHECK_LIB(nsl, gethostbyname) fi + AC_CHECK_FUNCS(connect) if test $ac_cv_func_connect = no; then AC_CHECK_LIB(socket, connect) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 0c0c8042f..ccef7d069 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,14 @@ +2002-08-05 Han-Wen Nienhuys + + * read.c (INPUT_ERROR): Prepare for file:line:column error + messages for errors in scm_lreadr() and friends. + +2002-08-04 Han-Wen Nienhuys + + * gc-malloc.c (scm_malloc): use scm_realloc() (simplifies + implementation). + (scm_gc_calloc): new function + 2002-08-04 Han-Wen * ports.c (scm_new_port_table_entry): init port entry to 0 diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index a1d8f2dc8..2720ed8d8 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -112,33 +112,6 @@ scm_gc_init_malloc (void) /* Function for non-cell memory management. */ -void * -scm_malloc (size_t size) -{ - void *ptr; - - if (size == 0) - return NULL; - - SCM_SYSCALL (ptr = malloc (size)); - if (ptr) - return ptr; - - scm_i_sweep_all_segments ("malloc"); - SCM_SYSCALL (ptr = malloc (size)); - if (ptr) - return ptr; - - scm_igc ("malloc"); - scm_i_sweep_all_segments ("malloc/gc"); - - SCM_SYSCALL (ptr = malloc (size)); - if (ptr) - return ptr; - - scm_memory_error ("malloc"); -} - void * scm_realloc (void *mem, size_t size) { @@ -164,6 +137,13 @@ scm_realloc (void *mem, size_t size) scm_memory_error ("realloc"); } +void * +scm_malloc (size_t sz) +{ + return scm_realloc (NULL, sz); +} + + char * scm_strndup (const char *str, size_t n) { @@ -268,6 +248,15 @@ scm_gc_malloc (size_t size, const char *what) return ptr; } +void * +scm_gc_calloc (size_t size, const char *what) +{ + void *ptr = scm_gc_malloc (size, what); + memset (ptr, 0x0, size); + return ptr; +} + + void * scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what) { diff --git a/libguile/gc.h b/libguile/gc.h index 1e688d65a..bce48debd 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -337,6 +337,7 @@ SCM_API void scm_gc_register_collectable_memory (void *mem, size_t size, const char *what); SCM_API void scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what); +SCM_API void *scm_gc_calloc (size_t size, const char *what); SCM_API void *scm_gc_malloc (size_t size, const char *what); SCM_API void *scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what); diff --git a/libguile/ports.c b/libguile/ports.c index 70f402651..b93fa9d8d 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -456,9 +456,7 @@ scm_t_port * scm_new_port_table_entry (void) #define FUNC_NAME "scm_new_port_table_entry" { - scm_t_port *entry = (scm_t_port *) scm_gc_malloc (sizeof (scm_t_port), "port"); - memset (entry, 0x0, sizeof (scm_t_port)); - + scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port"); if (scm_port_table_size == scm_port_table_room) { /* initial malloc is in gc.c. this doesn't use scm_gc_malloc etc., diff --git a/libguile/read.c b/libguile/read.c index f829cd535..6b85d0fc8 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -75,6 +75,65 @@ scm_t_option scm_read_opts[] = { "Style of keyword recognition: #f or 'prefix."} }; +/* + Give meaningful error messages for errors + + We use the format + + MESSAGE + This happened in .... + + This is not standard GNU format, but the test-suite likes the real + message to be in front. + + Hmmm. + + Maybe this is a kludge? Perhaps we should throw (list EXPR FILENAME + LINENO COLUMNO), and have the exception handler sort out the error + message?Where does the handler live, what are the conventions for + the expression argument of the handler? How does this work for an + error message like + +Backtrace: +In standard input: + 4: 0* [list ... + +standard input:4:1: While evaluating arguments to list in expression (list a b):standard input:4:1: Unbound variable: a +ABORT: (unbound-variable) + + + + In any case, we would have to assemble that information anyway. + */ + + +#if 0 + +#ifndef HAVE_SNPRINTF +#define snprintf sprintf +/* + should warn about buffer overflow? + */ +#endif + +#define INPUT_ERROR(port, message, arg) { \ + char s[1024];\ + int fn_found = SCM_STRINGP (SCM_FILENAME(port));\ + char *fn = "";\ + if (fn_found)\ + fn = SCM_STRING_CHARS(SCM_FILENAME(port));\ + snprintf (s, 1024, "%s\nThis happened in %s%s%s line %d column %d", message, \ + fn_found ? "`" : "", \ + fn,\ + fn_found ? "'" : "", \ + SCM_LINUM(port) + 1, SCM_COL(port) + 1); \ + SCM_MISC_ERROR(s, arg); \ + } +#else +#define INPUT_ERROR(port, message, arg) SCM_MISC_ERROR(message, arg) +#endif + + SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, (SCM setting), "Option interface for the read options. Instead of using\n" @@ -300,7 +359,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) ? scm_lreadrecparen (tok_buf, port, s_list, copy) : scm_lreadparen (tok_buf, port, s_list, copy); case ')': - SCM_MISC_ERROR ("unexpected \")\"", SCM_EOL); + INPUT_ERROR(port,"unexpected \")\"", SCM_EOL); goto tryagain; case '\'': @@ -430,7 +489,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if (scm_charnames[c] && (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf)))) return SCM_MAKE_CHAR (scm_charnums[c]); - SCM_MISC_ERROR ("unknown # object", SCM_EOL); + INPUT_ERROR (port, "unknown # object", SCM_EOL); /* #:SYMBOL is a syntax for keywords supported in all contexts. */ case ':': @@ -460,8 +519,8 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) } } unkshrp: - scm_misc_error (s_scm_read, "Unknown # object: ~S", - scm_list_1 (SCM_MAKE_CHAR (c))); + INPUT_ERROR (port, "Unknown # object: ~S", + scm_list_1 (SCM_MAKE_CHAR (c))); } case '"': @@ -469,7 +528,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) while ('"' != (c = scm_getc (port))) { if (c == EOF) - SCM_MISC_ERROR ("end of file in string constant", SCM_EOL); + INPUT_ERROR (port, "end of file in string constant", SCM_EOL); while (j + 2 >= SCM_STRING_LENGTH (*tok_buf)) scm_grow_tok_buf (tok_buf); @@ -531,7 +590,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) c = SCM_STRING_CHARS (*tok_buf)[1]; goto callshrp; } - SCM_MISC_ERROR ("unknown # object", SCM_EOL); + INPUT_ERROR (port, "unknown # object", SCM_EOL); } goto tok; @@ -662,7 +721,7 @@ scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy) ans = scm_lreadr (tok_buf, port, copy); closeit: if (')' != (c = scm_flush_ws (port, name))) - SCM_MISC_ERROR ("missing close paren", SCM_EOL); + INPUT_ERROR (port, "missing close paren", SCM_EOL); return ans; } ans = tl = scm_cons (tmp, SCM_EOL); @@ -702,7 +761,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) { ans = scm_lreadr (tok_buf, port, copy); if (')' != (c = scm_flush_ws (port, name))) - SCM_MISC_ERROR ("missing close paren", SCM_EOL); + INPUT_ERROR (port, "missing close paren", SCM_EOL); return ans; } /* Build the head of the list structure. */ @@ -726,7 +785,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) : tmp, SCM_EOL)); if (')' != (c = scm_flush_ws (port, name))) - SCM_MISC_ERROR ("missing close paren", SCM_EOL); + INPUT_ERROR (port, "missing close paren", SCM_EOL); goto exit; } From 33138b05678b86e382c4b71c4181ea48793a8b0c Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Mon, 5 Aug 2002 17:46:34 +0000 Subject: [PATCH 092/306] remove GC bits documentation from the tags table. --- libguile/ChangeLog | 2 ++ libguile/gc-card.c | 1 + libguile/gc-mark.c | 19 +++++++++++++++---- libguile/tags.h | 10 ++++------ 4 files changed, 22 insertions(+), 10 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index ccef7d069..62b6a1e4b 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,7 @@ 2002-08-05 Han-Wen Nienhuys + * tags.h: remove GC bits documentation from the tags table. + * read.c (INPUT_ERROR): Prepare for file:line:column error messages for errors in scm_lreadr() and friends. diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 7daa6df4c..6f82488ba 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -91,6 +91,7 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) the bitvec in turn, but it wasn't any faster, but quite bit hairier. */ + for (p += offset; p < end; p += span, offset += span) { SCM scmptr = PTR2SCM(p); diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 49cb77e29..466874ad2 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -192,7 +192,7 @@ scm_gc_mark (SCM ptr) Mark the dependencies of an object. -TODO: +Prefetching: Should prefetch objects before marking, i.e. if marking a cell, we should prefetch the car, and then mark the cdr. This will improve CPU @@ -204,7 +204,13 @@ garbage collector cache misses. Prefetch is supported on GCC >= 3.1 - */ +(Some time later.) + +Tried this with GCC 3.1.1 -- the time differences are barely measurable. +Perhaps this would work better with an explicit markstack? + + +*/ void scm_gc_mark_dependencies (SCM p) #define FUNC_NAME "scm_gc_mark_dependencies" @@ -225,6 +231,8 @@ scm_gc_mark_dependencies (SCM p) ptr = SCM_CAR (ptr); goto gc_mark_nimp; } + + scm_gc_mark (SCM_CAR (ptr)); ptr = SCM_CDR (ptr); goto gc_mark_nimp; @@ -232,6 +240,7 @@ scm_gc_mark_dependencies (SCM p) ptr = SCM_CDR (ptr); goto gc_mark_loop; case scm_tc7_pws: + scm_gc_mark (SCM_SETTER (ptr)); ptr = SCM_PROCEDURE (ptr); goto gc_mark_loop; @@ -285,8 +294,10 @@ scm_gc_mark_dependencies (SCM p) if (i == 0) break; while (--i > 0) - if (SCM_NIMP (SCM_VELTS (ptr)[i])) - scm_gc_mark (SCM_VELTS (ptr)[i]); + { + if (SCM_NIMP (SCM_VELTS (ptr)[i])) + scm_gc_mark (SCM_VELTS (ptr)[i]); + } ptr = SCM_VELTS (ptr)[0]; goto gc_mark_loop; #ifdef CCLO diff --git a/libguile/tags.h b/libguile/tags.h index 26d4e890e..3235b7705 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -229,12 +229,10 @@ typedef signed long scm_t_signed_bits; * * Here is a summary of tags in the CAR of a non-immediate: * - * HEAP CELL: G=gc_mark; 1 during mark, 0 other times. - * - * cons ..........SCM car..............0 ...........SCM cdr.............G - * struct ..........void * type........001 ...........void * data.........G - * closure ..........SCM code...........011 ...........SCM env.............G - * tc7 ......24.bits of data...Gxxxx1S1 ..........void *data............ + * cons ..........SCM car..............0 ...........SCM cdr.............0 + * struct ..........void * type........001 ...........void * data.........0 + * closure ..........SCM code...........011 ...........SCM env.............0 + * tc7 ......24.bits of data...0xxxx1S1 ..........void *data............ * * * From a9e40ed0d083fe84de6c969bfd341a31f1ca2b2f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 5 Aug 2002 18:47:41 +0000 Subject: [PATCH 093/306] Added Han Wen Nienhuys as contributor. --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index 947c1e615..7cccc4b41 100644 --- a/THANKS +++ b/THANKS @@ -3,6 +3,7 @@ Contributors since the last release: Rob Browning Stefan Jahn Thien-Thi Nguyen + Han-Wen Nienhuys Sponsors since the last release: From c5ee546dda0c74e393aca1b6c18915837e6adf7a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 5 Aug 2002 18:50:54 +0000 Subject: [PATCH 094/306] Added an introductory blurb about GC that I had lying around. --- doc/ref/scheme-memory.texi | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi index d6f0584c6..8f9d8e143 100644 --- a/doc/ref/scheme-memory.texi +++ b/doc/ref/scheme-memory.texi @@ -2,6 +2,21 @@ @node Memory Management @chapter Memory Management and Garbage Collection +Guile uses a @emph{garbage collector} to manage most of its objects. +This means that the memory used to store a Scheme string, say, is +automatically reclaimed when no one is using this string any longer. +This can work because Guile knows enough about its objects at run-time +to be able to trace all references between them. Thus, it can find +all 'life' objects (objects that are still in use) by starting from a +known set of 'root' objects and following the links that these objects +have to other objects, and so on. The objects that are not reached by +this recursive process can be considered 'dead' and their memory can +be used for new objects. + +When you are programming in Scheme, you don't need to worry about the +garbage collector. When programming in C, there are a few rules that +you must follow so that the garbage collector can do its job. + @menu * Garbage Collection:: * Memory Blocks:: From 4310df36888997847ea5afc9fb00a3d3512bd121 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 5 Aug 2002 18:52:27 +0000 Subject: [PATCH 095/306] Added (use-modules (ice-9 rdelim)) to an example that uses read-line. Thanks to Ralf Mattes! --- doc/ref/intro.texi | 16 +++++++++++++--- doc/ref/srfi-modules.texi | 1 + 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/doc/ref/intro.texi b/doc/ref/intro.texi index af1b48d0e..d3af77a8a 100644 --- a/doc/ref/intro.texi +++ b/doc/ref/intro.texi @@ -738,11 +738,14 @@ currently running Guile REPL or the top of your script file. @end lisp This will load the module and make the procedures exported by -@code{(ice-9 popen)} automatically available. The next step could be to -open a pipe to @file{ls} and read the contents of the current directory, -one line at a time. +@code{(ice-9 popen)} automatically available. The next step could be +to open a pipe to @file{ls} and read the contents of the current +directory, one line at a time. For the latter, we use the function +@code{read-line}, which can be found in the module @code{(ice-9 +rdelim)}, so we use that module as well. @lisp +(use-modules (ice-9 rdelim)) (define p (open-input-pipe "ls -l")) (read-line p) @result{} @@ -752,6 +755,13 @@ one line at a time. "drwxr-sr-x 2 mgrabmue mgrabmue 1024 Mar 29 19:57 CVS" @end lisp +The macro @code{use-modules} can take any number of modules to use. +Therefore, we could have written the two @code{use-modules} statements +in the code above as + +@lisp +(use-modules (ice-9 popen) (ice-9 rdelim)) +@end lisp @node Intro to Writing New Modules @subsection Intro to Writing New Modules diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 32de27a4b..3b751acda 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -1069,6 +1069,7 @@ defined previously, using @code{define-reader-ctor}. Example: @lisp +(use-modules (ice-9 rdelim)) ; for read-line (define-reader-ctor 'file open-input-file) (define f '#,(file "/etc/passwd")) (read-line f) From 3d0f4c6292008ec9b8182455da2dcbe13053c8da Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 5 Aug 2002 18:52:43 +0000 Subject: [PATCH 096/306] *** empty log message *** --- doc/ref/ChangeLog | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 88d4c02d8..339082c3d 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,12 @@ +2002-08-05 Marius Vollmer + + * intro.texi, srfi-modules.texi: Added (use-modules (ice-9 + rdelim)) to an example that uses read-line. Thanks to Ralf + Mattes! + + * scheme-memory.texi: Added an introductory blurb about GC that I + had lying around. + 2002-08-02 Gary Houston * scheme-modules.texi: split "Scheme and modules" into From ba1b222692b1ee69e51825397bf1368dffd1a28a Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Mon, 5 Aug 2002 23:04:44 +0000 Subject: [PATCH 097/306] * tests/reader.test: change misc-error in read-error. * read.c (scm_input_error): new function: give meaningful error messages, and throw read-error * gc-malloc.c (scm_calloc): add scm_calloc. * scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc. correct typos. --- doc/ref/ChangeLog | 5 +++ doc/ref/scheme-memory.texi | 8 ++-- libguile/ChangeLog | 7 +++ libguile/gc-malloc.c | 14 +++++- libguile/gc.h | 1 + libguile/pairs.c | 2 +- libguile/read.c | 86 +++++++++++++++--------------------- test-suite/ChangeLog | 4 ++ test-suite/tests/reader.test | 5 ++- 9 files changed, 74 insertions(+), 58 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 339082c3d..e836c2e05 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-08-06 Han-Wen Nienhuys + + * scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc. + correct typos. + 2002-08-05 Marius Vollmer * intro.texi, srfi-modules.texi: Added (use-modules (ice-9 diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi index 8f9d8e143..8fad86466 100644 --- a/doc/ref/scheme-memory.texi +++ b/doc/ref/scheme-memory.texi @@ -7,11 +7,11 @@ This means that the memory used to store a Scheme string, say, is automatically reclaimed when no one is using this string any longer. This can work because Guile knows enough about its objects at run-time to be able to trace all references between them. Thus, it can find -all 'life' objects (objects that are still in use) by starting from a +all 'live' objects (objects that are still in use) by starting from a known set of 'root' objects and following the links that these objects have to other objects, and so on. The objects that are not reached by this recursive process can be considered 'dead' and their memory can -be used for new objects. +be reused for new objects. When you are programming in Scheme, you don't need to worry about the garbage collector. When programming in C, there are a few rules that @@ -67,7 +67,9 @@ be freed by a garbage collection. The memory can be freed with @code{free}. There is also @code{scm_gc_realloc} and @code{scm_realloc}, to be used -in place of @code{realloc} when appropriate. +in place of @code{realloc} when appropriate, @code{scm_gc_calloc} and +@code{scm_calloc}, to be used in place of @code{calloc} when +appropriate. For really specialized needs, take at look at @code{scm_gc_register_collectable_memory} and diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 62b6a1e4b..5835323d0 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,10 @@ +2002-08-06 Han-Wen Nienhuys + + * read.c (scm_input_error): new function: give meaningful error + messages, and throw read-error + + * gc-malloc.c (scm_calloc): add scm_calloc. + 2002-08-05 Han-Wen Nienhuys * tags.h: remove GC bits documentation from the tags table. diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 2720ed8d8..86f2b50c1 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -142,7 +142,19 @@ scm_malloc (size_t sz) { return scm_realloc (NULL, sz); } - + +/* + Hmm. Should we use the C convention for arguments (i.e. N_ELTS, + SIZEOF_ELT)? --hwn + */ +void * +scm_calloc (size_t sz) +{ + void * ptr = scm_realloc (NULL, sz); + memset (ptr, 0x0, sz); + return ptr; +} + char * scm_strndup (const char *str, size_t n) diff --git a/libguile/gc.h b/libguile/gc.h index bce48debd..7161e3805 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -330,6 +330,7 @@ SCM_API int scm_in_heap_p (SCM value); SCM_API void scm_gc_sweep (void); SCM_API void *scm_malloc (size_t size); +SCM_API void *scm_calloc (size_t size); SCM_API void *scm_realloc (void *mem, size_t size); SCM_API char *scm_strdup (const char *str); SCM_API char *scm_strndup (const char *str, size_t n); diff --git a/libguile/pairs.c b/libguile/pairs.c index 5fed8d078..0b66ee5ca 100644 --- a/libguile/pairs.c +++ b/libguile/pairs.c @@ -54,7 +54,7 @@ #if (SCM_DEBUG_PAIR_ACCESSES == 1) -/~#include "libguile/ports.h" +#include "libguile/ports.h" #include "libguile/strings.h" void scm_error_pair_access (SCM non_pair) diff --git a/libguile/read.c b/libguile/read.c index 6b85d0fc8..8b0b0b2f4 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -55,9 +55,10 @@ #include "libguile/ports.h" #include "libguile/root.h" #include "libguile/strings.h" +#include "libguile/strports.h" #include "libguile/vectors.h" - #include "libguile/validate.h" + #include "libguile/read.h" @@ -80,58 +81,41 @@ scm_t_option scm_read_opts[] = { We use the format - MESSAGE + FILE:LINE:COL: MESSAGE This happened in .... This is not standard GNU format, but the test-suite likes the real message to be in front. - Hmmm. - - Maybe this is a kludge? Perhaps we should throw (list EXPR FILENAME - LINENO COLUMNO), and have the exception handler sort out the error - message?Where does the handler live, what are the conventions for - the expression argument of the handler? How does this work for an - error message like - -Backtrace: -In standard input: - 4: 0* [list ... - -standard input:4:1: While evaluating arguments to list in expression (list a b):standard input:4:1: Unbound variable: a -ABORT: (unbound-variable) - - - - In any case, we would have to assemble that information anyway. */ -#if 0 +static void +scm_input_error(char const * function, + SCM port, const char * message, SCM arg) +{ + char *fn = SCM_STRINGP (SCM_FILENAME(port)) + ? SCM_STRING_CHARS(SCM_FILENAME(port)) + : "#"; -#ifndef HAVE_SNPRINTF -#define snprintf sprintf -/* - should warn about buffer overflow? - */ -#endif + SCM string_port = scm_open_output_string (); + SCM string = SCM_EOL; + scm_simple_format (string_port, + scm_makfrom0str ("~A:~S:~S: ~A"), + scm_list_4 (scm_makfrom0str (fn), + scm_int2num (SCM_LINUM (port) + 1), + scm_int2num (SCM_COL (port) + 1), + scm_makfrom0str (message))); -#define INPUT_ERROR(port, message, arg) { \ - char s[1024];\ - int fn_found = SCM_STRINGP (SCM_FILENAME(port));\ - char *fn = "";\ - if (fn_found)\ - fn = SCM_STRING_CHARS(SCM_FILENAME(port));\ - snprintf (s, 1024, "%s\nThis happened in %s%s%s line %d column %d", message, \ - fn_found ? "`" : "", \ - fn,\ - fn_found ? "'" : "", \ - SCM_LINUM(port) + 1, SCM_COL(port) + 1); \ - SCM_MISC_ERROR(s, arg); \ - } -#else -#define INPUT_ERROR(port, message, arg) SCM_MISC_ERROR(message, arg) -#endif + + string = scm_get_output_string (string_port); + scm_close_output_port (string_port); + scm_error_scm (scm_str2symbol ("read-error"), + scm_makfrom0str (function), + string, + SCM_EOL, + SCM_BOOL_F); +} SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, @@ -359,7 +343,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) ? scm_lreadrecparen (tok_buf, port, s_list, copy) : scm_lreadparen (tok_buf, port, s_list, copy); case ')': - INPUT_ERROR(port,"unexpected \")\"", SCM_EOL); + scm_input_error (FUNC_NAME, port,"unexpected \")\"", SCM_EOL); goto tryagain; case '\'': @@ -489,7 +473,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if (scm_charnames[c] && (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf)))) return SCM_MAKE_CHAR (scm_charnums[c]); - INPUT_ERROR (port, "unknown # object", SCM_EOL); + scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL); /* #:SYMBOL is a syntax for keywords supported in all contexts. */ case ':': @@ -519,7 +503,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) } } unkshrp: - INPUT_ERROR (port, "Unknown # object: ~S", + scm_input_error (FUNC_NAME, port, "Unknown # object: ~S", scm_list_1 (SCM_MAKE_CHAR (c))); } @@ -528,7 +512,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) while ('"' != (c = scm_getc (port))) { if (c == EOF) - INPUT_ERROR (port, "end of file in string constant", SCM_EOL); + scm_input_error (FUNC_NAME, port, "end of file in string constant", SCM_EOL); while (j + 2 >= SCM_STRING_LENGTH (*tok_buf)) scm_grow_tok_buf (tok_buf); @@ -590,7 +574,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) c = SCM_STRING_CHARS (*tok_buf)[1]; goto callshrp; } - INPUT_ERROR (port, "unknown # object", SCM_EOL); + scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL); } goto tok; @@ -721,7 +705,7 @@ scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy) ans = scm_lreadr (tok_buf, port, copy); closeit: if (')' != (c = scm_flush_ws (port, name))) - INPUT_ERROR (port, "missing close paren", SCM_EOL); + scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL); return ans; } ans = tl = scm_cons (tmp, SCM_EOL); @@ -761,7 +745,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) { ans = scm_lreadr (tok_buf, port, copy); if (')' != (c = scm_flush_ws (port, name))) - INPUT_ERROR (port, "missing close paren", SCM_EOL); + scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL); return ans; } /* Build the head of the list structure. */ @@ -785,7 +769,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) : tmp, SCM_EOL)); if (')' != (c = scm_flush_ws (port, name))) - INPUT_ERROR (port, "missing close paren", SCM_EOL); + scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL); goto exit; } diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index da61a418f..0a6cca940 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2002-08-06 Han-Wen Nienhuys + + * tests/reader.test: change misc-error in read-error. + 2002-07-13 Dirk Herrmann * tests/goops.test: Added tests for define-generic and diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 64bd05aa7..ab8d49e13 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -2,9 +2,10 @@ ;;;; Jim Blandy --- September 1999 (define exception:eof - (cons 'misc-error "^end of file")) + (cons 'read-error "end of file$")) + (define exception:unexpected-rparen - (cons 'misc-error "^unexpected \")\"")) + (cons 'read-error "unexpected \")\"$")) (define (read-string s) (with-input-from-string s (lambda () (read)))) From 0f8ae50a816d700aa4c14d72f4b7a39c48f34a3d Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Mon, 5 Aug 2002 23:11:59 +0000 Subject: [PATCH 098/306] (scm_input_error): new function: give meaningful error messages, and throw read-error --- libguile/read.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/libguile/read.c b/libguile/read.c index 8b0b0b2f4..6046023a8 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -191,12 +191,10 @@ scm_flush_ws (SCM port, const char *eoferr) goteof: if (eoferr) { - if (!SCM_FALSEP (SCM_FILENAME (port))) - scm_misc_error (eoferr, - "end of file in ~A", - scm_list_1 (SCM_FILENAME (port))); - else - scm_misc_error (eoferr, "end of file", SCM_EOL); + scm_input_error (eoferr, + port, + "end of file", + SCM_EOL); } return c; case ';': From 77c16d83433605de485d348b51dce8cafd69376a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Aug 2002 17:07:10 +0000 Subject: [PATCH 099/306] Don't talk about 'bound?' which is gone. Thanks to Christopher Cramer. --- doc/ref/scheme-binding.texi | 4 +--- doc/ref/scheme-procedures.texi | 13 ++----------- 2 files changed, 3 insertions(+), 14 deletions(-) diff --git a/doc/ref/scheme-binding.texi b/doc/ref/scheme-binding.texi index 23786b3bf..987779c22 100644 --- a/doc/ref/scheme-binding.texi +++ b/doc/ref/scheme-binding.texi @@ -263,9 +263,7 @@ with duplicate bindings. @section Querying variable bindings Guile provides a procedure for checking whether a symbol is bound in the -top level environment. If you want to test whether a symbol is locally -bound in expression, you can use the @code{bound?} macro from the module -@code{(ice-9 optargs)}, documented in @ref{Optional Arguments}. +top level environment. @c NJFIXME explain [env] @deffn {Scheme Procedure} defined? sym [env] diff --git a/doc/ref/scheme-procedures.texi b/doc/ref/scheme-procedures.texi index 36f840ecc..8c08b387c 100644 --- a/doc/ref/scheme-procedures.texi +++ b/doc/ref/scheme-procedures.texi @@ -136,7 +136,7 @@ the scsh macros of the same name, but are slightly extended. Each of procedures these are used from. The items in @var{rest-arg} are sequentially bound to the variable names are given. When @var{rest-arg} runs out, the remaining vars are bound either to the default values or -left unbound if no default value was specified. @var{rest-arg} remains +@code{#f} if no default value was specified. @var{rest-arg} remains bound to whatever may have been left of @var{rest-arg}. After binding the variables, the expressions @var{expr} @dots{} are @@ -211,8 +211,7 @@ parameter list, but before any dotted rest argument. For example, creates a procedure with fixed arguments @var{a} and @var{b}, optional arguments @var{c} and @var{d}, and rest argument @var{e}. If the optional arguments are omitted in a call, the variables for them are -unbound in the procedure. This can be checked with the @code{bound?} -macro (documented below). +bound to @code{#f}. @code{lambda*} can also take keyword arguments. For example, a procedure defined like this: @@ -263,14 +262,6 @@ more similarity to DSSSL, MIT-Scheme and Kawa among others, as well as for refugees from other Lisp dialects. @end deffn -@deffn {library syntax} bound? variable -Check if a variable is bound in the current environment. - -The procedure @code{defined?} doesn't quite cut it as it stands, since -it only checks bindings in the top-level environment, not those in local -scope only. -@end deffn - @node define* Reference @subsection define* Reference From 00706edc1de5c13bc0552eedf8eec9a5a7ed8802 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Aug 2002 17:07:23 +0000 Subject: [PATCH 100/306] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index e836c2e05..2e25bec97 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-08-08 Marius Vollmer + + * scheme-binding.texi: Don't talk about 'bound?' which is gone. + Thanks to Christopher Cramer. + 2002-08-06 Han-Wen Nienhuys * scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc. From eab1b25970c21df7da67bd8f48290a1a1e1bf3d7 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 8 Aug 2002 19:47:31 +0000 Subject: [PATCH 101/306] * gc.h: add scm_debug_cells_gc_interval to public interface * gc-card.c ("sweep_card"): set scm_gc_running while sweeping. * gc.c (scm_i_expensive_validation_check): separate expensive validation checks from cheap ones. --- NEWS | 6 +- doc/ref/scheme-memory.texi | 17 +++- libguile/ChangeLog | 9 ++ libguile/gc-card.c | 16 +++- libguile/gc-mark.c | 22 +++-- libguile/gc-segment.c | 2 +- libguile/gc.c | 173 +++++++++++++++++++++---------------- libguile/gc.h | 16 ++-- libguile/inline.c | 5 +- libguile/inline.h | 13 +-- libguile/private-gc.h | 3 +- libguile/procs.c | 2 +- 12 files changed, 179 insertions(+), 105 deletions(-) diff --git a/NEWS b/NEWS index 0734b3bfd..25a081053 100644 --- a/NEWS +++ b/NEWS @@ -142,9 +142,9 @@ cause aborts in long running programs. The new functions are more symmetrical and do not need cooperation from smob free routines, among other improvements. -The new functions are scm_malloc, scm_realloc, scm_strdup, -scm_strndup, scm_gc_malloc, scm_gc_calloc, scm_gc_realloc, scm_gc_free, -scm_gc_register_collectable_memory, and +The new functions are scm_malloc, scm_realloc, scm_calloc, scm_strdup, +scm_strndup, scm_gc_malloc, scm_gc_calloc, scm_gc_realloc, +scm_gc_free, scm_gc_register_collectable_memory, and scm_gc_unregister_collectable_memory. Refer to the manual for more details and for upgrading instructions. diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi index 8fad86466..ea3f8bfd1 100644 --- a/doc/ref/scheme-memory.texi +++ b/doc/ref/scheme-memory.texi @@ -76,6 +76,7 @@ For really specialized needs, take at look at @code{scm_gc_unregister_collectable_memory}. @deftypefn {C Function} void *scm_malloc (size_t @var{size}) +@deftypefnx {C Function} void *scm_calloc (size_t @var{size}) Allocate @var{size} bytes of memory and return a pointer to it. When @var{size} is 0, return @code{NULL}. When not enough memory is available, signal an error. This function runs the GC to free up some @@ -85,6 +86,9 @@ The memory is allocated by the libc @code{malloc} function and can be freed with @code{free}. There is no @code{scm_free} function to go with @code{scm_malloc} to make it easier to pass memory back and forth between different modules. + +The function @code{scm_calloc} is similar to @code{scm_malloc}, but +initializes the block of memory to zero as well. @end deftypefn @deftypefn {C Function} void *scm_realloc (void *@var{mem}, size_t @var{new_size}) @@ -98,6 +102,9 @@ When not enough memory is available, signal an error. This function runs the GC to free up some memory when it deems it appropriate. @end deftypefn + + + @deftypefn {C Function} void scm_gc_register_collectable_memory (void *@var{mem}, size_t @var{size}, const char *@var{what}) Informs the GC that the memory at @var{mem} of size @var{size} can potentially be freed during a GC. That is, announce that @var{mem} is @@ -127,12 +134,14 @@ much less efficiently than it could. @deftypefn {C Function} void *scm_gc_malloc (size_t @var{size}, const char *@var{what}) @deftypefnx {C Function} void *scm_gc_realloc (void *@var{mem}, size_t @var{old_size}, size_t @var{new_size}, const char *@var{what}); -Like @code{scm_malloc} or @code{scm_realloc}, but also call -@code{scm_gc_register_collectable_memory}. Note that you need to pass -the old size of a reallocated memory block as well. See below for a -motivation. +@deftypefnx {C Function} void *scm_gc_calloc (size_t @var{size}, const char *@var{what}) +Like @code{scm_malloc}, @code{scm_realloc} or @code{scm_calloc}, but +also call @code{scm_gc_register_collectable_memory}. Note that you +need to pass the old size of a reallocated memory block as well. See +below for a motivation. @end deftypefn + @deftypefn {C Function} void scm_gc_free (void *@var{mem}, size_t @var{size}, const char *@var{what}) Like @code{free}, but also call @code{scm_gc_unregister_collectable_memory}. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5835323d0..0bb54712e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,12 @@ +2002-08-08 Han-Wen Nienhuys + + * gc.h: add scm_debug_cells_gc_interval to public interface + + * gc-card.c ("sweep_card"): set scm_gc_running while sweeping. + + * gc.c (scm_i_expensive_validation_check): separate expensive + validation checks from cheap ones. + 2002-08-06 Han-Wen Nienhuys * read.c (scm_input_error): new function: give meaningful error diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 6f82488ba..309ac88ab 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -86,12 +86,13 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); int free_count = 0; + ++ scm_gc_running_p; + /* I tried something fancy with shifting by one bit every word from the bitvec in turn, but it wasn't any faster, but quite bit hairier. */ - for (p += offset; p < end; p += span, offset += span) { SCM scmptr = PTR2SCM(p); @@ -273,6 +274,8 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) *free_list = PTR2SCM (p); free_count ++; } + + --scm_gc_running_p; return free_count; } #undef FUNC_NAME @@ -301,6 +304,7 @@ scm_init_card_freelist (scm_t_cell * card, SCM *free_list, int span) } + #if 0 /* These functions are meant to be called from GDB as a debug aid. @@ -318,6 +322,16 @@ typedef struct scm_t_list_cell_struct { struct scm_t_list_cell_struct * cdr; } scm_t_list_cell; + +typedef struct scm_t_double_cell +{ + scm_t_bits word_0; + scm_t_bits word_1; + scm_t_bits word_2; + scm_t_bits word_3; +} scm_t_double_cell; + + int scm_gc_marked_p (SCM obj) { diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 466874ad2..d7414d648 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -83,9 +83,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include #endif - - - #ifdef __ia64__ # define SCM_MARK_BACKING_STORE() do { \ ucontext_t ctx; \ @@ -101,6 +98,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base; # define SCM_MARK_BACKING_STORE() #endif + /* Entry point for this file. */ @@ -108,10 +106,10 @@ void scm_mark_all (void) { long j; - + scm_i_clear_mark_space (); - + #ifndef USE_THREADS /* Mark objects on the C stack. */ @@ -157,12 +155,14 @@ scm_mark_all (void) } } } + /* FIXME: we should have a means to register C functions to be run * in different phases of GC */ scm_mark_subr_table (); + #ifndef USE_THREADS scm_gc_mark (scm_root->handle); #endif @@ -171,7 +171,6 @@ scm_mark_all (void) /* {Mark/Sweep} */ - /* Mark an object precisely, then recurse. */ @@ -182,7 +181,9 @@ scm_gc_mark (SCM ptr) return ; if (SCM_GC_MARK_P (ptr)) - return; + { + return; + } SCM_SET_GC_MARK (ptr); scm_gc_mark_dependencies (ptr); @@ -475,9 +476,12 @@ gc_mark_loop: } if (SCM_GC_MARK_P (ptr)) + { return; - + } + SCM_SET_GC_MARK (ptr); + goto scm_mark_dependencies_again; } @@ -485,6 +489,7 @@ gc_mark_loop: + /* Mark a region conservatively */ void scm_mark_locations (SCM_STACKITEM x[], unsigned long n) @@ -570,4 +575,3 @@ scm_gc_init_mark(void) #endif } - diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index d3a48f2ab..593aa29a2 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -546,6 +546,7 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro } + void scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist) { @@ -568,4 +569,3 @@ scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *f freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction / 100); } - diff --git a/libguile/gc.c b/libguile/gc.c index 58ede2266..b29138573 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -90,53 +90,87 @@ extern unsigned long * __libc_ia64_register_backing_store_base; unsigned int scm_gc_running_p = 0; -#if (SCM_DEBUG_CELL_ACCESSES == 1) - /* Set this to != 0 if every cell that is accessed shall be checked: */ -unsigned int scm_debug_cell_accesses_p = 1; +int scm_debug_cell_accesses_p = 0; +int scm_expensive_debug_cell_accesses_p = 0; /* Set this to 0 if no additional gc's shall be performed, otherwise set it to * the number of cell accesses after which a gc shall be called. */ -static unsigned int debug_cells_gc_interval = 0; +int scm_debug_cells_gc_interval = 0; - -/* Assert that the given object is a valid reference to a valid cell. This - * test involves to determine whether the object is a cell pointer, whether - * this pointer actually points into a heap segment and whether the cell - * pointed to is not a free cell. Further, additional garbage collections may - * get executed after a user defined number of cell accesses. This helps to - * find places in the C code where references are dropped for extremely short - * periods. +/* + Global variable, so you can switch it off at runtime by setting + scm_i_cell_validation_already_running. */ +int scm_i_cell_validation_already_running ; + +#if (SCM_DEBUG_CELL_ACCESSES == 1) + + +/* + + Assert that the given object is a valid reference to a valid cell. This + test involves to determine whether the object is a cell pointer, whether + this pointer actually points into a heap segment and whether the cell + pointed to is not a free cell. Further, additional garbage collections may + get executed after a user defined number of cell accesses. This helps to + find places in the C code where references are dropped for extremely short + periods. + +*/ + + +void +scm_i_expensive_validation_check (SCM cell) +{ + if (!scm_in_heap_p (cell)) + { + fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n", + (unsigned long) SCM_UNPACK (cell)); + abort (); + } + + /* If desired, perform additional garbage collections after a user + * defined number of cell accesses. + */ + if (scm_debug_cells_gc_interval) + { + static unsigned int counter = 0; + + if (counter != 0) + { + --counter; + } + else + { + counter = scm_debug_cells_gc_interval; + scm_igc ("scm_assert_cell_valid"); + } + } +} void scm_assert_cell_valid (SCM cell) { - static unsigned int already_running = 0; - - if (!already_running) + if (!scm_i_cell_validation_already_running && scm_debug_cell_accesses_p) { - already_running = 1; /* set to avoid recursion */ + scm_i_cell_validation_already_running = 1; /* set to avoid recursion */ /* - During GC, no user-code should be run, and the guile core should - use non-protected accessors. - */ + During GC, no user-code should be run, and the guile core + should use non-protected accessors. + */ if (scm_gc_running_p) - abort(); + return; /* - Only scm_in_heap_p is wildly expensive. - */ - if (scm_debug_cell_accesses_p) - if (!scm_in_heap_p (cell)) - { - fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n", - (unsigned long) SCM_UNPACK (cell)); - abort (); - } + Only scm_in_heap_p and rescanning the heap is wildly + expensive. + */ + if (scm_expensive_debug_cell_accesses_p) + scm_i_expensive_validation_check (cell); if (!SCM_GC_MARK_P (cell)) { @@ -148,54 +182,47 @@ scm_assert_cell_valid (SCM cell) abort (); } - - /* If desired, perform additional garbage collections after a user - * defined number of cell accesses. - */ - if (scm_debug_cell_accesses_p && debug_cells_gc_interval) - { - static unsigned int counter = 0; - - if (counter != 0) - { - --counter; - } - else - { - counter = debug_cells_gc_interval; - scm_igc ("scm_assert_cell_valid"); - } - } - already_running = 0; /* re-enable */ + scm_i_cell_validation_already_running = 0; /* re-enable */ } } + SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, (SCM flag), "If @var{flag} is @code{#f}, cell access checking is disabled.\n" - "If @var{flag} is @code{#t}, cell access checking is enabled,\n" + "If @var{flag} is @code{#t}, cheap cell access checking is enabled,\n" "but no additional calls to garbage collection are issued.\n" - "If @var{flag} is a number, cell access checking is enabled,\n" + "If @var{flag} is a number, strict cell access checking is enabled,\n" "with an additional garbage collection after the given\n" "number of cell accesses.\n" "This procedure only exists when the compile-time flag\n" "@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.") #define FUNC_NAME s_scm_set_debug_cell_accesses_x { - if (SCM_FALSEP (flag)) { - scm_debug_cell_accesses_p = 0; - } else if (SCM_EQ_P (flag, SCM_BOOL_T)) { - debug_cells_gc_interval = 0; - scm_debug_cell_accesses_p = 1; - } else if (SCM_INUMP (flag)) { - long int f = SCM_INUM (flag); - if (f <= 0) SCM_OUT_OF_RANGE (1, flag); - debug_cells_gc_interval = f; - scm_debug_cell_accesses_p = 1; - } else { - SCM_WRONG_TYPE_ARG (1, flag); - } + if (SCM_FALSEP (flag)) + { + scm_debug_cell_accesses_p = 0; + } + else if (SCM_EQ_P (flag, SCM_BOOL_T)) + { + scm_debug_cells_gc_interval = 0; + scm_debug_cell_accesses_p = 1; + scm_expensive_debug_cell_accesses_p = 0; + } + else if (SCM_INUMP (flag)) + { + long int f = SCM_INUM (flag); + if (f <= 0) + SCM_OUT_OF_RANGE (1, flag); + scm_debug_cells_gc_interval = f; + scm_debug_cell_accesses_p = 1; + scm_expensive_debug_cell_accesses_p = 1; + } + else + { + SCM_WRONG_TYPE_ARG (1, flag); + } return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -497,6 +524,8 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells) --scm_ints_disabled; *free_cells = SCM_FREE_CELL_CDR (cell); + + return cell; } @@ -525,7 +554,7 @@ scm_igc (const char *what) /* During the critical section, only the current thread may run. */ SCM_CRITICAL_SECTION_START; - if (!scm_stack_base || scm_block_gc) + if (!scm_root || !scm_stack_base || scm_block_gc) { --scm_gc_running_p; return; @@ -585,17 +614,15 @@ scm_igc (const char *what) SCM_CRITICAL_SECTION_END; scm_c_hook_run (&scm_after_gc_c_hook, 0); --scm_gc_running_p; + + /* + For debugging purposes, you could do + scm_i_sweep_all_segments("debug"), but then the remains of the + cell aren't left to analyse. + */ } - - - - - - - - /* {GC Protection Helper Functions} */ @@ -939,7 +966,7 @@ mark_gc_async (void * hook_data SCM_UNUSED, * after-gc-hook. */ #if (SCM_DEBUG_CELL_ACCESSES == 1) - if (debug_cells_gc_interval == 0) + if (scm_debug_cells_gc_interval == 0) scm_system_async_mark (gc_async); #else scm_system_async_mark (gc_async); diff --git a/libguile/gc.h b/libguile/gc.h index 7161e3805..f0f89b7f7 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -218,6 +218,7 @@ typedef unsigned long scm_t_c_bvec_long; #define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 (x, t) + /* Freelists consist of linked cells where the type entry holds the value * scm_tc_free_cell and the second entry holds a pointer to the next cell of * the freelist. Due to this structure, freelist cells are not cons cells @@ -245,7 +246,11 @@ typedef unsigned long scm_t_c_bvec_long; #if (SCM_DEBUG_CELL_ACCESSES == 1) -SCM_API unsigned int scm_debug_cell_accesses_p; +/* Set this to != 0 if every cell that is accessed shall be checked: + */ +SCM_API int scm_debug_cell_accesses_p; +SCM_API int scm_expensive_debug_cell_accesses_p; +SCM_API int scm_debug_cells_gc_interval ; #endif SCM_API int scm_block_gc; @@ -274,10 +279,11 @@ SCM_API size_t scm_max_segment_size; Deprecated scm_freelist, scm_master_freelist. No warning; this is not a user serviceable part. */ -SCM_API SCM scm_i_freelist; -SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist; -SCM_API SCM scm_i_freelist2; -SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2; +extern SCM scm_i_freelist; +extern struct scm_t_cell_type_statistics scm_i_master_freelist; +extern SCM scm_i_freelist2; +extern struct scm_t_cell_type_statistics scm_i_master_freelist2; + SCM_API unsigned long scm_gc_cells_swept; SCM_API unsigned long scm_gc_cells_collected; diff --git a/libguile/inline.c b/libguile/inline.c index 914f309b2..66e348b1c 100644 --- a/libguile/inline.c +++ b/libguile/inline.c @@ -39,10 +39,13 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ +#include #include "libguile/scmconfig.h" - +#ifndef HAVE_INLINE #define HAVE_INLINE +#endif + #define EXTERN_INLINE #undef SCM_INLINE_H diff --git a/libguile/inline.h b/libguile/inline.h index c1df037c3..ea6b51277 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -50,10 +50,6 @@ */ -#if (SCM_DEBUG_CELL_ACCESSES == 1) -#include -#endif - #include "libguile/pairs.h" #include "libguile/gc.h" @@ -64,8 +60,6 @@ SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, #ifdef HAVE_INLINE - - #ifndef EXTERN_INLINE #define EXTERN_INLINE extern inline #endif @@ -74,6 +68,7 @@ extern unsigned scm_newcell2_count; extern unsigned scm_newcell_count; + EXTERN_INLINE SCM scm_cell (scm_t_bits car, scm_t_bits cdr) @@ -137,6 +132,10 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) #endif +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (scm_expensive_debug_cell_accesses_p ) + scm_i_expensive_validation_check (z); +#endif return z; } @@ -201,5 +200,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, return z; } + + #endif #endif diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 3924e5044..f5acd9450 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -236,5 +236,6 @@ void scm_gc_init_malloc (void); void scm_gc_init_freelist (void); void scm_gc_init_segments (void); void scm_gc_init_mark (void); - + + #endif diff --git a/libguile/procs.c b/libguile/procs.c index 948934de2..7269fa558 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -139,7 +139,7 @@ scm_mark_subr_table () long i; for (i = 0; i < scm_subr_table_size; ++i) { - SCM_SET_GC_MARK (scm_subr_table[i].name); + scm_gc_mark (scm_subr_table[i].name); if (scm_subr_table[i].generic && *scm_subr_table[i].generic) scm_gc_mark (*scm_subr_table[i].generic); if (SCM_NIMP (scm_subr_table[i].properties)) From bcf009c3f86a25858c0f428c382113a7c75a22d7 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 8 Aug 2002 21:47:53 +0000 Subject: [PATCH 102/306] Add examples from Ian Sheldon, and merge recent updates from stable branch. --- doc/ref/ChangeLog | 8 +++ doc/ref/data-rep.texi | 17 +++--- doc/ref/posix.texi | 114 ++++++++++++++++++++++++++++++++++++ doc/ref/scheme-memory.texi | 2 +- doc/ref/scheme-modules.texi | 78 ++++++++++++------------ 5 files changed, 168 insertions(+), 51 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 2e25bec97..a2e3a2269 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,11 @@ +2002-08-08 Neil Jerram + + * data-rep.texi, scheme-memory.texi, scheme-modules.texi: Merge + recent updates from stable branch. + + * posix.texi (File System, Time, Pipes, Network Databases, + Internet Socket Examples): Add examples provided by Ian Sheldon. + 2002-08-08 Marius Vollmer * scheme-binding.texi: Don't talk about 'bound?' which is gone. diff --git a/doc/ref/data-rep.texi b/doc/ref/data-rep.texi index 30fcee6c6..107c14209 100644 --- a/doc/ref/data-rep.texi +++ b/doc/ref/data-rep.texi @@ -46,7 +46,7 @@ @c essay @sp 10 @c essay @comment The title is printed in a large font. @c essay @title Data Representation in Guile -@c essay @subtitle $Id: data-rep.texi,v 1.7 2002-03-29 20:25:23 ossau Exp $ +@c essay @subtitle $Id: data-rep.texi,v 1.8 2002-08-08 21:47:53 ossau Exp $ @c essay @subtitle For use with Guile @value{VERSION} @c essay @author Jim Blandy @c essay @author Free Software Foundation @@ -961,7 +961,7 @@ Return the name of the subr @var{x}. The result is undefined if @var{x} is not a subr. @end deftypefn -@deftypefun SCM scm_make_gsubr (char *@var{name}, int @var{req}, int @var{opt}, int @var{rest}, SCM (*@var{function})()) +@deftypefun SCM scm_c_define_gsubr (char *@var{name}, int @var{req}, int @var{opt}, int @var{rest}, SCM (*@var{function})()) Create a new subr object named @var{name}, based on the C function @var{function}, make it visible to Scheme the value of as a global variable named @var{name}, and return the subr object. @@ -986,8 +986,8 @@ combinations of required, optional, and rest arguments. For example, a subr can take one required argument, or one required and one optional argument, but a subr can't take one required and two optional arguments. It's bizarre, but that's the way the interpreter was written. If the -arguments to @code{scm_make_gsubr} do not fit one of the predefined -patterns, then @code{scm_make_gsubr} will return a compiled closure +arguments to @code{scm_c_define_gsubr} do not fit one of the predefined +patterns, then @code{scm_c_define_gsubr} will return a compiled closure object instead of a subr object. @end deftypefun @@ -1048,22 +1048,23 @@ represented and used at the C level. In fact, there are two basic C data types to represent objects in Guile: -@itemize @bullet -@item +@deftp {Data type} SCM @code{SCM} is the user level abstract C type that is used to represent all of Guile's Scheme objects, no matter what the Scheme object type is. No C operation except assignment is guaranteed to work with variables of type @code{SCM}, so you should only use macros and functions to work with @code{SCM} values. Values are converted between C data types and the @code{SCM} type with utility functions and macros. +@end deftp +@cindex SCM data type -@item +@deftp {Data type} scm_t_bits @code{scm_t_bits} is an integral data type that is guaranteed to be large enough to hold all information that is required to represent any Scheme object. While this data type is mostly used to implement Guile's internals, the use of this type is also necessary to write certain kinds of extensions to Guile. -@end itemize +@end deftp @menu * Relationship between SCM and scm_t_bits:: diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 8a9fc280e..f43eb148c 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -735,6 +735,17 @@ Close the directory stream @var{stream}. The return value is unspecified. @end deffn +Here is an example showing how to display all the entries in a +directory: + +@lisp +(define dir (opendir "/usr/lib")) +(do ((entry (readdir dir) (readdir dir))) + ((eof-object? entry)) + (display entry)(newline)) +(closedir dir) +@end lisp + @deffn {Scheme Procedure} sync @deffnx {C Function} scm_sync () Flush the operating system disk buffers. @@ -791,6 +802,11 @@ Return the base name of the file name @var{filename}. The base name is the file name without any directory components. If @var{suffix} is provided, and is equal to the end of @var{basename}, it is removed also. + +@lisp +(basename "/tmp/test.xml" ".xml") +@result{} "test" +@end lisp @end deffn @@ -1021,6 +1037,11 @@ specifications introduced by a @code{%} character. The formatting of month and day names is dependent on the current locale. The value returned is the formatted string. @xref{Formatting Date and Time, , , libc, The GNU C Library Reference Manual}.) + +@lisp +(strftime "%c" (localtime (current-time))) +@result{} "Mon Mar 11 20:17:43 2002" +@end lisp @end deffn @deffn {Scheme Procedure} strptime format string @@ -1663,6 +1684,14 @@ be the value of @code{OPEN_READ} or @code{OPEN_WRITE}. @deffn {Scheme Procedure} open-input-pipe command Equivalent to @code{open-pipe} with mode @code{OPEN_READ}. + +@lisp +(read-line (open-input-pipe "date")) +@result{} "Mon Mar 11 20:10:44 GMT 2002" + +(waitpid WAIT_ANY) +@result{} (24160 . 0) +@end lisp @end deffn @deffn {Scheme Procedure} open-output-pipe command @@ -1686,6 +1715,7 @@ close a pipe, but doesn't return the status. * Network Address Conversion:: * Network Databases:: * Network Sockets and Communication:: +* Internet Socket Examples:: @end menu @node Network Address Conversion @@ -1827,6 +1857,14 @@ found, an error will be thrown to one of the keys: @code{no-data}, corresponding to the equivalent @code{h_error} values. Unusual conditions may result in errors thrown to the @code{system-error} or @code{misc_error} keys. + +@lisp +(gethost "www.gnu.org") +@result{} #("www.gnu.org" () 2 4 (3353880842)) + +(gethostbyname "www.emacs.org") +@result{} #("emacs.org" ("www.emacs.org") 2 4 (1073448978)) +@end lisp @end deffn The following procedures may be used to step through the host @@ -2000,6 +2038,14 @@ database does not match this name, a system error is signalled. The @code{getserv} procedure will take either a service name or number as its first argument; if given no arguments, it behaves like @code{getservent} (see below). + +@lisp +(getserv "imap" "tcp") +@result{} #("imap2" ("imap") 143 "tcp") + +(getservbyport 88 "udp") +@result{} #("kerberos" ("kerberos5" "krb5") 88 "udp") +@end lisp @end deffn The following procedures may be used to step through the service @@ -2390,6 +2436,74 @@ These procedures are inconvenient to use at present, but consider: (ntohl (uniform-vector-ref v 0))))) @end example + +@node Internet Socket Examples +@subsection Network Socket Examples + +The following sections give examples of how to use network sockets. + +@menu +* Internet Socket Client:: +* Internet Socket Server:: +@end menu + + +@node Internet Socket Client +@subsubsection Internet Socket Client Example + +@cindex socket client example +The following example demonstrates an Internet socket client. +It connects to the HTTP daemon running on the local machine and +returns the contents of the root index URL. + +@example +(let ((s (socket AF_INET SOCK_STREAM 0))) + (connect s AF_INET (inet-aton "127.0.0.1") 80) + (display "GET / HTTP/1.0\r\n\r\n" s) + + (do ((line (read-line s) (read-line s))) + ((eof-object? line)) + (display line) + (newline))) +@end example + + +@node Internet Socket Server +@subsubsection Internet Socket Server Example + +@cindex socket server example +The following example shows a simple Internet server which listens on +port 2904 for incoming connections and sends a greeting back to the +client. + +@example +(let ((s (socket AF_INET SOCK_STREAM 0))) + (setsockopt s SOL_SOCKET SO_REUSEADDR 1) + ;; Specific address? + ;; (bind s AF_INET (inet-aton "127.0.0.1") 2904) + (bind s AF_INET INADDR_ANY 2904) + (listen s 5) + + (simple-format #t "Listening for clients in pid: ~S" (getpid)) + (newline) + + (while #t + (let* ((client-connection (accept s)) + (client-details (cdr client-connection)) + (client (car client-connection))) + (simple-format #t "Got new client connection: ~S" + client-details) + (newline) + (simple-format #t "Client address: ~S" + (gethostbyaddr + (sockaddr:addr client-details))) + (newline) + ;; Send back the greeting to the client port + (display "Hello client\r\n" client) + (close client)))) +@end example + + @node System Identification @section System Identification diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi index ea3f8bfd1..5f19bcb38 100644 --- a/doc/ref/scheme-memory.texi +++ b/doc/ref/scheme-memory.texi @@ -32,7 +32,7 @@ you must follow so that the garbage collector can do its job. @deffnx {C Function} scm_gc () Scans all of SCM objects and reclaims for further use those that are no longer accessible. You normally don't need to call this function -explicitely. It is called automatically when appropriate. +explicitly. It is called automatically when appropriate. @end deffn @deffn {Scheme Procedure} gc-stats diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index c9279258c..46c02172d 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -552,69 +552,60 @@ When using the low level procedures to do your dynamic linking, you have complete control over which library is loaded when and what gets done with it. -@deffn {Scheme Procedure} dynamic-link filename -@deffnx {C Function} scm_dynamic_link (filename) -Find the shared object (shared library) denoted by -@var{filename} and link it into the running Guile -application. The returned -scheme object is a ``handle'' for the library which can -be passed to @code{dynamic-func}, @code{dynamic-call} etc. +@deffn {Scheme Procedure} dynamic-link library +@deffnx {C Function} scm_dynamic_link (library) +Find the shared library denoted by @var{library} (a string) and link it +into the running Guile application. When everything works out, return a +Scheme object suitable for representing the linked object file. +Otherwise an error is thrown. How object files are searched is system +dependent. -Searching for object files is system dependent. Normally, -if @var{filename} does have an explicit directory it will -be searched for in locations -such as @file{/usr/lib} and @file{/usr/local/lib}. +Normally, @var{library} is just the name of some shared library file +that will be searched for in the places where shared libraries usually +reside, such as in @file{/usr/lib} and @file{/usr/local/lib}. @end deffn @deffn {Scheme Procedure} dynamic-object? obj @deffnx {C Function} scm_dynamic_object_p (obj) -Return @code{#t} if @var{obj} is a dynamic object handle, -or @code{#f} otherwise. +Return @code{#t} if @var{obj} is a dynamic library handle, or @code{#f} +otherwise. @end deffn @deffn {Scheme Procedure} dynamic-unlink dobj @deffnx {C Function} scm_dynamic_unlink (dobj) -Unlink a dynamic object from the application, if possible. The -object must have been linked by @code{dynamic-link}, with -@var{dobj} the corresponding handle. After this procedure -is called, the handle can no longer be used to access the -object. +Unlink the indicated object file from the application. The +argument @var{dobj} must have been obtained by a call to +@code{dynamic-link}. After @code{dynamic-unlink} has been +called on @var{dobj}, its content is no longer accessible. @end deffn @deffn {Scheme Procedure} dynamic-func name dobj @deffnx {C Function} scm_dynamic_func (name, dobj) -Return a ``handle'' for the function @var{name} in the -shared object referred to by @var{dobj}. The handle -can be passed to @code{dynamic-call} to actually -call the function. +Search the dynamic object @var{dobj} for the C function +indicated by the string @var{name} and return some Scheme +handle that can later be used with @code{dynamic-call} to +actually call the function. -Regardless whether your C compiler prepends an underscore -@samp{_} to the global names in a program, you should -@strong{not} include this underscore in @var{name} -since it will be added automatically when necessary. +Regardless whether your C compiler prepends an underscore @samp{_} to +the global names in a program, you should @strong{not} include this +underscore in @var{function}. Guile knows whether the underscore is +needed or not and will add it when necessary. @end deffn @deffn {Scheme Procedure} dynamic-call func dobj @deffnx {C Function} scm_dynamic_call (func, dobj) -Call a C function in a dynamic object. Two styles of -invocation are supported: - -@itemize @bullet -@item @var{func} can be a function handle returned by -@code{dynamic-func}. In this case @var{dobj} is -ignored -@item @var{func} can be a string with the name of the -function to call, with @var{dobj} the handle of the -dynamic object in which to find the function. -This is equivalent to +Call the C function indicated by @var{func} and @var{dobj}. +The function is passed no arguments and its return value is +ignored. When @var{function} is something returned by +@code{dynamic-func}, call that function and ignore @var{dobj}. +When @var{func} is a string , look it up in @var{dynobj}; this +is equivalent to @smallexample - (dynamic-call (dynamic-func @var{func} @var{dobj}) #f) @end smallexample -@end itemize -In either case, the function is passed no arguments -and its return value is ignored. +Interrupts are deferred while the C function is executing (with +@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}). @end deffn @deffn {Scheme Procedure} dynamic-args-call func dobj args @@ -634,7 +625,10 @@ converted to a Scheme number and returned from the call to @code{dynamic-args-call}. @end deffn -Here is a small example that may work on GNU/Linux: +When dynamic linking is disabled or not supported on your system, +the above functions throw errors, but they are still available. + +Here is a small example that works on GNU/Linux: @smallexample (define libc-obj (dynamic-link "libc.so")) From 395b0a341fff3630fffe7d42bf2c570faeeb68e8 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 8 Aug 2002 22:43:32 +0000 Subject: [PATCH 103/306] More interbranch doc syncing. --- doc/ref/ChangeLog | 6 ++++++ doc/ref/gh.texi | 5 +---- doc/ref/posix.texi | 15 +++++---------- 3 files changed, 12 insertions(+), 14 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index a2e3a2269..df313238c 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,5 +1,11 @@ 2002-08-08 Neil Jerram + * gh.texi (Data types and constants defined by gh): Avoid + generating index entry for SCM. + + * posix.texi (Runtime Environment): Remove duplicate doc for + setenv. + * data-rep.texi, scheme-memory.texi, scheme-modules.texi: Merge recent updates from stable branch. diff --git a/doc/ref/gh.texi b/doc/ref/gh.texi index 1cadc168a..f362f6976 100644 --- a/doc/ref/gh.texi +++ b/doc/ref/gh.texi @@ -97,13 +97,10 @@ interpreter, you will have to add more libraries. The following C constants and data types are defined in gh: -@deftp {Data type} SCM -This is a C data type used to store all Scheme data, no matter what the +@code{SCM} is a C data type used to store all Scheme data, no matter what the Scheme type. Values are converted between C data types and the SCM type with utility functions described below (@pxref{Converting data between C and Scheme}). [FIXME: put in references to Jim's essay and so forth.] -@end deftp -@cindex SCM data type @defvr Constant SCM_BOOL_T @defvrx Constant SCM_BOOL_F diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index f43eb148c..dcac9d900 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -1120,7 +1120,6 @@ value is @code{#f} unless a string of the form @code{NAME=VALUE} is found, in which case the string @code{VALUE} is returned. @end deffn -@c begin (scm-doc-string "boot-9.scm" "setenv") @deffn {Scheme Procedure} setenv name value Modifies the environment of the current process, which is also the default environment inherited by child processes. @@ -1133,6 +1132,11 @@ to the environment, replacing any existing string with name matching The return value is unspecified. @end deffn +@deffn {Scheme Procedure} unsetenv name +Remove variable @var{name} from the environment. The +name can not contain a @samp{=} character. +@end deffn + @deffn {Scheme Procedure} environ [env] @deffnx {C Function} scm_environ (env) If @var{env} is omitted, return the current environment (in the @@ -1159,15 +1163,6 @@ be removed. The return value is unspecified. @end deffn -@deffn {Scheme Procedure} setenv name value -Give the environment variable @var{name} the value @var{value}. The -name can not contain a @samp{=} character. -@end deffn - -@deffn {Scheme Procedure} unsetenv name -Remove variable @var{name} from the environment. The -name can not contain a @samp{=} character. -@end deffn @node Processes @section Processes From da220f2794a54186721c6ef6ae6a45ba0c3b55a7 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 8 Aug 2002 23:02:28 +0000 Subject: [PATCH 104/306] ("scm_new_port_table_entry"): return a boxed SCM in stead of scm_t_port*. The function now takes a tag argument. --- libguile/ChangeLog | 5 +++++ libguile/fports.c | 8 ++++---- libguile/ports.c | 22 +++++++++++----------- libguile/ports.h | 2 +- libguile/strports.c | 10 +++------- libguile/vports.c | 8 +++----- 6 files changed, 27 insertions(+), 28 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 0bb54712e..2e8e6fdd5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-08-09 Han-Wen Nienhuys + + * ports.c ("scm_new_port_table_entry"): return a boxed SCM in + stead of scm_t_port*. The function now takes a tag argument. + 2002-08-08 Han-Wen Nienhuys * gc.h: add scm_debug_cells_gc_interval to public interface diff --git a/libguile/fports.c b/libguile/fports.c index 36ea33115..222b2034d 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -437,10 +437,10 @@ scm_fdes_to_port (int fdes, char *mode, SCM name) } SCM_DEFER_INTS; - pt = scm_new_port_table_entry (); - port = scm_cell (scm_tc16_fport | mode_bits, (scm_t_bits) pt); - pt->port = port; - + + port = scm_new_port_table_entry (scm_tc16_fport); + SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits); + pt = SCM_PTAB_ENTRY(port); { scm_t_fport *fp = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port"); diff --git a/libguile/ports.c b/libguile/ports.c index b93fa9d8d..80ef93d4e 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -452,10 +452,11 @@ long scm_port_table_size = 0; /* Number of ports in scm_port_table. */ long scm_port_table_room = 20; /* Size of the array. */ -scm_t_port * -scm_new_port_table_entry (void) +SCM +scm_new_port_table_entry (scm_t_bits tag) #define FUNC_NAME "scm_new_port_table_entry" { + SCM z = scm_cell (SCM_EOL, SCM_EOL); scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port"); if (scm_port_table_size == scm_port_table_room) { @@ -468,17 +469,19 @@ scm_new_port_table_entry (void) scm_port_table_room *= 2; } - entry->port = SCM_EOL; entry->entry = scm_port_table_size; entry->file_name = SCM_BOOL_F; entry->rw_active = SCM_PORT_NEITHER; - scm_port_table[scm_port_table_size] = entry; scm_port_table_size++; - return entry; + entry->port = z; + SCM_SET_CELL_TYPE(z, tag); + SCM_SETPTAB_ENTRY(z, entry); + + return z; } #undef FUNC_NAME @@ -1521,13 +1524,10 @@ scm_void_port (char *mode_str) SCM_DEFER_INTS; { int mode_bits = scm_mode_bits (mode_str); - scm_t_port * pt = scm_new_port_table_entry (); - SCM answer; - + SCM answer = scm_new_port_table_entry (scm_tc16_void_port); + scm_t_port * pt = SCM_PTAB_ENTRY(answer); + scm_port_non_buffer (pt); - answer = scm_cell (scm_tc16_void_port, 0); - SCM_SETPTAB_ENTRY (answer, pt); - pt->port = answer; SCM_SETSTREAM (answer, 0); SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits); diff --git a/libguile/ports.h b/libguile/ports.h index 3e7a0dfcb..c85ecfd55 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -257,7 +257,7 @@ SCM_API SCM scm_current_load_port (void); SCM_API SCM scm_set_current_input_port (SCM port); SCM_API SCM scm_set_current_output_port (SCM port); SCM_API SCM scm_set_current_error_port (SCM port); -SCM_API scm_t_port * scm_new_port_table_entry (void); +SCM_API SCM scm_new_port_table_entry (scm_t_bits tag); SCM_API void scm_remove_from_port_table (SCM port); SCM_API void scm_grow_port_cbuf (SCM port, size_t requested); SCM_API SCM scm_pt_size (void); diff --git a/libguile/strports.c b/libguile/strports.c index 94aa928f5..5af68bbcd 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -281,14 +281,10 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); SCM_DEFER_INTS; - pt = scm_new_port_table_entry (); - z = scm_cell (scm_tc16_strport | modes, 0); - - SCM_SETPTAB_ENTRY (z, pt); - pt->port = z; - - + z = scm_new_port_table_entry (scm_tc16_strport); + pt = SCM_PTAB_ENTRY(z); SCM_SETSTREAM (z, SCM_UNPACK (str)); + SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes); pt->write_buf = pt->read_buf = SCM_STRING_UCHARS (str); pt->read_pos = pt->write_pos = pt->read_buf + SCM_INUM (pos); pt->write_buf_size = pt->read_buf_size = str_len; diff --git a/libguile/vports.c b/libguile/vports.c index 6addd2b0c..977a69e91 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -191,12 +191,10 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, SCM_VALIDATE_STRING (2, modes); SCM_DEFER_INTS; - pt = scm_new_port_table_entry (); + z = scm_new_port_table_entry (scm_tc16_sfport); scm_port_non_buffer (pt); - z = scm_cell (scm_tc16_sfport | scm_mode_bits (SCM_STRING_CHARS (modes)), 0); - SCM_SETPTAB_ENTRY (z, pt); - pt->port = z; - + SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_STRING_CHARS (modes))); + SCM_SETSTREAM (z, SCM_UNPACK (pv)); SCM_ALLOW_INTS; return z; From be3ff02158f2bee16b1cf8a8419ba80613172ee1 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 8 Aug 2002 23:18:23 +0000 Subject: [PATCH 105/306] * gc-card.c ("sweep_card"): remove SCM_MISC_ERROR messages: print message and abort. * gc-mark.c ("scm_gc_mark_dependencies"): idem. --- libguile/ChangeLog | 5 +++++ libguile/gc-card.c | 15 ++++++++++++--- libguile/gc-malloc.c | 5 ++++- libguile/gc-mark.c | 18 ++++++++++++++---- 4 files changed, 35 insertions(+), 8 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2e8e6fdd5..5b75a0ba9 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,10 @@ 2002-08-09 Han-Wen Nienhuys + * gc-card.c ("sweep_card"): remove SCM_MISC_ERROR messages: print + message and abort. + + * gc-mark.c ("scm_gc_mark_dependencies"): idem. + * ports.c ("scm_new_port_table_entry"): return a boxed SCM in stead of scm_t_port*. The function now takes a tag argument. diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 309ac88ab..5eb6d814e 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -40,6 +40,8 @@ * If you do not wish that, delete this exception notice. */ +#include + #include "libguile/_scm.h" #include "libguile/eval.h" #include "libguile/stime.h" @@ -184,7 +186,10 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) size_t mm; #if (SCM_DEBUG_CELL_ACCESSES == 1) if (!(k < scm_numptob)) - SCM_MISC_ERROR ("undefined port type", SCM_EOL); + { + fprintf (stderr, "undefined port type"); + abort(); + } #endif /* Keep "revealed" ports alive. */ if (scm_revealed_count (scmptr) > 0) @@ -239,7 +244,10 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) k = SCM_SMOBNUM (scmptr); #if (SCM_DEBUG_CELL_ACCESSES == 1) if (!(k < scm_numsmob)) - SCM_MISC_ERROR ("undefined smob type", SCM_EOL); + { + fprintf (stderr, "undefined smob type"); + abort(); + } #endif if (scm_smobs[k].free) { @@ -265,7 +273,8 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) } break; default: - SCM_MISC_ERROR ("unknown type", SCM_EOL); + fprintf (stderr, "unknown type"); + abort(); } diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 86f2b50c1..0cd6bfaad 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -380,7 +380,10 @@ scm_must_free (void *obj) if (obj) free (obj); else - SCM_MISC_ERROR ("freeing NULL pointer", SCM_EOL); + { + fprintf (stderr,"freeing NULL pointer"); + abort (); + } } #undef FUNC_NAME diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index d7414d648..56ccd57f1 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -403,7 +403,10 @@ scm_gc_mark_dependencies (SCM p) i = SCM_PTOBNUM (ptr); #if (SCM_DEBUG_CELL_ACCESSES == 1) if (!(i < scm_numptob)) - SCM_MISC_ERROR ("undefined port type", SCM_EOL); + { + fprintf (stderr, "undefined port type"); + abort(); + } #endif if (SCM_PTAB_ENTRY(ptr)) scm_gc_mark (SCM_FILENAME (ptr)); @@ -431,7 +434,10 @@ scm_gc_mark_dependencies (SCM p) i = SCM_SMOBNUM (ptr); #if (SCM_DEBUG_CELL_ACCESSES == 1) if (!(i < scm_numsmob)) - SCM_MISC_ERROR ("undefined smob type", SCM_EOL); + { + fprintf (stderr, "undefined smob type"); + abort(); + } #endif if (scm_smobs[i].mark) { @@ -443,7 +449,8 @@ scm_gc_mark_dependencies (SCM p) } break; default: - SCM_MISC_ERROR ("unknown type", SCM_EOL); + fprintf (stderr, "unknown type"); + abort(); } /* @@ -472,7 +479,10 @@ gc_mark_loop: #endif if (!valid_cell) - SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL); + { + fprintf (stderr, "rogue pointer in heap"); + abort(); + } } if (SCM_GC_MARK_P (ptr)) From f631e15e2cb51a2644517e408251df1b580be5e1 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sat, 10 Aug 2002 14:09:55 +0000 Subject: [PATCH 106/306] * new section Primitive Procedures, documentation for scm_c_make_gsubr and scm_c_define_gsubr. --- doc/maint/guile.texi | 669 +++++++++++++++++++-------------- doc/ref/ChangeLog | 5 + doc/ref/new-docstrings.texi | 6 + doc/ref/scheme-data.texi | 2 +- doc/ref/scheme-memory.texi | 1 + doc/ref/scheme-procedures.texi | 37 ++ 6 files changed, 436 insertions(+), 284 deletions(-) diff --git a/doc/maint/guile.texi b/doc/maint/guile.texi index fa8125594..66764cd36 100644 --- a/doc/maint/guile.texi +++ b/doc/maint/guile.texi @@ -516,7 +516,7 @@ Return @code{#t} if @var{obj} is a debug object. @end deffn dynamic-link -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:212 +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:171 @deffn {Scheme Procedure} dynamic-link filename @deffnx {C Function} scm_dynamic_link (filename) Find the shared object (shared library) denoted by @@ -532,7 +532,7 @@ such as @file{/usr/lib} and @file{/usr/local/lib}. @end deffn dynamic-object? -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:227 +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:186 @deffn {Scheme Procedure} dynamic-object? obj @deffnx {C Function} scm_dynamic_object_p (obj) Return @code{#t} if @var{obj} is a dynamic object handle, @@ -540,7 +540,7 @@ or @code{#f} otherwise. @end deffn dynamic-unlink -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:241 +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:200 @deffn {Scheme Procedure} dynamic-unlink dobj @deffnx {C Function} scm_dynamic_unlink (dobj) Unlink a dynamic object from the application, if possible. The @@ -551,7 +551,7 @@ object. @end deffn dynamic-func -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:266 +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:225 @deffn {Scheme Procedure} dynamic-func name dobj @deffnx {C Function} scm_dynamic_func (name, dobj) Return a ``handle'' for the function @var{name} in the @@ -566,7 +566,7 @@ since it will be added automatically when necessary. @end deffn dynamic-call -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:308 +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:267 @deffn {Scheme Procedure} dynamic-call func dobj @deffnx {C Function} scm_dynamic_call (func, dobj) Call a C function in a dynamic object. Two styles of @@ -591,7 +591,7 @@ and its return value is ignored. @end deffn dynamic-args-call -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:363 +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:322 @deffn {Scheme Procedure} dynamic-args-call func dobj args @deffnx {C Function} scm_dynamic_args_call (func, dobj, args) Call the C function indicated by @var{func} and @var{dobj}, @@ -664,7 +664,7 @@ a-cont @end deffn environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:129 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:130 @deffn {Scheme Procedure} environment? obj @deffnx {C Function} scm_environment_p (obj) Return @code{#t} if @var{obj} is an environment, or @code{#f} @@ -672,7 +672,7 @@ otherwise. @end deffn environment-bound? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:140 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:141 @deffn {Scheme Procedure} environment-bound? env sym @deffnx {C Function} scm_environment_bound_p (env, sym) Return @code{#t} if @var{sym} is bound in @var{env}, or @@ -680,7 +680,7 @@ Return @code{#t} if @var{sym} is bound in @var{env}, or @end deffn environment-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:155 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:156 @deffn {Scheme Procedure} environment-ref env sym @deffnx {C Function} scm_environment_ref (env, sym) Return the value of the location bound to @var{sym} in @@ -689,7 +689,7 @@ Return the value of the location bound to @var{sym} in @end deffn environment-fold -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:225 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:226 @deffn {Scheme Procedure} environment-fold env proc init @deffnx {C Function} scm_environment_fold (env, proc, init) Iterate over all the bindings in @var{env}, accumulating some @@ -726,7 +726,7 @@ using environment-fold: @end deffn environment-define -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:260 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:261 @deffn {Scheme Procedure} environment-define env sym val @deffnx {C Function} scm_environment_define (env, sym, val) Bind @var{sym} to a new location containing @var{val} in @@ -739,7 +739,7 @@ immutable, signal an @code{environment:immutable-binding} error. @end deffn environment-undefine -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:286 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:287 @deffn {Scheme Procedure} environment-undefine env sym @deffnx {C Function} scm_environment_undefine (env, sym) Remove any binding for @var{sym} from @var{env}. If @var{sym} @@ -750,7 +750,7 @@ immutable, signal an @code{environment:immutable-binding} error. @end deffn environment-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:314 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:315 @deffn {Scheme Procedure} environment-set! env sym val @deffnx {C Function} scm_environment_set_x (env, sym, val) If @var{env} binds @var{sym} to some location, change that @@ -763,7 +763,7 @@ to an immutable location, signal an @end deffn environment-cell -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:349 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:350 @deffn {Scheme Procedure} environment-cell env sym for_write @deffnx {C Function} scm_environment_cell (env, sym, for_write) Return the value cell which @var{env} binds to @var{sym}, or @@ -781,7 +781,7 @@ re-bound to a new value cell, or becomes undefined. @end deffn environment-observe -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:401 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:402 @deffn {Scheme Procedure} environment-observe env proc @deffnx {C Function} scm_environment_observe (env, proc) Whenever @var{env}'s bindings change, apply @var{proc} to @@ -793,7 +793,7 @@ token is unspecified. @end deffn environment-observe-weak -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:418 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:419 @deffn {Scheme Procedure} environment-observe-weak env proc @deffnx {C Function} scm_environment_observe_weak (env, proc) This function is the same as environment-observe, except that @@ -805,7 +805,7 @@ list of observing procedures. @end deffn environment-unobserve -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:454 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:455 @deffn {Scheme Procedure} environment-unobserve token @deffnx {C Function} scm_environment_unobserve (token) Cancel the observation request which returned the value @@ -817,7 +817,7 @@ bindings change. @end deffn make-leaf-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1031 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1026 @deffn {Scheme Procedure} make-leaf-environment @deffnx {C Function} scm_make_leaf_environment () Create a new leaf environment, containing no bindings. @@ -826,7 +826,7 @@ will be mutable. @end deffn leaf-environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1054 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1049 @deffn {Scheme Procedure} leaf-environment? object @deffnx {C Function} scm_leaf_environment_p (object) Return @code{#t} if object is a leaf environment, or @code{#f} @@ -834,7 +834,7 @@ otherwise. @end deffn make-eval-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1419 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1414 @deffn {Scheme Procedure} make-eval-environment local imported @deffnx {C Function} scm_make_eval_environment (local, imported) Return a new environment object eval whose bindings are the @@ -861,7 +861,7 @@ In typical use, @var{local} will be a finite environment, and @end deffn eval-environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1456 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1451 @deffn {Scheme Procedure} eval-environment? object @deffnx {C Function} scm_eval_environment_p (object) Return @code{#t} if object is an eval environment, or @code{#f} @@ -869,35 +869,35 @@ otherwise. @end deffn eval-environment-local -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1466 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1461 @deffn {Scheme Procedure} eval-environment-local env @deffnx {C Function} scm_eval_environment_local (env) Return the local environment of eval environment @var{env}. @end deffn eval-environment-set-local! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1478 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1473 @deffn {Scheme Procedure} eval-environment-set-local! env local @deffnx {C Function} scm_eval_environment_set_local_x (env, local) Change @var{env}'s local environment to @var{local}. @end deffn eval-environment-imported -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1504 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1499 @deffn {Scheme Procedure} eval-environment-imported env @deffnx {C Function} scm_eval_environment_imported (env) Return the imported environment of eval environment @var{env}. @end deffn eval-environment-set-imported! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1516 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1511 @deffn {Scheme Procedure} eval-environment-set-imported! env imported @deffnx {C Function} scm_eval_environment_set_imported_x (env, imported) Change @var{env}'s imported environment to @var{imported}. @end deffn make-import-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1839 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1834 @deffn {Scheme Procedure} make-import-environment imports conflict_proc @deffnx {C Function} scm_make_import_environment (imports, conflict_proc) Return a new environment @var{imp} whose bindings are the union @@ -928,7 +928,7 @@ if one of its imported environments changes. @end deffn import-environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1868 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1863 @deffn {Scheme Procedure} import-environment? object @deffnx {C Function} scm_import_environment_p (object) Return @code{#t} if object is an import environment, or @@ -936,7 +936,7 @@ Return @code{#t} if object is an import environment, or @end deffn import-environment-imports -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1879 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1874 @deffn {Scheme Procedure} import-environment-imports env @deffnx {C Function} scm_import_environment_imports (env) Return the list of environments imported by the import @@ -944,7 +944,7 @@ environment @var{env}. @end deffn import-environment-set-imports! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1892 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1887 @deffn {Scheme Procedure} import-environment-set-imports! env imports @deffnx {C Function} scm_import_environment_set_imports_x (env, imports) Change @var{env}'s list of imported environments to @@ -952,7 +952,7 @@ Change @var{env}'s list of imported environments to @end deffn make-export-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2159 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2154 @deffn {Scheme Procedure} make-export-environment private signature @deffnx {C Function} scm_make_export_environment (private, signature) Return a new environment @var{exp} containing only those @@ -1002,7 +1002,7 @@ if the bindings in private change. @end deffn export-environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2194 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2189 @deffn {Scheme Procedure} export-environment? object @deffnx {C Function} scm_export_environment_p (object) Return @code{#t} if object is an export environment, or @@ -1010,35 +1010,35 @@ Return @code{#t} if object is an export environment, or @end deffn export-environment-private -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2204 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2199 @deffn {Scheme Procedure} export-environment-private env @deffnx {C Function} scm_export_environment_private (env) Return the private environment of export environment @var{env}. @end deffn export-environment-set-private! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2216 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2211 @deffn {Scheme Procedure} export-environment-set-private! env private @deffnx {C Function} scm_export_environment_set_private_x (env, private) Change the private environment of export environment @var{env}. @end deffn export-environment-signature -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2238 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2233 @deffn {Scheme Procedure} export-environment-signature env @deffnx {C Function} scm_export_environment_signature (env) Return the signature of export environment @var{env}. @end deffn export-environment-set-signature! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2312 +@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2307 @deffn {Scheme Procedure} export-environment-set-signature! env signature @deffnx {C Function} scm_export_environment_set_signature_x (env, signature) Change the signature of export environment @var{env}. @end deffn eq? -@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:62 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:68 @deffn {Scheme Procedure} eq? x y Return @code{#t} iff @var{x} references the same object as @var{y}. @code{eq?} is similar to @code{eqv?} except that in some cases it is @@ -1047,7 +1047,7 @@ capable of discerning distinctions finer than those detectable by @end deffn eqv? -@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:85 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:91 @deffn {Scheme Procedure} eqv? x y The @code{eqv?} procedure defines a useful equivalence relation on objects. Briefly, it returns @code{#t} if @var{x} and @var{y} should normally be @@ -1057,7 +1057,7 @@ and inexact numbers. @end deffn equal? -@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:138 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:144 @deffn {Scheme Procedure} equal? x y Return @code{#t} iff @var{x} and @var{y} are recursively @code{eqv?} equivalent. @code{equal?} recursively compares the contents of pairs, @@ -1095,7 +1095,7 @@ must be an integer value. @end deffn apply:nconc2last -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3409 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3412 @deffn {Scheme Procedure} apply:nconc2last lst @deffnx {C Function} scm_nconc2last (lst) Given a list (@var{arg1} @dots{} @var{args}), this function @@ -1108,7 +1108,7 @@ destroys its argument, so use with care. @end deffn force -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3945 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3948 @deffn {Scheme Procedure} force x @deffnx {C Function} scm_force (x) If the promise @var{x} has not been computed yet, compute and @@ -1117,7 +1117,7 @@ value. @end deffn promise? -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3968 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3971 @deffn {Scheme Procedure} promise? obj @deffnx {C Function} scm_promise_p (obj) Return true if @var{obj} is a promise, i.e. a delayed computation @@ -1125,7 +1125,7 @@ Return true if @var{obj} is a promise, i.e. a delayed computation @end deffn cons-source -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3980 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3983 @deffn {Scheme Procedure} cons-source xorig x y @deffnx {C Function} scm_cons_source (xorig, x, y) Create and return a new pair whose car and cdr are @var{x} and @var{y}. @@ -1134,7 +1134,7 @@ with the new pair. @end deffn copy-tree -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4000 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4003 @deffn {Scheme Procedure} copy-tree obj @deffnx {C Function} scm_copy_tree (obj) Recursively copy the data tree that is bound to @var{obj}, and return a @@ -1145,7 +1145,7 @@ any other object. @end deffn primitive-eval -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4093 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4096 @deffn {Scheme Procedure} primitive-eval exp @deffnx {C Function} scm_primitive_eval (exp) Evaluate @var{exp} in the top-level environment specified by @@ -1153,7 +1153,7 @@ the current module. @end deffn eval -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4162 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4165 @deffn {Scheme Procedure} eval exp module @deffnx {C Function} scm_eval (exp, module) Evaluate @var{exp}, a list representing a Scheme expression, @@ -1164,7 +1164,7 @@ is reset to its previous value when @var{eval} returns. @end deffn eval-options-interface -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:1747 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:1749 @deffn {Scheme Procedure} eval-options-interface [setting] @deffnx {C Function} scm_eval_options_interface (setting) Option interface for the evaluation options. Instead of using @@ -1173,7 +1173,7 @@ this procedure directly, use the procedures @code{eval-enable}, @end deffn evaluator-traps-interface -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:1764 +@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:1766 @deffn {Scheme Procedure} evaluator-traps-interface [setting] @deffnx {C Function} scm_evaluator_traps (setting) Option interface for the evaluator trap options. @@ -1193,7 +1193,7 @@ implemented by the C function "scm_map" @end deffn load-extension -@c snarfed from /home/ghouston/guile/guile-core/libguile/extensions.c:152 +@c snarfed from /home/ghouston/guile/guile-core/libguile/extensions.c:154 @deffn {Scheme Procedure} load-extension lib init @deffnx {C Function} scm_load_extension (lib, init) Load and initialize the extension designated by LIB and INIT. @@ -1356,16 +1356,25 @@ current interfaces. If a file cannot be opened with the access requested, @code{open-file} throws an exception. @end deffn + set-debug-cell-accesses! +@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:210 +@deffn {Scheme Procedure} set-debug-cell-accesses! flag +@deffnx {C Function} scm_set_debug_cell_accesses_x (flag) +This function is used to turn on checking for a debug version of GUILE. This version does not support this functionality + +@end deffn + gc-stats -@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:735 +@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:303 @deffn {Scheme Procedure} gc-stats @deffnx {C Function} scm_gc_stats () Return an association list of statistics about Guile's current use of storage. + @end deffn object-address -@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:832 +@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:424 @deffn {Scheme Procedure} object-address obj @deffnx {C Function} scm_object_address (obj) Return an integer that for the lifetime of @var{obj} is uniquely @@ -1373,7 +1382,7 @@ returned by this function for @var{obj} @end deffn gc -@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:843 +@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:435 @deffn {Scheme Procedure} gc @deffnx {C Function} scm_gc () Scans all of SCM objects and reclaims for further use those that are @@ -1703,7 +1712,7 @@ from the arguments @var{initargs}. @end deffn make -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2010 +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2026 @deffn {Scheme Procedure} make . args @deffnx {C Function} scm_make (args) Make a new object. @var{args} must contain the class and @@ -1711,21 +1720,21 @@ all necessary initialization information. @end deffn find-method -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2103 +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2119 @deffn {Scheme Procedure} find-method . l @deffnx {C Function} scm_find_method (l) @end deffn %method-more-specific? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2123 +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2139 @deffn {Scheme Procedure} %method-more-specific? m1 m2 targs @deffnx {C Function} scm_sys_method_more_specific_p (m1, m2, targs) @end deffn %goops-loaded -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2648 +@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2664 @deffn {Scheme Procedure} %goops-loaded @deffnx {C Function} scm_sys_goops_loaded () Announce that GOOPS is loaded and perform initialization @@ -2591,7 +2600,7 @@ an error is signalled. @end deffn procedure->syntax -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:104 +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:107 @deffn {Scheme Procedure} procedure->syntax code @deffnx {C Function} scm_makacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2601,7 +2610,7 @@ environment. @end deffn procedure->macro -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:125 +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:130 @deffn {Scheme Procedure} procedure->macro code @deffnx {C Function} scm_makmacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2619,7 +2628,7 @@ environment. For example: @end deffn procedure->memoizing-macro -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:143 +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:155 @deffn {Scheme Procedure} procedure->memoizing-macro code @deffnx {C Function} scm_makmmacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2634,7 +2643,7 @@ form of the containing code. @end deffn macro? -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:155 +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:167 @deffn {Scheme Procedure} macro? obj @deffnx {C Function} scm_macro_p (obj) Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a @@ -2642,7 +2651,7 @@ syntax transformer. @end deffn macro-type -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:173 +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:187 @deffn {Scheme Procedure} macro-type m @deffnx {C Function} scm_macro_type (m) Return one of the symbols @code{syntax}, @code{macro} or @@ -2653,14 +2662,14 @@ returned. @end deffn macro-name -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:191 +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:207 @deffn {Scheme Procedure} macro-name m @deffnx {C Function} scm_macro_name (m) Return the name of the macro @var{m}. @end deffn macro-transformer -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:202 +@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:218 @deffn {Scheme Procedure} macro-transformer m @deffnx {C Function} scm_macro_transformer (m) Return the transformer of the macro @var{m}. @@ -2941,7 +2950,7 @@ Return the number of bits necessary to represent @var{n}. @end deffn number->string -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:2330 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:2336 @deffn {Scheme Procedure} number->string n [radix] @deffnx {C Function} scm_number_to_string (n, radix) Return a string holding the external representation of the @@ -2950,7 +2959,7 @@ inexact, a radix of 10 will be used. @end deffn string->number -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:2989 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:2995 @deffn {Scheme Procedure} string->number string [radix] @deffnx {C Function} scm_string_to_number (string, radix) Return a number of the maximally precise representation @@ -2964,13 +2973,13 @@ syntactically valid notation for a number, then @end deffn number? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3058 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3064 @deffn {Scheme Procedure} number? implemented by the C function "scm_number_p" @end deffn complex? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3070 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3076 @deffn {Scheme Procedure} complex? x @deffnx {C Function} scm_number_p (x) Return @code{#t} if @var{x} is a complex number, @code{#f} @@ -2981,13 +2990,13 @@ rational or integer number. @end deffn real? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3078 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3084 @deffn {Scheme Procedure} real? implemented by the C function "scm_real_p" @end deffn rational? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3091 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3097 @deffn {Scheme Procedure} rational? x @deffnx {C Function} scm_real_p (x) Return @code{#t} if @var{x} is a rational number, @code{#f} @@ -2999,7 +3008,7 @@ precision. @end deffn integer? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3112 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3118 @deffn {Scheme Procedure} integer? x @deffnx {C Function} scm_integer_p (x) Return @code{#t} if @var{x} is an integer number, @code{#f} @@ -3007,7 +3016,7 @@ else. @end deffn inexact? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3137 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3143 @deffn {Scheme Procedure} inexact? x @deffnx {C Function} scm_inexact_p (x) Return @code{#t} if @var{x} is an inexact number, @code{#f} @@ -3015,7 +3024,7 @@ else. @end deffn $expt -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4297 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4303 @deffn {Scheme Procedure} $expt x y @deffnx {C Function} scm_sys_expt (x, y) Return @var{x} raised to the power of @var{y}. This @@ -3023,7 +3032,7 @@ procedure does not accept complex arguments. @end deffn $atan2 -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4313 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4319 @deffn {Scheme Procedure} $atan2 x y @deffnx {C Function} scm_sys_atan2 (x, y) Return the arc tangent of the two arguments @var{x} and @@ -3034,7 +3043,7 @@ procedure does not accept complex arguments. @end deffn make-rectangular -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4326 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4332 @deffn {Scheme Procedure} make-rectangular real imaginary @deffnx {C Function} scm_make_rectangular (real, imaginary) Return a complex number constructed of the given @var{real} and @@ -3042,14 +3051,14 @@ Return a complex number constructed of the given @var{real} and @end deffn make-polar -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4339 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4345 @deffn {Scheme Procedure} make-polar x y @deffnx {C Function} scm_make_polar (x, y) Return the complex number @var{x} * e^(i * @var{y}). @end deffn inexact->exact -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4474 +@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4480 @deffn {Scheme Procedure} inexact->exact z @deffnx {C Function} scm_inexact_to_exact (z) Return an exact number that is numerically closest to @var{z}. @@ -3269,14 +3278,14 @@ Set the current default error port to @var{port}. @end deffn port-revealed -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:578 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:571 @deffn {Scheme Procedure} port-revealed port @deffnx {C Function} scm_port_revealed (port) Return the revealed count for @var{port}. @end deffn set-port-revealed! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:591 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:584 @deffn {Scheme Procedure} set-port-revealed! port rcount @deffnx {C Function} scm_set_port_revealed_x (port, rcount) Sets the revealed count for a port to a given value. @@ -3284,7 +3293,7 @@ The return value is unspecified. @end deffn port-mode -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:634 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:627 @deffn {Scheme Procedure} port-mode port @deffnx {C Function} scm_port_mode (port) Return the port modes associated with the open port @var{port}. @@ -3294,7 +3303,7 @@ used only during port creation are not retained. @end deffn close-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:671 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:664 @deffn {Scheme Procedure} close-port port @deffnx {C Function} scm_close_port (port) Close the specified port object. Return @code{#t} if it @@ -3306,7 +3315,7 @@ descriptors. @end deffn close-input-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:699 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:692 @deffn {Scheme Procedure} close-input-port port @deffnx {C Function} scm_close_input_port (port) Close the specified input port object. The routine has no effect if @@ -3318,7 +3327,7 @@ which can close file descriptors. @end deffn close-output-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:714 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:707 @deffn {Scheme Procedure} close-output-port port @deffnx {C Function} scm_close_output_port (port) Close the specified output port object. The routine has no effect if @@ -3330,7 +3339,7 @@ which can close file descriptors. @end deffn port-for-each -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:731 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:724 @deffn {Scheme Procedure} port-for-each proc @deffnx {C Function} scm_port_for_each (proc) Apply @var{proc} to each port in the Guile port table @@ -3342,7 +3351,7 @@ have no effect as far as @var{port-for-each} is concerned. @end deffn input-port? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:772 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:765 @deffn {Scheme Procedure} input-port? x @deffnx {C Function} scm_input_port_p (x) Return @code{#t} if @var{x} is an input port, otherwise return @@ -3351,7 +3360,7 @@ Return @code{#t} if @var{x} is an input port, otherwise return @end deffn output-port? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:783 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:776 @deffn {Scheme Procedure} output-port? x @deffnx {C Function} scm_output_port_p (x) Return @code{#t} if @var{x} is an output port, otherwise return @@ -3360,7 +3369,7 @@ Return @code{#t} if @var{x} is an output port, otherwise return @end deffn port? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:795 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:788 @deffn {Scheme Procedure} port? x @deffnx {C Function} scm_port_p (x) Return a boolean indicating whether @var{x} is a port. @@ -3369,7 +3378,7 @@ Equivalent to @code{(or (input-port? @var{x}) (output-port? @end deffn port-closed? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:805 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:798 @deffn {Scheme Procedure} port-closed? port @deffnx {C Function} scm_port_closed_p (port) Return @code{#t} if @var{port} is closed or @code{#f} if it is @@ -3377,7 +3386,7 @@ open. @end deffn eof-object? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:816 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:809 @deffn {Scheme Procedure} eof-object? x @deffnx {C Function} scm_eof_object_p (x) Return @code{#t} if @var{x} is an end-of-file object; otherwise @@ -3385,7 +3394,7 @@ return @code{#f}. @end deffn force-output -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:830 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:823 @deffn {Scheme Procedure} force-output [port] @deffnx {C Function} scm_force_output (port) Flush the specified output port, or the current output port if @var{port} @@ -3398,7 +3407,7 @@ The return value is unspecified. @end deffn flush-all-ports -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:848 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:841 @deffn {Scheme Procedure} flush-all-ports @deffnx {C Function} scm_flush_all_ports () Equivalent to calling @code{force-output} on @@ -3406,7 +3415,7 @@ all open output ports. The return value is unspecified. @end deffn read-char -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:866 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:859 @deffn {Scheme Procedure} read-char [port] @deffnx {C Function} scm_read_char (port) Return the next character available from @var{port}, updating @@ -3415,7 +3424,7 @@ characters are available, the end-of-file object is returned. @end deffn peek-char -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1192 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1185 @deffn {Scheme Procedure} peek-char [port] @deffnx {C Function} scm_peek_char (port) Return the next character available from @var{port}, @@ -3433,7 +3442,7 @@ to @code{read-char} would have hung.} @end deffn unread-char -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1213 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1206 @deffn {Scheme Procedure} unread-char cobj [port] @deffnx {C Function} scm_unread_char (cobj, port) Place @var{char} in @var{port} so that it will be read by the @@ -3443,7 +3452,7 @@ not supplied, the current input port is used. @end deffn unread-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1236 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1229 @deffn {Scheme Procedure} unread-string str port @deffnx {C Function} scm_unread_string (str, port) Place the string @var{str} in @var{port} so that its characters will be @@ -3453,7 +3462,7 @@ unread characters will be read again in last-in first-out order. If @end deffn seek -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1275 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1268 @deffn {Scheme Procedure} seek fd_port offset whence @deffnx {C Function} scm_seek (fd_port, offset, whence) Sets the current position of @var{fd/port} to the integer @@ -3482,7 +3491,7 @@ that the current position of a port can be obtained using: @end deffn truncate-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1330 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1323 @deffn {Scheme Procedure} truncate-file object [length] @deffnx {C Function} scm_truncate_file (object, length) Truncates the object referred to by @var{object} to at most @@ -3494,21 +3503,21 @@ position. The return value is unspecified. @end deffn port-line -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1383 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1376 @deffn {Scheme Procedure} port-line port @deffnx {C Function} scm_port_line (port) Return the current line number for @var{port}. @end deffn set-port-line! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1394 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1387 @deffn {Scheme Procedure} set-port-line! port line @deffnx {C Function} scm_set_port_line_x (port, line) Set the current line number for @var{port} to @var{line}. @end deffn port-column -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1415 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1408 @deffn {Scheme Procedure} port-column port @deffnx {Scheme Procedure} port-line port @deffnx {C Function} scm_port_column (port) @@ -3523,7 +3532,7 @@ what non-programmers will find most natural.) @end deffn set-port-column! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1428 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1421 @deffn {Scheme Procedure} set-port-column! port column @deffnx {Scheme Procedure} set-port-line! port line @deffnx {C Function} scm_set_port_column_x (port, column) @@ -3532,7 +3541,7 @@ current input port if none is specified. @end deffn port-filename -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1443 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1436 @deffn {Scheme Procedure} port-filename port @deffnx {C Function} scm_port_filename (port) Return the filename associated with @var{port}. This function returns @@ -3541,7 +3550,7 @@ when called on the current input, output and error ports respectively. @end deffn set-port-filename! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1457 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1450 @deffn {Scheme Procedure} set-port-filename! port filename @deffnx {C Function} scm_set_port_filename_x (port, filename) Change the filename associated with @var{port}, using the current input @@ -3551,7 +3560,7 @@ source of data, but only the value that is returned by @end deffn %make-void-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1551 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1546 @deffn {Scheme Procedure} %make-void-port mode @deffnx {C Function} scm_sys_make_void_port (mode) Create and return a new void port. A void port acts like @@ -3571,7 +3580,7 @@ and @code{print-options}. @end deffn simple-format -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:921 +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:920 @deffn {Scheme Procedure} simple-format destination message . args @deffnx {C Function} scm_simple_format (destination, message, args) Write @var{message} to @var{destination}, defaulting to @@ -3588,7 +3597,7 @@ containing the formatted text. Does not add a trailing newline. @end deffn newline -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1009 +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1008 @deffn {Scheme Procedure} newline [port] @deffnx {C Function} scm_newline (port) Send a newline to @var{port}. @@ -3596,14 +3605,14 @@ If @var{port} is omitted, send to the current output port. @end deffn write-char -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1024 +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1023 @deffn {Scheme Procedure} write-char chr [port] @deffnx {C Function} scm_write_char (chr, port) Send character @var{chr} to @var{port}. @end deffn port-with-print-state -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1078 +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1077 @deffn {Scheme Procedure} port-with-print-state port pstate @deffnx {C Function} scm_port_with_print_state (port, pstate) Create a new port which behaves like @var{port}, but with an @@ -3611,7 +3620,7 @@ included print state @var{pstate}. @end deffn get-print-state -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1093 +@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1092 @deffn {Scheme Procedure} get-print-state port @deffnx {C Function} scm_get_print_state (port) Return the print state of the port @var{port}. If @var{port} @@ -3743,7 +3752,7 @@ Remove any value associated with @var{prop} and @var{obj}. @c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:376 @deffn {Scheme Procedure} random n [state] @deffnx {C Function} scm_random (n, state) -Return a number in [0,N). +Return a number in [0, N). Accepts a positive integer or real n and returns a number of the same type between zero (inclusive) and @@ -4088,7 +4097,7 @@ structures. @end deffn restore-signals -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:345 +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:346 @deffn {Scheme Procedure} restore-signals @deffnx {C Function} scm_restore_signals () Return all signal handlers to the values they had before any call to @@ -4096,7 +4105,7 @@ Return all signal handlers to the values they had before any call to @end deffn alarm -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:384 +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:383 @deffn {Scheme Procedure} alarm i @deffnx {C Function} scm_alarm (i) Set a timer to raise a @code{SIGALRM} signal after the specified @@ -4111,7 +4120,7 @@ no previous alarm, the return value is zero. @end deffn setitimer -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:414 +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:413 @deffn {Scheme Procedure} setitimer which_timer interval_seconds interval_microseconds value_seconds value_microseconds @deffnx {C Function} scm_setitimer (which_timer, interval_seconds, interval_microseconds, value_seconds, value_microseconds) Set the timer specified by @var{which_timer} according to the given @@ -4132,7 +4141,7 @@ the seconds and microseconds of the timer @code{it_value}. @end deffn getitimer -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:455 +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:454 @deffn {Scheme Procedure} getitimer which_timer @deffnx {C Function} scm_getitimer (which_timer) Return information about the timer specified by @var{which_timer} @@ -4149,7 +4158,7 @@ the seconds and microseconds of the timer @code{it_value}. @end deffn pause -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:482 +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:481 @deffn {Scheme Procedure} pause @deffnx {C Function} scm_pause () Pause the current process (thread?) until a signal arrives whose @@ -4158,7 +4167,7 @@ handler procedure. The return value is unspecified. @end deffn sleep -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:495 +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:494 @deffn {Scheme Procedure} sleep i @deffnx {C Function} scm_sleep (i) Wait for the given number of seconds (an integer) or until a signal @@ -4167,7 +4176,7 @@ of seconds remaining otherwise. @end deffn usleep -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:513 +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:512 @deffn {Scheme Procedure} usleep i @deffnx {C Function} scm_usleep (i) Sleep for I microseconds. @code{usleep} is not available on @@ -4175,7 +4184,7 @@ all platforms. @end deffn raise -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:542 +@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:541 @deffn {Scheme Procedure} raise sig @deffnx {C Function} scm_raise (sig) Sends a specified signal @var{sig} to the current process, where @@ -4225,7 +4234,7 @@ is not specified. @end deffn sorted? -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:453 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:454 @deffn {Scheme Procedure} sorted? items less @deffnx {C Function} scm_sorted_p (items, less) Return @code{#t} iff @var{items} is a list or a vector such that @@ -4234,7 +4243,7 @@ applied to all elements i - 1 and i @end deffn merge -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:526 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:527 @deffn {Scheme Procedure} merge alist blist less @deffnx {C Function} scm_merge (alist, blist, less) Merge two already sorted lists into one. @@ -4247,7 +4256,7 @@ Note: this does _not_ accept vectors. @end deffn merge! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:639 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:640 @deffn {Scheme Procedure} merge! alist blist less @deffnx {C Function} scm_merge_x (alist, blist, less) Takes two lists @var{alist} and @var{blist} such that @@ -4260,7 +4269,7 @@ Note: this does _not_ accept vectors. @end deffn sort! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:715 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:716 @deffn {Scheme Procedure} sort! items less @deffnx {C Function} scm_sort_x (items, less) Sort the sequence @var{items}, which may be a list or a @@ -4271,7 +4280,7 @@ This is not a stable sort. @end deffn sort -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:749 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:750 @deffn {Scheme Procedure} sort items less @deffnx {C Function} scm_sort (items, less) Sort the sequence @var{items}, which may be a list or a @@ -4280,7 +4289,7 @@ elements. This is not a stable sort. @end deffn stable-sort! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:845 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:858 @deffn {Scheme Procedure} stable-sort! items less @deffnx {C Function} scm_stable_sort_x (items, less) Sort the sequence @var{items}, which may be a list or a @@ -4291,7 +4300,7 @@ This is a stable sort. @end deffn stable-sort -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:885 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:902 @deffn {Scheme Procedure} stable-sort items less @deffnx {C Function} scm_stable_sort (items, less) Sort the sequence @var{items}, which may be a list or a @@ -4300,7 +4309,7 @@ This is a stable sort. @end deffn sort-list! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:931 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:947 @deffn {Scheme Procedure} sort-list! items less @deffnx {C Function} scm_sort_list_x (items, less) Sort the list @var{items}, using @var{less} for comparing the @@ -4310,7 +4319,7 @@ This is a stable sort. @end deffn sort-list -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:945 +@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:961 @deffn {Scheme Procedure} sort-list items less @deffnx {C Function} scm_sort_list (items, less) Sort the list @var{items}, using @var{less} for comparing the @@ -4997,7 +5006,7 @@ equal to @var{s2} regardless of case. @end deffn object->string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:321 +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:325 @deffn {Scheme Procedure} object->string obj [printer] @deffnx {C Function} scm_object_to_string (obj, printer) Return a Scheme string obtained by printing @var{obj}. @@ -5006,7 +5015,7 @@ argument @var{printer} (default: @code{write}). @end deffn call-with-output-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:345 +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:349 @deffn {Scheme Procedure} call-with-output-string proc @deffnx {C Function} scm_call_with_output_string (proc) Calls the one-argument procedure @var{proc} with a newly created output @@ -5015,7 +5024,7 @@ written into the port is returned. @end deffn call-with-input-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:364 +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:368 @deffn {Scheme Procedure} call-with-input-string string proc @deffnx {C Function} scm_call_with_input_string (string, proc) Calls the one-argument procedure @var{proc} with a newly @@ -5024,7 +5033,7 @@ read. The value yielded by the @var{proc} is returned. @end deffn open-input-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:377 +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:381 @deffn {Scheme Procedure} open-input-string str @deffnx {C Function} scm_open_input_string (str) Take a string and return an input port that delivers characters @@ -5034,7 +5043,7 @@ by the garbage collector if it becomes inaccessible. @end deffn open-output-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:391 +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:395 @deffn {Scheme Procedure} open-output-string @deffnx {C Function} scm_open_output_string () Return an output port that will accumulate characters for @@ -5045,7 +5054,7 @@ inaccessible. @end deffn get-output-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:408 +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:412 @deffn {Scheme Procedure} get-output-string port @deffnx {C Function} scm_get_output_string (port) Given an output port created by @code{open-output-string}, @@ -5054,7 +5063,7 @@ output to the port so far. @end deffn eval-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:467 +@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:471 @deffn {Scheme Procedure} eval-string string @deffnx {C Function} scm_eval_string (string) Evaluate @var{string} as the text representation of a Scheme @@ -5238,7 +5247,7 @@ Set the name of the vtable @var{vtable} to @var{name}. @end deffn symbol? -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:164 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:159 @deffn {Scheme Procedure} symbol? obj @deffnx {C Function} scm_symbol_p (obj) Return @code{#t} if @var{obj} is a symbol, otherwise return @@ -5246,7 +5255,7 @@ Return @code{#t} if @var{obj} is a symbol, otherwise return @end deffn symbol-interned? -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:174 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:169 @deffn {Scheme Procedure} symbol-interned? symbol @deffnx {C Function} scm_symbol_interned_p (symbol) Return @code{#t} if @var{symbol} is interned, otherwise return @@ -5254,14 +5263,14 @@ Return @code{#t} if @var{symbol} is interned, otherwise return @end deffn make-symbol -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:186 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:181 @deffn {Scheme Procedure} make-symbol name @deffnx {C Function} scm_make_symbol (name) Return a new uninterned symbol with the name @var{name}. The returned symbol is guaranteed to be unique and future calls to @code{string->symbol} will not return it. @end deffn symbol->string -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:222 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:217 @deffn {Scheme Procedure} symbol->string s @deffnx {C Function} scm_symbol_to_string (s) Return the name of @var{symbol} as a string. If the symbol was @@ -5290,7 +5299,7 @@ standard case is lower case: @end deffn string->symbol -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:255 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:250 @deffn {Scheme Procedure} string->symbol string @deffnx {C Function} scm_string_to_symbol (string) Return the symbol whose name is @var{string}. This procedure @@ -5316,7 +5325,7 @@ standard case is lower case: @end deffn gensym -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:277 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:272 @deffn {Scheme Procedure} gensym [prefix] @deffnx {C Function} scm_gensym (prefix) Create a new symbol with a name constructed from a prefix and @@ -5327,35 +5336,35 @@ resetting the counter. @end deffn symbol-hash -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:309 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:304 @deffn {Scheme Procedure} symbol-hash symbol @deffnx {C Function} scm_symbol_hash (symbol) Return a hash value for @var{symbol}. @end deffn symbol-fref -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:319 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:314 @deffn {Scheme Procedure} symbol-fref s @deffnx {C Function} scm_symbol_fref (s) Return the contents of @var{symbol}'s @dfn{function slot}. @end deffn symbol-pref -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:330 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:325 @deffn {Scheme Procedure} symbol-pref s @deffnx {C Function} scm_symbol_pref (s) Return the @dfn{property list} currently associated with @var{symbol}. @end deffn symbol-fset! -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:341 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:336 @deffn {Scheme Procedure} symbol-fset! s val @deffnx {C Function} scm_symbol_fset_x (s, val) Change the binding of @var{symbol}'s function slot. @end deffn symbol-pset! -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:353 +@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:348 @deffn {Scheme Procedure} symbol-pset! s val @deffnx {C Function} scm_symbol_pset_x (s, val) Change the binding of @var{symbol}'s property slot. @@ -5495,7 +5504,7 @@ given arguments. Analogous to @code{list}. @end deffn make-vector -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:179 +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:183 @deffn {Scheme Procedure} make-vector k [fill] @deffnx {C Function} scm_make_vector (k, fill) Return a newly allocated vector of @var{k} elements. If a @@ -5505,7 +5514,7 @@ unspecified. @end deffn vector->list -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:233 +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:237 @deffn {Scheme Procedure} vector->list v @deffnx {C Function} scm_vector_to_list (v) Return a newly allocated list composed of the elements of @var{v}. @@ -5517,7 +5526,7 @@ Return a newly allocated list composed of the elements of @var{v}. @end deffn vector-fill! -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:250 +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:254 @deffn {Scheme Procedure} vector-fill! v fill @deffnx {C Function} scm_vector_fill_x (v, fill) Store @var{fill} in every position of @var{vector}. The value @@ -5525,7 +5534,7 @@ returned by @code{vector-fill!} is unspecified. @end deffn vector-move-left! -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:283 +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:286 @deffn {Scheme Procedure} vector-move-left! vec1 start1 end1 vec2 start2 @deffnx {C Function} scm_vector_move_left_x (vec1, start1, end1, vec2, start2) Copy elements from @var{vec1}, positions @var{start1} to @var{end1}, @@ -5539,7 +5548,7 @@ same vector, @code{vector-move-left!} is usually appropriate when @end deffn vector-move-right! -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:312 +@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:322 @deffn {Scheme Procedure} vector-move-right! vec1 start1 end1 vec2 start2 @deffnx {C Function} scm_vector_move_right_x (vec1, start1, end1, vec2, start2) Copy elements from @var{vec1}, positions @var{start1} to @var{end1}, @@ -5669,7 +5678,7 @@ the same way @code{list->vector} would. @end deffn weak-vector? -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:160 +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:163 @deffn {Scheme Procedure} weak-vector? obj @deffnx {C Function} scm_weak_vector_p (obj) Return @code{#t} if @var{obj} is a weak vector. Note that all @@ -5677,7 +5686,7 @@ weak hashes are also weak vectors. @end deffn make-weak-key-hash-table -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:178 +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:181 @deffn {Scheme Procedure} make-weak-key-hash-table size @deffnx {Scheme Procedure} make-weak-value-hash-table size @deffnx {Scheme Procedure} make-doubly-weak-hash-table size @@ -5691,7 +5700,7 @@ would modify regular hash tables. (@pxref{Hash Tables}) @end deffn make-weak-value-hash-table -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:189 +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:192 @deffn {Scheme Procedure} make-weak-value-hash-table size @deffnx {C Function} scm_make_weak_value_hash_table (size) Return a hash table with weak values with @var{size} buckets. @@ -5699,7 +5708,7 @@ Return a hash table with weak values with @var{size} buckets. @end deffn make-doubly-weak-hash-table -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:200 +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:203 @deffn {Scheme Procedure} make-doubly-weak-hash-table size @deffnx {C Function} scm_make_doubly_weak_hash_table (size) Return a hash table with weak keys and values with @var{size} @@ -5707,7 +5716,7 @@ buckets. (@pxref{Hash Tables}) @end deffn weak-key-hash-table? -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:214 +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:217 @deffn {Scheme Procedure} weak-key-hash-table? obj @deffnx {Scheme Procedure} weak-value-hash-table? obj @deffnx {Scheme Procedure} doubly-weak-hash-table? obj @@ -5718,19 +5727,113 @@ nor a weak value hash table. @end deffn weak-value-hash-table? -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:224 +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:227 @deffn {Scheme Procedure} weak-value-hash-table? obj @deffnx {C Function} scm_weak_value_hash_table_p (obj) Return @code{#t} if @var{obj} is a weak value hash table. @end deffn doubly-weak-hash-table? -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:234 +@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:237 @deffn {Scheme Procedure} doubly-weak-hash-table? obj @deffnx {C Function} scm_doubly_weak_hash_table_p (obj) Return @code{#t} if @var{obj} is a doubly weak hash table. @end deffn + dynamic-link +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:171 +@deffn {Scheme Procedure} dynamic-link filename +@deffnx {C Function} scm_dynamic_link (filename) +Find the shared object (shared library) denoted by +@var{filename} and link it into the running Guile +application. The returned +scheme object is a ``handle'' for the library which can +be passed to @code{dynamic-func}, @code{dynamic-call} etc. + +Searching for object files is system dependent. Normally, +if @var{filename} does have an explicit directory it will +be searched for in locations +such as @file{/usr/lib} and @file{/usr/local/lib}. +@end deffn + + dynamic-object? +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:186 +@deffn {Scheme Procedure} dynamic-object? obj +@deffnx {C Function} scm_dynamic_object_p (obj) +Return @code{#t} if @var{obj} is a dynamic object handle, +or @code{#f} otherwise. +@end deffn + + dynamic-unlink +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:200 +@deffn {Scheme Procedure} dynamic-unlink dobj +@deffnx {C Function} scm_dynamic_unlink (dobj) +Unlink a dynamic object from the application, if possible. The +object must have been linked by @code{dynamic-link}, with +@var{dobj} the corresponding handle. After this procedure +is called, the handle can no longer be used to access the +object. +@end deffn + + dynamic-func +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:225 +@deffn {Scheme Procedure} dynamic-func name dobj +@deffnx {C Function} scm_dynamic_func (name, dobj) +Return a ``handle'' for the function @var{name} in the +shared object referred to by @var{dobj}. The handle +can be passed to @code{dynamic-call} to actually +call the function. + +Regardless whether your C compiler prepends an underscore +@samp{_} to the global names in a program, you should +@strong{not} include this underscore in @var{name} +since it will be added automatically when necessary. +@end deffn + + dynamic-call +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:267 +@deffn {Scheme Procedure} dynamic-call func dobj +@deffnx {C Function} scm_dynamic_call (func, dobj) +Call a C function in a dynamic object. Two styles of +invocation are supported: + +@itemize @bullet +@item @var{func} can be a function handle returned by +@code{dynamic-func}. In this case @var{dobj} is +ignored +@item @var{func} can be a string with the name of the +function to call, with @var{dobj} the handle of the +dynamic object in which to find the function. +This is equivalent to +@smallexample + +(dynamic-call (dynamic-func @var{func} @var{dobj}) #f) +@end smallexample +@end itemize + +In either case, the function is passed no arguments +and its return value is ignored. +@end deffn + + dynamic-args-call +@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:322 +@deffn {Scheme Procedure} dynamic-args-call func dobj args +@deffnx {C Function} scm_dynamic_args_call (func, dobj, args) +Call the C function indicated by @var{func} and @var{dobj}, +just like @code{dynamic-call}, but pass it some arguments and +return its return value. The C function is expected to take +two arguments and return an @code{int}, just like @code{main}: +@smallexample +int c_func (int argc, char **argv); +@end smallexample + +The parameter @var{args} must be a list of strings and is +converted into an array of @code{char *}. The array is passed +in @var{argv} and its size in @var{argc}. The return value is +converted to a Scheme number and returned from the call to +@code{dynamic-args-call}. +@end deffn + array-fill! @c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:462 @deffn {Scheme Procedure} array-fill! ra fill @@ -5757,13 +5860,13 @@ dimension. The order is unspecified. @end deffn array-map-in-order! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1510 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1512 @deffn {Scheme Procedure} array-map-in-order! implemented by the C function "scm_array_map_x" @end deffn array-map! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1521 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1523 @deffn {Scheme Procedure} array-map! ra0 proc . lra @deffnx {Scheme Procedure} array-map-in-order! ra0 proc . lra @deffnx {C Function} scm_array_map_x (ra0, proc, lra) @@ -5776,7 +5879,7 @@ unspecified. The order of application is unspecified. @end deffn array-for-each -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1668 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1671 @deffn {Scheme Procedure} array-for-each proc ra0 . lra @deffnx {C Function} scm_array_for_each (proc, ra0, lra) Apply @var{proc} to each tuple of elements of @var{array0} @dots{} @@ -5784,7 +5887,7 @@ in row-major order. The value returned is unspecified. @end deffn array-index-map! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1696 +@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1699 @deffn {Scheme Procedure} array-index-map! ra proc @deffnx {C Function} scm_array_index_map_x (ra, proc) Apply @var{proc} to the indices of each element of @var{array} in @@ -5921,7 +6024,7 @@ have smaller rank than @var{array}. @end deffn enclose-array -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:911 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:912 @deffn {Scheme Procedure} enclose-array ra . axes @deffnx {C Function} scm_enclose_array (ra, axes) @var{dim0}, @var{dim1} @dots{} should be nonnegative integers less than @@ -5948,7 +6051,7 @@ examples: @end deffn array-in-bounds? -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:995 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:996 @deffn {Scheme Procedure} array-in-bounds? v . args @deffnx {C Function} scm_array_in_bounds_p (v, args) Return @code{#t} if its arguments would be acceptable to @@ -5956,13 +6059,13 @@ Return @code{#t} if its arguments would be acceptable to @end deffn array-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1074 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1075 @deffn {Scheme Procedure} array-ref implemented by the C function "scm_uniform_vector_ref" @end deffn uniform-vector-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1081 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1082 @deffn {Scheme Procedure} uniform-vector-ref v args @deffnx {Scheme Procedure} array-ref v . args @deffnx {C Function} scm_uniform_vector_ref (v, args) @@ -5971,13 +6074,13 @@ Return the element at the @code{(index1, index2)} element in @end deffn uniform-array-set1! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1250 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1251 @deffn {Scheme Procedure} uniform-array-set1! implemented by the C function "scm_array_set_x" @end deffn array-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1259 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1260 @deffn {Scheme Procedure} array-set! v obj . args @deffnx {Scheme Procedure} uniform-array-set1! v obj args @deffnx {C Function} scm_array_set_x (v, obj, args) @@ -5986,7 +6089,7 @@ Set the element at the @code{(index1, index2)} element in @var{array} to @end deffn array-contents -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1374 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1375 @deffn {Scheme Procedure} array-contents ra [strict] @deffnx {C Function} scm_array_contents (ra, strict) If @var{array} may be @dfn{unrolled} into a one dimensional shared array @@ -6002,7 +6105,7 @@ memory. @end deffn uniform-array-read! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1488 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1489 @deffn {Scheme Procedure} uniform-array-read! ra [port_or_fd [start [end]]] @deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] [start] [end] @deffnx {C Function} scm_uniform_array_read_x (ra, port_or_fd, start, end) @@ -6023,7 +6126,7 @@ returned by @code{(current-input-port)}. @end deffn uniform-array-write -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1653 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1654 @deffn {Scheme Procedure} uniform-array-write v [port_or_fd [start [end]]] @deffnx {Scheme Procedure} uniform-vector-write uve [port-or-fdes] [start] [end] @deffnx {C Function} scm_uniform_array_write (v, port_or_fd, start, end) @@ -6041,7 +6144,7 @@ omitted, in which case it defaults to the value returned by @end deffn bit-count -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1780 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1781 @deffn {Scheme Procedure} bit-count b bitvector @deffnx {C Function} scm_bit_count (b, bitvector) Return the number of occurrences of the boolean @var{b} in @@ -6049,7 +6152,7 @@ Return the number of occurrences of the boolean @var{b} in @end deffn bit-position -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1819 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1820 @deffn {Scheme Procedure} bit-position item v k @deffnx {C Function} scm_bit_position (item, v, k) Return the minimum index of an occurrence of @var{bool} in @@ -6058,7 +6161,7 @@ within the specified range @code{#f} is returned. @end deffn bit-set*! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1887 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1888 @deffn {Scheme Procedure} bit-set*! v kv obj @deffnx {C Function} scm_bit_set_star_x (v, kv, obj) If uve is a bit-vector @var{bv} and uve must be of the same @@ -6073,7 +6176,7 @@ of @var{bv} corresponding to the indexes in uve are set to @end deffn bit-count* -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1941 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1942 @deffn {Scheme Procedure} bit-count* v kv obj @deffnx {C Function} scm_bit_count_star (v, kv, obj) Return @@ -6084,14 +6187,14 @@ Return @end deffn bit-invert! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2005 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2006 @deffn {Scheme Procedure} bit-invert! v @deffnx {C Function} scm_bit_invert_x (v) Modify @var{bv} by replacing each element with its negation. @end deffn array->list -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2084 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2085 @deffn {Scheme Procedure} array->list v @deffnx {C Function} scm_array_to_list (v) Return a list consisting of all the elements, in order, of @@ -6099,7 +6202,7 @@ Return a list consisting of all the elements, in order, of @end deffn list->uniform-array -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2185 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2186 @deffn {Scheme Procedure} list->uniform-array ndim prot lst @deffnx {Scheme Procedure} list->uniform-vector prot lst @deffnx {C Function} scm_list_to_uniform_array (ndim, prot, lst) @@ -6110,7 +6213,7 @@ done. @end deffn array-prototype -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2536 +@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2537 @deffn {Scheme Procedure} array-prototype ra @deffnx {C Function} scm_array_prototype (ra) Return an object that would produce an array of the same type @@ -6224,7 +6327,7 @@ The return value is unspecified. @end deffn stat -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:621 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:620 @deffn {Scheme Procedure} stat object @deffnx {C Function} scm_stat (object) Return an object containing various information about the file @@ -6286,7 +6389,7 @@ An integer representing the access permission bits. @end deffn link -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:684 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:683 @deffn {Scheme Procedure} link oldpath newpath @deffnx {C Function} scm_link (oldpath, newpath) Creates a new name @var{newpath} in the file system for the @@ -6296,7 +6399,7 @@ system. @end deffn rename-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:705 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:704 @deffn {Scheme Procedure} rename-file oldname newname @deffnx {C Function} scm_rename (oldname, newname) Renames the file specified by @var{oldname} to @var{newname}. @@ -6304,14 +6407,14 @@ The return value is unspecified. @end deffn delete-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:732 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:731 @deffn {Scheme Procedure} delete-file str @deffnx {C Function} scm_delete_file (str) Deletes (or "unlinks") the file specified by @var{path}. @end deffn mkdir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:750 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:749 @deffn {Scheme Procedure} mkdir path [mode] @deffnx {C Function} scm_mkdir (path, mode) Create a new directory named by @var{path}. If @var{mode} is omitted @@ -6321,7 +6424,7 @@ umask. Otherwise they are set to the decimal value specified with @end deffn rmdir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:778 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:777 @deffn {Scheme Procedure} rmdir path @deffnx {C Function} scm_rmdir (path) Remove the existing directory named by @var{path}. The directory must @@ -6329,7 +6432,7 @@ be empty for this to succeed. The return value is unspecified. @end deffn directory-stream? -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:803 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:802 @deffn {Scheme Procedure} directory-stream? obj @deffnx {C Function} scm_directory_stream_p (obj) Return a boolean indicating whether @var{object} is a directory @@ -6337,7 +6440,7 @@ stream as returned by @code{opendir}. @end deffn opendir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:814 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:813 @deffn {Scheme Procedure} opendir dirname @deffnx {C Function} scm_opendir (dirname) Open the directory specified by @var{path} and return a directory @@ -6345,7 +6448,7 @@ stream. @end deffn readdir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:831 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:830 @deffn {Scheme Procedure} readdir port @deffnx {C Function} scm_readdir (port) Return (as a string) the next directory entry from the directory stream @@ -6354,7 +6457,7 @@ end of file object is returned. @end deffn rewinddir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:854 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:853 @deffn {Scheme Procedure} rewinddir port @deffnx {C Function} scm_rewinddir (port) Reset the directory port @var{stream} so that the next call to @@ -6362,7 +6465,7 @@ Reset the directory port @var{stream} so that the next call to @end deffn closedir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:871 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:870 @deffn {Scheme Procedure} closedir port @deffnx {C Function} scm_closedir (port) Close the directory stream @var{stream}. @@ -6370,7 +6473,7 @@ The return value is unspecified. @end deffn chdir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:921 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:920 @deffn {Scheme Procedure} chdir str @deffnx {C Function} scm_chdir (str) Change the current working directory to @var{path}. @@ -6378,14 +6481,14 @@ The return value is unspecified. @end deffn getcwd -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:937 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:936 @deffn {Scheme Procedure} getcwd @deffnx {C Function} scm_getcwd () Return the name of the current working directory. @end deffn select -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1133 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1132 @deffn {Scheme Procedure} select reads writes excepts [secs [usecs]] @deffnx {C Function} scm_select (reads, writes, excepts, secs, usecs) This procedure has a variety of uses: waiting for the ability @@ -6420,7 +6523,7 @@ An additional @code{select!} interface is provided. @end deffn fcntl -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1279 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1278 @deffn {Scheme Procedure} fcntl object cmd [value] @deffnx {C Function} scm_fcntl (object, cmd, value) Apply @var{command} to the specified file descriptor or the underlying @@ -6451,7 +6554,7 @@ The value used to indicate the "close on exec" flag with @code{F_GETFL} or @end deffn fsync -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1316 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1315 @deffn {Scheme Procedure} fsync object @deffnx {C Function} scm_fsync (object) Copies any unwritten data for the specified output file descriptor to disk. @@ -6461,7 +6564,7 @@ The return value is unspecified. @end deffn symlink -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1343 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1342 @deffn {Scheme Procedure} symlink oldpath newpath @deffnx {C Function} scm_symlink (oldpath, newpath) Create a symbolic link named @var{path-to} with the value (i.e., pointing to) @@ -6469,7 +6572,7 @@ Create a symbolic link named @var{path-to} with the value (i.e., pointing to) @end deffn readlink -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1362 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1361 @deffn {Scheme Procedure} readlink path @deffnx {C Function} scm_readlink (path) Return the value of the symbolic link named by @var{path} (a @@ -6477,7 +6580,7 @@ string), i.e., the file that the link points to. @end deffn lstat -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1391 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1390 @deffn {Scheme Procedure} lstat str @deffnx {C Function} scm_lstat (str) Similar to @code{stat}, but does not follow symbolic links, i.e., @@ -6486,7 +6589,7 @@ file it points to. @var{path} must be a string. @end deffn copy-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1415 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1414 @deffn {Scheme Procedure} copy-file oldfile newfile @deffnx {C Function} scm_copy_file (oldfile, newfile) Copy the file specified by @var{path-from} to @var{path-to}. @@ -6494,7 +6597,7 @@ The return value is unspecified. @end deffn dirname -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1460 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1459 @deffn {Scheme Procedure} dirname filename @deffnx {C Function} scm_dirname (filename) Return the directory name component of the file name @@ -6503,7 +6606,7 @@ component, @code{.} is returned. @end deffn basename -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1503 +@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1502 @deffn {Scheme Procedure} basename filename [suffix] @deffnx {C Function} scm_basename (filename, suffix) Return the base name of the file name @var{filename}. The @@ -6513,7 +6616,7 @@ If @var{suffix} is provided, and is equal to the end of @end deffn pipe -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:202 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:201 @deffn {Scheme Procedure} pipe @deffnx {C Function} scm_pipe () Return a newly created pipe: a pair of ports which are linked @@ -6532,7 +6635,7 @@ from the input port. @end deffn getgroups -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:223 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:222 @deffn {Scheme Procedure} getgroups @deffnx {C Function} scm_getgroups () Return a vector of integers representing the current @@ -6540,7 +6643,7 @@ supplementary group IDs. @end deffn getpw -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:254 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:257 @deffn {Scheme Procedure} getpw [user] @deffnx {C Function} scm_getpwuid (user) Look up an entry in the user database. @var{obj} can be an integer, @@ -6567,7 +6670,7 @@ or getgrent respectively. @end deffn setgr -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:366 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:364 @deffn {Scheme Procedure} setgr [arg] @deffnx {C Function} scm_setgrent (arg) If called with a true argument, initialize or reset the group data @@ -6576,7 +6679,7 @@ stream. Otherwise, close the stream. The @code{setgrent} and @end deffn kill -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:402 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:400 @deffn {Scheme Procedure} kill pid sig @deffnx {C Function} scm_kill (pid, sig) Sends a signal to the specified process or group of processes. @@ -6609,7 +6712,7 @@ Interrupt signal. @end deffn waitpid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:455 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:453 @deffn {Scheme Procedure} waitpid pid [options] @deffnx {C Function} scm_waitpid (pid, options) This procedure collects status information from a child process which @@ -6656,7 +6759,7 @@ The integer status value. @end deffn status:exit-val -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:483 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:481 @deffn {Scheme Procedure} status:exit-val status @deffnx {C Function} scm_status_exit_val (status) Return the exit status value, as would be set if a process @@ -6665,7 +6768,7 @@ if any, otherwise @code{#f}. @end deffn status:term-sig -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:503 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:501 @deffn {Scheme Procedure} status:term-sig status @deffnx {C Function} scm_status_term_sig (status) Return the signal number which terminated the process, if any, @@ -6673,7 +6776,7 @@ otherwise @code{#f}. @end deffn status:stop-sig -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:521 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:519 @deffn {Scheme Procedure} status:stop-sig status @deffnx {C Function} scm_status_stop_sig (status) Return the signal number which stopped the process, if any, @@ -6681,7 +6784,7 @@ otherwise @code{#f}. @end deffn getppid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:541 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:539 @deffn {Scheme Procedure} getppid @deffnx {C Function} scm_getppid () Return an integer representing the process ID of the parent @@ -6689,21 +6792,21 @@ process. @end deffn getuid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:553 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:551 @deffn {Scheme Procedure} getuid @deffnx {C Function} scm_getuid () Return an integer representing the current real user ID. @end deffn getgid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:564 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:562 @deffn {Scheme Procedure} getgid @deffnx {C Function} scm_getgid () Return an integer representing the current real group ID. @end deffn geteuid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:578 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:576 @deffn {Scheme Procedure} geteuid @deffnx {C Function} scm_geteuid () Return an integer representing the current effective user ID. @@ -6713,7 +6816,7 @@ system supports effective IDs. @end deffn getegid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:595 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:593 @deffn {Scheme Procedure} getegid @deffnx {C Function} scm_getegid () Return an integer representing the current effective group ID. @@ -6723,7 +6826,7 @@ system supports effective IDs. @end deffn setuid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:611 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:609 @deffn {Scheme Procedure} setuid id @deffnx {C Function} scm_setuid (id) Sets both the real and effective user IDs to the integer @var{id}, provided @@ -6732,7 +6835,7 @@ The return value is unspecified. @end deffn setgid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:625 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:623 @deffn {Scheme Procedure} setgid id @deffnx {C Function} scm_setgid (id) Sets both the real and effective group IDs to the integer @var{id}, provided @@ -6741,7 +6844,7 @@ The return value is unspecified. @end deffn seteuid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:641 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:639 @deffn {Scheme Procedure} seteuid id @deffnx {C Function} scm_seteuid (id) Sets the effective user ID to the integer @var{id}, provided the process @@ -6752,7 +6855,7 @@ The return value is unspecified. @end deffn setegid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:667 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:665 @deffn {Scheme Procedure} setegid id @deffnx {C Function} scm_setegid (id) Sets the effective group ID to the integer @var{id}, provided the process @@ -6763,7 +6866,7 @@ The return value is unspecified. @end deffn getpgrp -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:691 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:689 @deffn {Scheme Procedure} getpgrp @deffnx {C Function} scm_getpgrp () Return an integer representing the current process group ID. @@ -6771,7 +6874,7 @@ This is the POSIX definition, not BSD. @end deffn setpgid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:709 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:707 @deffn {Scheme Procedure} setpgid pid pgid @deffnx {C Function} scm_setpgid (pid, pgid) Move the process @var{pid} into the process group @var{pgid}. @var{pid} or @@ -6782,7 +6885,7 @@ The return value is unspecified. @end deffn setsid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:728 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:726 @deffn {Scheme Procedure} setsid @deffnx {C Function} scm_setsid () Creates a new session. The current process becomes the session leader @@ -6792,7 +6895,7 @@ The return value is an integer representing the new process group ID. @end deffn ttyname -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:743 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:741 @deffn {Scheme Procedure} ttyname port @deffnx {C Function} scm_ttyname (port) Return a string with the name of the serial terminal device @@ -6800,7 +6903,7 @@ underlying @var{port}. @end deffn ctermid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:767 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:765 @deffn {Scheme Procedure} ctermid @deffnx {C Function} scm_ctermid () Return a string containing the file name of the controlling @@ -6808,7 +6911,7 @@ terminal for the current process. @end deffn tcgetpgrp -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:790 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:788 @deffn {Scheme Procedure} tcgetpgrp port @deffnx {C Function} scm_tcgetpgrp (port) Return the process group ID of the foreground process group @@ -6824,7 +6927,7 @@ foreground. @end deffn tcsetpgrp -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:814 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:812 @deffn {Scheme Procedure} tcsetpgrp port pgid @deffnx {C Function} scm_tcsetpgrp (port, pgid) Set the foreground process group ID for the terminal used by the file @@ -6835,7 +6938,7 @@ controlling terminal. The return value is unspecified. @end deffn execl -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:869 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:867 @deffn {Scheme Procedure} execl filename . args @deffnx {C Function} scm_execl (filename, args) Executes the file named by @var{path} as a new process image. @@ -6852,7 +6955,7 @@ call, but we call it @code{execl} because of its Scheme calling interface. @end deffn execlp -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:889 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:887 @deffn {Scheme Procedure} execlp filename . args @deffnx {C Function} scm_execlp (filename, args) Similar to @code{execl}, however if @@ -6865,7 +6968,7 @@ call, but we call it @code{execlp} because of its Scheme calling interface. @end deffn execle -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:939 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:937 @deffn {Scheme Procedure} execle filename env . args @deffnx {C Function} scm_execle (filename, env, args) Similar to @code{execl}, but the environment of the new process is @@ -6877,7 +6980,7 @@ call, but we call it @code{execle} because of its Scheme calling interface. @end deffn primitive-fork -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:963 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:961 @deffn {Scheme Procedure} primitive-fork @deffnx {C Function} scm_fork () Creates a new "child" process by duplicating the current "parent" process. @@ -6889,7 +6992,7 @@ with the scsh fork. @end deffn uname -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:983 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:981 @deffn {Scheme Procedure} uname @deffnx {C Function} scm_uname () Return an object with some information about the computer @@ -6897,7 +7000,7 @@ system the program is running on. @end deffn environ -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1013 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1010 @deffn {Scheme Procedure} environ [env] @deffnx {C Function} scm_environ (env) If @var{env} is omitted, return the current environment (in the @@ -6910,7 +7013,7 @@ then the return value is unspecified. @end deffn tmpnam -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1051 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1048 @deffn {Scheme Procedure} tmpnam @deffnx {C Function} scm_tmpnam () Return a name in the file system that does not match any @@ -6921,7 +7024,7 @@ Care should be taken if opening the file, e.g., use the @end deffn mkstemp! -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1077 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1074 @deffn {Scheme Procedure} mkstemp! tmpl @deffnx {C Function} scm_mkstemp (tmpl) Create a new unique file in the file system and returns a new @@ -6932,7 +7035,7 @@ place to return the name of the temporary file. @end deffn utime -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1102 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1099 @deffn {Scheme Procedure} utime pathname [actime [modtime]] @deffnx {C Function} scm_utime (pathname, actime, modtime) @code{utime} sets the access and modification times for the @@ -6948,7 +7051,7 @@ modification time to the current time. @end deffn access? -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1150 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1147 @deffn {Scheme Procedure} access? path how @deffnx {C Function} scm_access (path, how) Return @code{#t} if @var{path} corresponds to an existing file @@ -6977,14 +7080,14 @@ test for existence of the file. @end deffn getpid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1164 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1161 @deffn {Scheme Procedure} getpid @deffnx {C Function} scm_getpid () Return an integer representing the current process ID. @end deffn putenv -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1181 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1178 @deffn {Scheme Procedure} putenv str @deffnx {C Function} scm_putenv (str) Modifies the environment of the current process, which is @@ -7001,7 +7104,7 @@ The return value is unspecified. @end deffn setlocale -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1223 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1220 @deffn {Scheme Procedure} setlocale category [locale] @deffnx {C Function} scm_setlocale (category, locale) If @var{locale} is omitted, return the current value of the @@ -7016,7 +7119,7 @@ the locale will be set using environment variables. @end deffn mknod -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1263 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1260 @deffn {Scheme Procedure} mknod path type perms dev @deffnx {C Function} scm_mknod (path, type, perms, dev) Creates a new special file, such as a file corresponding to a device. @@ -7037,7 +7140,7 @@ The return value is unspecified. @end deffn nice -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1309 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1306 @deffn {Scheme Procedure} nice incr @deffnx {C Function} scm_nice (incr) Increment the priority of the current process by @var{incr}. A higher @@ -7046,7 +7149,7 @@ The return value is unspecified. @end deffn sync -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1324 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1321 @deffn {Scheme Procedure} sync @deffnx {C Function} scm_sync () Flush the operating system disk buffers. @@ -7054,7 +7157,7 @@ The return value is unspecified. @end deffn crypt -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1337 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1334 @deffn {Scheme Procedure} crypt key salt @deffnx {C Function} scm_crypt (key, salt) Encrypt @var{key} using @var{salt} as the salt value to the @@ -7062,7 +7165,7 @@ crypt(3) library call. @end deffn chroot -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1358 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1355 @deffn {Scheme Procedure} chroot path @deffnx {C Function} scm_chroot (path) Change the root directory to that specified in @var{path}. @@ -7073,7 +7176,7 @@ root directory. @end deffn getlogin -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1390 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1387 @deffn {Scheme Procedure} getlogin @deffnx {C Function} scm_getlogin () Return a string containing the name of the user logged in on @@ -7082,7 +7185,7 @@ information cannot be obtained. @end deffn cuserid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1408 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1405 @deffn {Scheme Procedure} cuserid @deffnx {C Function} scm_cuserid () Return a string containing a user name associated with the @@ -7091,7 +7194,7 @@ information cannot be obtained. @end deffn getpriority -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1433 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1430 @deffn {Scheme Procedure} getpriority which who @deffnx {C Function} scm_getpriority (which, who) Return the scheduling priority of the process, process group @@ -7107,7 +7210,7 @@ specified processes. @end deffn setpriority -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1467 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1464 @deffn {Scheme Procedure} setpriority which who prio @deffnx {C Function} scm_setpriority (which, who, prio) Set the scheduling priority of the process, process group @@ -7126,7 +7229,7 @@ The return value is not specified. @end deffn getpass -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1492 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1489 @deffn {Scheme Procedure} getpass prompt @deffnx {C Function} scm_getpass (prompt) Display @var{prompt} to the standard error output and read @@ -7139,7 +7242,7 @@ characters is disabled. @end deffn flock -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1596 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1593 @deffn {Scheme Procedure} flock file operation @deffnx {C Function} scm_flock (file, operation) Apply or remove an advisory lock on an open file. @@ -7162,7 +7265,7 @@ file descriptor or an open file descriptor port. @end deffn sethostname -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1622 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1619 @deffn {Scheme Procedure} sethostname name @deffnx {C Function} scm_sethostname (name) Set the host name of the current processor to @var{name}. May @@ -7171,14 +7274,14 @@ specified. @end deffn gethostname -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1637 +@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1634 @deffn {Scheme Procedure} gethostname @deffnx {C Function} scm_gethostname () Return the host name of the current processor. @end deffn gethost -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:154 +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:153 @deffn {Scheme Procedure} gethost [host] @deffnx {Scheme Procedure} gethostbyname hostname @deffnx {Scheme Procedure} gethostbyaddr address @@ -7195,7 +7298,7 @@ Unusual conditions may result in errors thrown to the @end deffn getnet -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:233 +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:231 @deffn {Scheme Procedure} getnet [net] @deffnx {Scheme Procedure} getnetbyname net-name @deffnx {Scheme Procedure} getnetbyaddr net-number @@ -7208,7 +7311,7 @@ given. @end deffn getproto -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:282 +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:277 @deffn {Scheme Procedure} getproto [protocol] @deffnx {Scheme Procedure} getprotobyname name @deffnx {Scheme Procedure} getprotobynumber number @@ -7220,7 +7323,7 @@ argument. @code{getproto} will accept either type, behaving like @end deffn getserv -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:348 +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:337 @deffn {Scheme Procedure} getserv [name [protocol]] @deffnx {Scheme Procedure} getservbyname name protocol @deffnx {Scheme Procedure} getservbyport port protocol @@ -7236,7 +7339,7 @@ as its first argument; if given no arguments, it behaves like @end deffn sethost -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:385 +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:374 @deffn {Scheme Procedure} sethost [stayopen] @deffnx {C Function} scm_sethost (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endhostent}. @@ -7244,7 +7347,7 @@ Otherwise it is equivalent to @code{sethostent stayopen}. @end deffn setnet -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:401 +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:390 @deffn {Scheme Procedure} setnet [stayopen] @deffnx {C Function} scm_setnet (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endnetent}. @@ -7252,7 +7355,7 @@ Otherwise it is equivalent to @code{setnetent stayopen}. @end deffn setproto -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:417 +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:406 @deffn {Scheme Procedure} setproto [stayopen] @deffnx {C Function} scm_setproto (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endprotoent}. @@ -7260,7 +7363,7 @@ Otherwise it is equivalent to @code{setprotoent stayopen}. @end deffn setserv -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:433 +@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:422 @deffn {Scheme Procedure} setserv [stayopen] @deffnx {C Function} scm_setserv (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endservent}. @@ -7268,7 +7371,7 @@ Otherwise it is equivalent to @code{setservent stayopen}. @end deffn htons -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:109 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:108 @deffn {Scheme Procedure} htons value @deffnx {C Function} scm_htons (value) Convert a 16 bit quantity from host to network byte ordering. @@ -7277,7 +7380,7 @@ and returned as a new integer. @end deffn ntohs -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:126 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:125 @deffn {Scheme Procedure} ntohs value @deffnx {C Function} scm_ntohs (value) Convert a 16 bit quantity from network to host byte ordering. @@ -7286,7 +7389,7 @@ and returned as a new integer. @end deffn htonl -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:143 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:142 @deffn {Scheme Procedure} htonl value @deffnx {C Function} scm_htonl (value) Convert a 32 bit quantity from host to network byte ordering. @@ -7295,7 +7398,7 @@ and returned as a new integer. @end deffn ntohl -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:156 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:155 @deffn {Scheme Procedure} ntohl value @deffnx {C Function} scm_ntohl (value) Convert a 32 bit quantity from network to host byte ordering. @@ -7304,7 +7407,7 @@ and returned as a new integer. @end deffn inet-aton -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:176 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:175 @deffn {Scheme Procedure} inet-aton address @deffnx {C Function} scm_inet_aton (address) Convert an IPv4 Internet address from printable string @@ -7316,7 +7419,7 @@ Convert an IPv4 Internet address from printable string @end deffn inet-ntoa -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:195 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:194 @deffn {Scheme Procedure} inet-ntoa inetid @deffnx {C Function} scm_inet_ntoa (inetid) Convert an IPv4 Internet address to a printable @@ -7328,7 +7431,7 @@ Convert an IPv4 Internet address to a printable @end deffn inet-netof -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:215 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:214 @deffn {Scheme Procedure} inet-netof address @deffnx {C Function} scm_inet_netof (address) Return the network number part of the given IPv4 @@ -7340,7 +7443,7 @@ Internet address. E.g., @end deffn inet-lnaof -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:233 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:232 @deffn {Scheme Procedure} inet-lnaof address @deffnx {C Function} scm_lnaof (address) Return the local-address-with-network part of the given @@ -7353,7 +7456,7 @@ E.g., @end deffn inet-makeaddr -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:251 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:250 @deffn {Scheme Procedure} inet-makeaddr net lna @deffnx {C Function} scm_inet_makeaddr (net, lna) Make an IPv4 Internet address by combining the network number @@ -7366,7 +7469,7 @@ Make an IPv4 Internet address by combining the network number @end deffn inet-pton -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:369 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:368 @deffn {Scheme Procedure} inet-pton family address @deffnx {C Function} scm_inet_pton (family, address) Convert a string containing a printable network address to @@ -7382,7 +7485,7 @@ the result is an integer with normal host byte ordering. @end deffn inet-ntop -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:404 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:403 @deffn {Scheme Procedure} inet-ntop family address @deffnx {C Function} scm_inet_ntop (family, address) Convert a network address into a printable string. @@ -7398,7 +7501,7 @@ ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff @end deffn socket -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:449 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:448 @deffn {Scheme Procedure} socket family style proto @deffnx {C Function} scm_socket (family, style, proto) Return a new socket port of the type specified by @var{family}, @@ -7417,7 +7520,7 @@ has been connected to another socket. @end deffn socketpair -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:471 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:470 @deffn {Scheme Procedure} socketpair family style proto @deffnx {C Function} scm_socketpair (family, style, proto) Return a pair of connected (but unnamed) socket ports of the @@ -7428,7 +7531,7 @@ family. Zero is likely to be the only meaningful value for @end deffn getsockopt -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:500 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:499 @deffn {Scheme Procedure} getsockopt sock level optname @deffnx {C Function} scm_getsockopt (sock, level, optname) Return the value of a particular socket option for the socket @@ -7443,7 +7546,7 @@ returns a pair of integers. @end deffn setsockopt -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:568 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:567 @deffn {Scheme Procedure} setsockopt sock level optname value @deffnx {C Function} scm_setsockopt (sock, level, optname, value) Set the value of a particular socket option for the socket @@ -7460,7 +7563,7 @@ The return value is unspecified. @end deffn shutdown -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:672 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:671 @deffn {Scheme Procedure} shutdown sock how @deffnx {C Function} scm_shutdown (sock, how) Sockets can be closed simply by using @code{close-port}. The @@ -7483,7 +7586,7 @@ The return value is unspecified. @end deffn connect -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:816 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:815 @deffn {Scheme Procedure} connect sock fam address . args @deffnx {C Function} scm_connect (sock, fam, address, args) Initiate a connection from a socket using a specified address @@ -7510,7 +7613,7 @@ The return value is unspecified. @end deffn bind -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:876 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:875 @deffn {Scheme Procedure} bind sock fam address . args @deffnx {C Function} scm_bind (sock, fam, address, args) Assign an address to the socket port @var{sock}. @@ -7559,7 +7662,7 @@ The return value is unspecified. @end deffn listen -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:910 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:909 @deffn {Scheme Procedure} listen sock backlog @deffnx {C Function} scm_listen (sock, backlog) Enable @var{sock} to accept connection @@ -7573,7 +7676,7 @@ The return value is unspecified. @end deffn accept -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1015 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1013 @deffn {Scheme Procedure} accept sock @deffnx {C Function} scm_accept (sock) Accept a connection on a bound, listening socket. @@ -7593,7 +7696,7 @@ connection and will continue to accept new requests. @end deffn getsockname -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1042 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1040 @deffn {Scheme Procedure} getsockname sock @deffnx {C Function} scm_getsockname (sock) Return the address of @var{sock}, in the same form as the @@ -7602,7 +7705,7 @@ of a socket in the @code{AF_FILE} namespace cannot be read. @end deffn getpeername -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1064 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1062 @deffn {Scheme Procedure} getpeername sock @deffnx {C Function} scm_getpeername (sock) Return the address that @var{sock} @@ -7612,7 +7715,7 @@ is connected to, in the same form as the object returned by @end deffn recv! -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1099 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1097 @deffn {Scheme Procedure} recv! sock buf [flags] @deffnx {C Function} scm_recv (sock, buf, flags) Receive data from a socket port. @@ -7638,7 +7741,7 @@ any unread buffered port data is ignored. @end deffn send -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1132 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1130 @deffn {Scheme Procedure} send sock message [flags] @deffnx {C Function} scm_send (sock, message, flags) Transmit the string @var{message} on a socket port @var{sock}. @@ -7657,7 +7760,7 @@ any unflushed buffered port data is ignored. @end deffn recvfrom! -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1172 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1170 @deffn {Scheme Procedure} recvfrom! sock str [flags [start [end]]] @deffnx {C Function} scm_recvfrom (sock, str, flags, start, end) Return data from the socket port @var{sock} and also @@ -7686,7 +7789,7 @@ descriptor: any unread buffered port data is ignored. @end deffn sendto -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1230 +@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1228 @deffn {Scheme Procedure} sendto sock message fam address . args_and_flags @deffnx {C Function} scm_sendto (sock, message, fam, address, args_and_flags) Transmit the string @var{message} on the socket port diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index df313238c..dc766d347 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-08-10 Gary Houston + + * new section Primitive Procedures, documentation for + scm_c_make_gsubr and scm_c_define_gsubr. + 2002-08-08 Neil Jerram * gh.texi (Data types and constants defined by gh): Avoid diff --git a/doc/ref/new-docstrings.texi b/doc/ref/new-docstrings.texi index 17aa45680..0bfbbcb85 100644 --- a/doc/ref/new-docstrings.texi +++ b/doc/ref/new-docstrings.texi @@ -699,3 +699,9 @@ Return NaN. @deffnx {C Function} scm_inf () Return Inf. @end deffn + +@deffn {Scheme Procedure} set-debug-cell-accesses! flag +@deffnx {C Function} scm_set_debug_cell_accesses_x (flag) +This function is used to turn on checking for a debug version of GUILE. This version does not support this functionality + +@end deffn diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index fc4a84afd..d64284925 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -1212,7 +1212,7 @@ Return a copy of the random state @var{state}. @deffn {Scheme Procedure} random n [state] @deffnx {C Function} scm_random (n, state) -Return a number in [0,N). +Return a number in [0, N). Accepts a positive integer or real n and returns a number of the same type between zero (inclusive) and diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi index 5f19bcb38..3cfcc6e98 100644 --- a/doc/ref/scheme-memory.texi +++ b/doc/ref/scheme-memory.texi @@ -39,6 +39,7 @@ explicitly. It is called automatically when appropriate. @deffnx {C Function} scm_gc_stats () Return an association list of statistics about Guile's current use of storage. + @end deffn diff --git a/doc/ref/scheme-procedures.texi b/doc/ref/scheme-procedures.texi index 8c08b387c..bc9c0baed 100644 --- a/doc/ref/scheme-procedures.texi +++ b/doc/ref/scheme-procedures.texi @@ -4,6 +4,7 @@ @menu * Lambda:: Basic procedure creation using lambda. +* Primitive Procedures:: Procedures defined in C. * Optional Arguments:: Handling keyword, optional and rest arguments. * Procedure Properties:: Procedure properties and meta-information. * Procedures with Setters:: Procedures with setters. @@ -80,6 +81,42 @@ empty list is stored into the location of the last formal argument. order when the procedure is invoked. @end deffn +@node Primitive Procedures +@section Primitive Procedures +@cindex primitives +@cindex primitive procedures + +Procedures written in C can be registered for use from Scheme, +provided they take only arguments of type @code{SCM} and return +@code{SCM} values. @code{scm_c_define_gsubr} is likely to be the most +useful mechanism, combining the process of registration +(@code{scm_c_make_gsubr}) and definition (@code{scm_define}). + +@deftypefun SCM scm_c_make_gsubr (const char *name, int req, int opt, int rst, fcn) +Register a C procedure @var{FCN} as a ``subr'' --- a primitive +subroutine that can be called from Scheme. It will be associated with +the given @var{name} but no environment binding will be created. The +arguments @var{req}, @var{opt} and @var{rst} specify the number of +required, optional and ``rest'' arguments respectively. The total +number of these arguments should match the actual number of arguments +to @var{fcn}. The number of rest arguments should be 0 or 1. +@code{scm_c_make_gsubr} returns a value of type @code{SCM} which is a +``handle'' for the procedure. +@end deftypefun + +@deftypefun SCM scm_c_define_gsubr (const char *name, int req, int opt, int rst, fcn) +Register a C procedure @var{FCN}, as for @code{scm_c_make_gsubr} +above, and additionally create a top-level Scheme binding for the +procedure in the ``current environment'' using @code{scm_define}. +@code{scm_c_define_gsubr} returns a handle for the procedure in the +same way as @code{scm_c_make_gsubr}, which is usually not further +required. +@end deftypefun + +@code{scm_c_make_gsubr} and @code{scm_c_define_gsubr} automatically +use @code{scm_c_make_subr} and also @code{scm_makcclo} if necessary. +It is advisable to use the gsubr variants since they provide a +slightly higher-level abstraction of the Guile implementation. @node Optional Arguments @section Optional Arguments From 08b98c54cbfc5643674b46dd62cc42a90a004199 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sat, 10 Aug 2002 14:23:49 +0000 Subject: [PATCH 107/306] * scheme-modules.texi (Compiled Code Modules): replace gh_new_procedure with scm_c_define_gsubr. --- doc/ref/ChangeLog | 6 ++++-- doc/ref/scheme-modules.texi | 16 +++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index dc766d347..2c32b518b 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,7 +1,9 @@ 2002-08-10 Gary Houston - * new section Primitive Procedures, documentation for - scm_c_make_gsubr and scm_c_define_gsubr. + * scheme-procedures.texi: new section Primitive Procedures, + documentation for scm_c_make_gsubr and scm_c_define_gsubr. + * scheme-modules.texi (Compiled Code Modules): replace + gh_new_procedure with scm_c_define_gsubr. 2002-08-08 Neil Jerram diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index 46c02172d..4470de162 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -679,19 +679,17 @@ the Guile contrib archive to make @file{libffi} accessible from Guile. @node Compiled Code Modules @subsection Putting Compiled Code into Modules -@c FIXME::martin: Change all gh_ references to their scm_ equivalents. - -The new primitives that you add to Guile with @code{gh_new_procedure} -or with any of the other mechanisms are normally placed into the same -module as all the other builtin procedures (like @code{display}). -However, it is also possible to put new primitives into their own -module. +The new primitives that you add to Guile with +@code{scm_c_define_gsubr} (@pxref{Primitive Procedures}) or with any +of the other mechanisms are placed into the @code{(guile-user)} module +by default. However, it is also possible to put new primitives into +other modules. The mechanism for doing so is not very well thought out and is likely to change when the module system of Guile itself is revised, but it is simple and useful enough to document it as it stands. -What @code{gh_new_procedure} and the functions used by the snarfer +What @code{scm_c_define_gsubr} and the functions used by the snarfer really do is to add the new primitives to whatever module is the @emph{current module} when they are called. This is analogous to the way Scheme code is put into modules: the @code{define-module} expression @@ -701,7 +699,7 @@ current module while the rest of the file is evaluated. The this current module. Therefore, all we need to do is to make sure that the right module is -current when calling @code{gh_new_procedure} for our new primitives. +current when calling @code{scm_c_define_gsubr} for our new primitives. @node Dynamic Linking and Compiled Code Modules @subsection Dynamic Linking and Compiled Code Modules From 76ea0ed53dd691992490e48b56f3a8dcdff5d1fb Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 12 Aug 2002 23:10:38 +0000 Subject: [PATCH 108/306] (More Modules Procedures): Removed. (Accessing Modules from C): New. --- doc/ref/scheme-modules.texi | 118 ++++++++++++++++++++++++++++++------ 1 file changed, 98 insertions(+), 20 deletions(-) diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index 4470de162..bc9aaa0b8 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -131,15 +131,14 @@ change in the future, the Scheme programming interface described in this manual should be considered stable. The C programming interface is considered relatively stable, although at the time of this writing, there is still some flux. -@c fixme: Review: Need better C code interface commentary. @menu * General Information about Modules:: Guile module basics. * Using Guile Modules:: How to use existing modules. * Creating Guile Modules:: How to package your code into modules. -* More Module Procedures:: Low-level module code. * Module System Quirks:: Strange things to be aware of. * Included Guile Modules:: Which modules come with Guile? +* Accessing Modules from C:: How to work with modules with C code. @end menu @node General Information about Modules @@ -376,24 +375,6 @@ Equivalent to @code{(begin (define foo ...) (export foo))}. @c end -@node More Module Procedures -@subsection More Module Procedures - -@c FIXME::martin: Review me! - -@c FIXME::martin: Should this procedure be documented and supported -@c at all? - -The procedures in this section are useful if you want to dig into the -innards of Guile's module system. If you don't know precisely what you -do, you should probably avoid using any of them. - -@deffn {Scheme Procedure} standard-eval-closure module -@deffnx {C Function} scm_standard_eval_closure (module) -Return an eval closure for the module @var{module}. -@end deffn - - @node Module System Quirks @subsection Module System Quirks @@ -502,6 +483,103 @@ package Jacal from Guile (@pxref{JACAL}). @end table +@node Accessing Modules from C +@subsection Accessing Modules from C + +The last sections have described how modules are used in Scheme code, +which is the recommended way of creating and accessing modules. You +can also work with modules from C, but it is more cumbersome. + +The following procedures are available. + +@deftypefn {C Procedure} SCM scm_current_module () +Return the module that is the @emph{current module}. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_set_current_module (SCM module) +Set the current module to @var{module} and return the previous current +module. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_call_with_current_module (SCM module, SCM (*func)(void *), void *data) +Call @var{func} and make @var{module} the current module during the +call. The argument @var{data} is passed to @var{func}. The return +value of @code{scm_c_call_with_current_module} is the return value of +@var{func}. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_lookup (const char *name) +Return the variable bound to the symbol indicated by @var{name} in the +current module. If there is no such binding or the symbol is not +bound to a variable, signal an error. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_lookup (SCM name) +Like @code{scm_c_lookup}, but the symbol is specified directly. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_module_lookup (SCM module, const char *name) +@deftypefnx {C Procedure} SCM scm_module_lookup (SCM module, SCM name) +Like @code{scm_c_lookup} and @code{scm_lookup}, but the specified +module is used instead of the current one. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_define (const char *name, SCM val) +Bind the symbol indicated by @var{name} to a variable in the current +module and set that variable to @var{val}. When @var{name} is already +bound to a variable, use that. Else create a new variable. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_define (SCM name, SCM val) +Like @code{scm_c_define}, but the symbol is specified directly. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_module_define (SCM module, const char *name, SCM val) +@deftypefnx {C Procedure} SCM scm_module_define (SCM module, SCM name, SCM val) +Like @code{scm_c_define} and @code{scm_define}, but the specified +module is used instead of the current one. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_module_reverse_lookup (SCM module, SCM variable) +Find the symbol that is bound to @var{variable} in @var{module}. When no such binding is found, return @var{#f}. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_define_module (const char *name, void (*init)(void *), void *data) +Define a new module named @var{name} and make it current while +@var{init} is called, passing it @var{data}. Return the module. + +The parameter @var{name} is a string with the symbols that make up +the module name, separated by spaces. For example, @samp{"foo bar"} names +the module @samp{(foo bar)}. + +When there already exists a module named @var{name}, it is used +unchanged, otherwise, an empty module is created. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_resolve_module (const char *name) +Find the module name @var{name} and return it. When it has not +already been defined, try to auto-load it. When it can't be found +that way either, create an empty module. The name is interpreted as +for @code{scm_c_define_module}. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_resolve_module (SCM name) +Like @code{scm_c_resolve_module}, but the name is given as a real list +of symbols. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_use_module (const char *name) +Add the module named @var{name} to the uses list of the current +module, as with @code{(use-modules @var{name})}. The name is +interpreted as for @code{scm_c_define_module}. +@end deftypefn + +@deftypefn {C Procedure} SCM scm_c_export (const char *name, ...) +Add the bindings designated by @var{name}, ... to the public interface +of the current module. The list of names is terminated by +@code{NULL}. +@end deftypefn + @node Dynamic Libraries @section Dynamic Libraries From 28ab77254e3bf35036e03ec05294ff8f6a17569b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 12 Aug 2002 23:10:44 +0000 Subject: [PATCH 109/306] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 2c32b518b..79f5ef887 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-08-13 Marius Vollmer + + * scheme-modules.texi (More Modules Procedures): Removed. + (Accessing Modules from C): New. + 2002-08-10 Gary Houston * scheme-procedures.texi: new section Primitive Procedures, From 209b52fecdd298f175171513f97510f19c513e0f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 13 Aug 2002 20:54:12 +0000 Subject: [PATCH 110/306] * strports.h (scm_c_eval_string_in_module, scm_eval_string_in_module): New prototypes. * strports.c (scm_eval_string_in_module): New, but use "eval-string" as the Scheme name and make second parameter optional. (scm_eval_string): Implement using scm_eval_string_in_module. (scm_c_eval_string_in_module): New. Thanks to Ralf Mattes for the suggestion! --- libguile/strports.c | 32 +++++++++++++++++++++++++------- libguile/strports.h | 2 ++ 2 files changed, 27 insertions(+), 7 deletions(-) diff --git a/libguile/strports.c b/libguile/strports.c index 5af68bbcd..44a8db53b 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -440,6 +440,13 @@ scm_c_eval_string (const char *expr) return scm_eval_string (scm_makfrom0str (expr)); } +SCM +scm_c_eval_string_in_module (const char *expr, SCM module) +{ + return scm_eval_string_in_module (scm_makfrom0str (expr), module); +} + + static SCM inner_eval_string (void *data) { @@ -459,21 +466,32 @@ inner_eval_string (void *data) return ans; } -SCM_DEFINE (scm_eval_string, "eval-string", 1, 0, 0, - (SCM string), +SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, + (SCM string, SCM module), "Evaluate @var{string} as the text representation of a Scheme\n" "form or forms, and return whatever value they produce.\n" - "Evaluation takes place in the environment returned by the\n" - "procedure @code{interaction-environment}.") -#define FUNC_NAME s_scm_eval_string + "Evaluation takes place in the given module, or the current\n" + "module when no module is given.\n" + "While the code is evaluated, the given module is made the\n" + "current one. The current module is restored when this\n" + "procedure returns.") +#define FUNC_NAME s_scm_eval_string_in_module { SCM port = scm_mkstrport (SCM_INUM0, string, SCM_OPN | SCM_RDNG, - "eval-string"); - return scm_c_call_with_current_module (scm_interaction_environment (), + FUNC_NAME); + if (SCM_UNBNDP (module)) + module = scm_current_module (); + return scm_c_call_with_current_module (module, inner_eval_string, (void *)port); } #undef FUNC_NAME +SCM +scm_eval_string (SCM string) +{ + return scm_eval_string_in_module (string, SCM_UNDEFINED); +} + static scm_t_bits scm_make_stptob () { diff --git a/libguile/strports.h b/libguile/strports.h index 22e9168a2..5f2625c05 100644 --- a/libguile/strports.h +++ b/libguile/strports.h @@ -76,7 +76,9 @@ SCM_API SCM scm_open_output_string (void); SCM_API SCM scm_get_output_string (SCM port); SCM_API SCM scm_c_read_string (const char *expr); SCM_API SCM scm_c_eval_string (const char *expr); +SCM_API SCM scm_c_eval_string_in_module (const char *expr, SCM module); SCM_API SCM scm_eval_string (SCM string); +SCM_API SCM scm_eval_string_in_module (SCM string, SCM module); SCM_API void scm_init_strports (void); #endif /* SCM_STRPORTS_H */ From dc61cbc6cd786fd1cc3137d806eb1d6da6df7c83 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 13 Aug 2002 20:54:36 +0000 Subject: [PATCH 111/306] *** empty log message *** --- libguile/ChangeLog | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5b75a0ba9..fad2a618d 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,14 @@ +2002-08-13 Marius Vollmer + + * strports.h (scm_c_eval_string_in_module, + scm_eval_string_in_module): New prototypes. + * strports.c (scm_eval_string_in_module): New, but use + "eval-string" as the Scheme name and make second parameter + optional. + (scm_eval_string): Implement using scm_eval_string_in_module. + (scm_c_eval_string_in_module): New. + Thanks to Ralf Mattes for the suggestion! + 2002-08-09 Han-Wen Nienhuys * gc-card.c ("sweep_card"): remove SCM_MISC_ERROR messages: print From a05a88b3b2d277b0cff71bf52a265ea726afa7d5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 13 Aug 2002 22:05:46 +0000 Subject: [PATCH 112/306] (Fluids): Touched up a bit, added with-fluids. --- doc/ref/scheme-scheduling.texi | 40 ++++++++++++++++++++-------------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/doc/ref/scheme-scheduling.texi b/doc/ref/scheme-scheduling.texi index 920a73029..ea060177a 100644 --- a/doc/ref/scheme-scheduling.texi +++ b/doc/ref/scheme-scheduling.texi @@ -11,7 +11,7 @@ reviewed and largely reorganized.] * Asyncs:: Asynchronous procedure invocation. * Dynamic Roots:: Root frames of execution. * Threads:: Multiple threads of execution. -* Fluids:: Dynamically scoped variables. +* Fluids:: Thread-local variables. @end menu @@ -392,16 +392,17 @@ fluid are only visible in the same dynamic root. Since threads are executed in separate dynamic roots, fluids can be used for thread local storage (@pxref{Threads}). -Fluids can be used to simulate dynamically scoped variables. These are -used in several (especially in older) dialects of lisp, such as in Emacs -Lisp, and they work a bit like global variables in that they can be -modified by the caller of a procedure, and the called procedure will see -the changes. With lexically scoped variables---which are normally used -in Scheme---this cannot happen. See the description of -@code{with-fluids*} below for details. +Fluids can be used to simulate the desirable effects of dynamically +scoped variables. Dynamically scoped variables are useful when you +want to set a variable to a value during some dynamic extent in the +execution of your program and have them revert to their original value +when the control flow is outside of this dynamic extent. See the +description of @code{with-fluids} below for details. -New fluids are created with @code{make-fluid} and @code{fluid?} is used -for testing whether an object is actually a fluid. +New fluids are created with @code{make-fluid} and @code{fluid?} is +used for testing whether an object is actually a fluid. The values +stored in a fluid can be accessed with @code{fluid-ref} and +@code{fluid-set!}. @deffn {Scheme Procedure} make-fluid @deffnx {C Function} scm_make_fluid () @@ -420,9 +421,6 @@ Return @code{#t} iff @var{obj} is a fluid; otherwise, return @code{#f}. @end deffn -The values stored in a fluid can be accessed with @code{fluid-ref} and -@code{fluid-set!}. - @deffn {Scheme Procedure} fluid-ref fluid @deffnx {C Function} scm_fluid_ref (fluid) Return the value associated with @var{fluid} in the current @@ -442,11 +440,21 @@ given values. After the procedure returns, the old values are restored. @deffn {Scheme Procedure} with-fluids* fluids values thunk @deffnx {C Function} scm_with_fluids (fluids, values, thunk) Set @var{fluids} to @var{values} temporary, and call @var{thunk}. -@var{fluids} must be a list of fluids and @var{values} must be the same -number of their values to be applied. Each substitution is done -one after another. @var{thunk} must be a procedure with no argument. +@var{fluids} must be a list of fluids and @var{values} must be the +same number of their values to be applied. Each substitution is done +in the order given. @var{thunk} must be a procedure with no argument. +it is called inside a @code{dynamic-wind} and the fluids are +set/restored when control enter or leaves the established dynamic +extent. @end deffn +@deffn {Scheme Macro} with-fluids ((fluid value) ...) body... +Execute @var{body...} while each @var{fluid} is set to the +corresponding @var{value}. Both @var{fluid} and @var{value} are +evaluated and @var{fluid} must yield a fluid. @var{body...} is +executed inside a @code{dynamic-wind} and the fluids are set/restored +when control enter or leaves the established dynamic extent. +@end deffn @c Local Variables: @c TeX-master: "guile.texi" From 21fabda15dd67a56ad893195a7f33b64ad323632 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 13 Aug 2002 22:06:14 +0000 Subject: [PATCH 113/306] (eval-string): Updated. --- doc/ref/scheme-evaluation.texi | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/doc/ref/scheme-evaluation.texi b/doc/ref/scheme-evaluation.texi index b73f8316d..6357c78cf 100644 --- a/doc/ref/scheme-evaluation.texi +++ b/doc/ref/scheme-evaluation.texi @@ -205,12 +205,14 @@ return the environment in which the implementation would evaluate expressions dynamically typed by the user. @end deffn -@deffn {Scheme Procedure} eval-string string +@deffn {Scheme Procedure} eval-string string [module] @deffnx {C Function} scm_eval_string (string) -Evaluate @var{string} as the text representation of a Scheme -form or forms, and return whatever value they produce. -Evaluation takes place in the environment returned by the -procedure @code{interaction-environment}. +@deffnx {C Function} scm_eval_string_in_module (string, module) +Evaluate @var{string} as the text representation of a Scheme form or +forms, and return whatever value they produce. Evaluation takes place +in the given module, or in the current module when no module is given. +While the code is evaluated, the given module is made the current one. +The current module is restored when this procedure returns. @end deffn @deffn {Scheme Procedure} apply:nconc2last lst From 29dae8f8c805416074a3539fd19190aeafe11cf2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 13 Aug 2002 22:06:22 +0000 Subject: [PATCH 114/306] *** empty log message *** --- doc/ref/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 79f5ef887..60de2f380 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,10 @@ +2002-08-14 Marius Vollmer + + * scheme-evaluation.texi (eval-string): Updated. + + * scheme-scheduling.texi (Fluids): Touched up a bit, added + with-fluids. + 2002-08-13 Marius Vollmer * scheme-modules.texi (More Modules Procedures): Removed. From f07c886abbde77c62528981137406da88cf2f055 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Thu, 15 Aug 2002 21:17:21 +0000 Subject: [PATCH 115/306] * vports.c (scm_make_soft_port): Initialize pt variable. --- libguile/ChangeLog | 4 ++++ libguile/vports.c | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index fad2a618d..bea586102 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-08-15 Mikael Djurfeldt + + * vports.c (scm_make_soft_port): Initialize pt variable. + 2002-08-13 Marius Vollmer * strports.h (scm_c_eval_string_in_module, diff --git a/libguile/vports.c b/libguile/vports.c index 977a69e91..94e44976c 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -192,6 +192,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, SCM_DEFER_INTS; z = scm_new_port_table_entry (scm_tc16_sfport); + pt = SCM_PTAB_ENTRY (z); scm_port_non_buffer (pt); SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_STRING_CHARS (modes))); From 67329a9eefdcfae7ccee5ba2afc783e30dacdae2 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 16 Aug 2002 22:01:10 +0000 Subject: [PATCH 116/306] * mallocs.c (scm_malloc_obj): use scm_gc_malloc in stead of malloc. * gc-segment.c (scm_i_get_new_heap_segment): remove cluster cruft: only use SCM_MIN_HEAP_SEG_SIZE. * ports.c (scm_add_to_port_table): add backwards compatibility function * ports.h: use scm_i_ prefix for port table and port table size. --- libguile/ChangeLog | 16 ++++++++++ libguile/alloca.c | 2 +- libguile/coop.c | 8 ++--- libguile/deprecation.c | 2 +- libguile/fports.c | 4 +-- libguile/gc-segment.c | 13 ++------ libguile/gc.c | 6 ++-- libguile/goops.c | 4 +-- libguile/ioext.c | 8 ++--- libguile/mallocs.c | 2 +- libguile/ports.c | 68 +++++++++++++++++++++++++---------------- libguile/ports.h | 11 +++++-- libguile/posix.c | 6 ++-- libguile/putenv.c | 2 +- libguile/random.c | 4 +-- libguile/script.c | 6 ++-- libguile/socket.c | 6 ++-- libguile/sort.c | 4 +-- libguile/srcprop.c | 2 +- libguile/strings.c | 2 +- libguile/symbols.c | 2 +- libguile/win32-dirent.c | 6 ++-- 22 files changed, 107 insertions(+), 77 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index bea586102..6af70e988 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,19 @@ +2002-08-17 Han-Wen Nienhuys + + * *.c: use scm_malloc in stead of malloc everywhere. + + * mallocs.c (scm_malloc_obj): use scm_gc_malloc in stead of + malloc. + + * gc-segment.c (scm_i_get_new_heap_segment): remove cluster cruft: + only use SCM_MIN_HEAP_SEG_SIZE. + + * ports.c (scm_add_to_port_table): add backwards compatibility + function + + * ports.h: use scm_i_ prefix for port table and port table size. + + 2002-08-15 Mikael Djurfeldt * vports.c (scm_make_soft_port): Initialize pt variable. diff --git a/libguile/alloca.c b/libguile/alloca.c index e814ed43f..4e09fd205 100644 --- a/libguile/alloca.c +++ b/libguile/alloca.c @@ -200,7 +200,7 @@ alloca (unsigned size) /* Allocate combined header + user data storage. */ { - register pointer new = (pointer) malloc (sizeof (header) + size); + register pointer new = (pointer) scm_malloc (sizeof (header) + size); /* Address of header. */ if (new == 0) diff --git a/libguile/coop.c b/libguile/coop.c index ca057b423..2a39a5910 100644 --- a/libguile/coop.c +++ b/libguile/coop.c @@ -40,7 +40,7 @@ * If you do not wish that, delete this exception notice. */ -/* $Id: coop.c,v 1.29 2001-11-04 15:52:29 ela Exp $ */ +/* $Id: coop.c,v 1.30 2002-08-16 22:01:09 hanwen Exp $ */ /* Cooperative thread library, based on QuickThreads */ @@ -620,7 +620,7 @@ coop_create (coop_userf_t *f, void *pu) else #endif { - t = malloc (sizeof (coop_t)); + t = scm_malloc (sizeof (coop_t), "coop"); t->specific = NULL; t->n_keys = 0; @@ -647,7 +647,7 @@ coop_create (coop_userf_t *f, void *pu) while (coop_child || mother_awake_p) usleep (0); #else - t->sto = malloc (COOP_STKSIZE); + t->sto = scm_malloc (COOP_STKSIZE); sto = COOP_STKALIGN (t->sto, QT_STKALIGN); t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN); #endif @@ -730,7 +730,7 @@ coop_join(coop_t *t) /* Create a join list if necessary */ if (t->joining == NULL) { - t->joining = malloc(sizeof(coop_q_t)); + t->joining = scm_malloc(sizeof(coop_q_t)); coop_qinit((coop_q_t *) t->joining); } diff --git a/libguile/deprecation.c b/libguile/deprecation.c index fa22e49a2..6b5ab3c15 100644 --- a/libguile/deprecation.c +++ b/libguile/deprecation.c @@ -87,7 +87,7 @@ scm_c_issue_deprecation_warning (const char *msg) scm_newline (scm_current_error_port ()); } msg = strdup (msg); - iw = malloc (sizeof (struct issued_warning)); + iw = scm_malloc (sizeof (struct issued_warning)); if (msg == NULL || iw == NULL) return; iw->message = msg; diff --git a/libguile/fports.c b/libguile/fports.c index 222b2034d..2fe9aa059 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -220,9 +220,9 @@ scm_evict_ports (int fd) { long i; - for (i = 0; i < scm_port_table_size; i++) + for (i = 0; i < scm_i_port_table_size; i++) { - SCM port = scm_port_table[i]->port; + SCM port = scm_i_port_table[i]->port; if (SCM_FPORTP (port)) { diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 593aa29a2..46054fc53 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -512,21 +512,14 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro freelist->collected = LONG_MAX; } - if (len > scm_max_segment_size) - len = scm_max_segment_size; + if (len > SCM_MIN_HEAP_SEG_SIZE) + len = SCM_MIN_HEAP_SEG_SIZE; { - size_t smallest; scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); - - smallest = 1024 * 10; /* UGH. */ - - if (len < smallest) - len = smallest; /* Allocate with decaying ambition. */ - while ((len >= SCM_MIN_HEAP_SEG_SIZE) - && (len >= smallest)) + while (len >= SCM_MIN_HEAP_SEG_SIZE) { if (scm_i_initialize_heap_segment_data (seg, len)) { diff --git a/libguile/gc.c b/libguile/gc.c index b29138573..97ae62c45 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -892,9 +892,9 @@ scm_init_storage () scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL); /* Initialise the list of ports. */ - scm_port_table = (scm_t_port **) - malloc (sizeof (scm_t_port *) * scm_port_table_room); - if (!scm_port_table) + scm_i_port_table = (scm_t_port **) + malloc (sizeof (scm_t_port *) * scm_i_port_table_room); + if (!scm_i_port_table) return 1; #ifdef HAVE_ATEXIT diff --git a/libguile/goops.c b/libguile/goops.c index 8017cffa3..61b3d6575 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -2393,7 +2393,7 @@ create_smob_classes (void) { long i; - scm_smob_class = (SCM *) malloc (255 * sizeof (SCM)); + scm_smob_class = (SCM *) scm_malloc (255 * sizeof (SCM)); for (i = 0; i < 255; ++i) scm_smob_class[i] = 0; @@ -2436,7 +2436,7 @@ create_port_classes (void) { long i; - scm_port_class = (SCM *) malloc (3 * 256 * sizeof (SCM)); + scm_port_class = (SCM *) scm_malloc (3 * 256 * sizeof (SCM)); for (i = 0; i < 3 * 256; ++i) scm_port_class[i] = 0; diff --git a/libguile/ioext.c b/libguile/ioext.c index 931a157f7..cbc301131 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -302,11 +302,11 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0, SCM_VALIDATE_INUM_COPY (1, fd, int_fd); - for (i = 0; i < scm_port_table_size; i++) + for (i = 0; i < scm_i_port_table_size; i++) { - if (SCM_OPFPORTP (scm_port_table[i]->port) - && ((scm_t_fport *) scm_port_table[i]->stream)->fdes == int_fd) - result = scm_cons (scm_port_table[i]->port, result); + if (SCM_OPFPORTP (scm_i_port_table[i]->port) + && ((scm_t_fport *) scm_i_port_table[i]->stream)->fdes == int_fd) + result = scm_cons (scm_i_port_table[i]->port, result); } return result; } diff --git a/libguile/mallocs.c b/libguile/mallocs.c index accdcce36..6360ec2b9 100644 --- a/libguile/mallocs.c +++ b/libguile/mallocs.c @@ -84,7 +84,7 @@ malloc_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) SCM scm_malloc_obj (size_t n) { - scm_t_bits mem = n ? (scm_t_bits) malloc (n) : 0; + scm_t_bits mem = n ? (scm_t_bits) scm_gc_malloc (n, "malloc smob") : 0; if (n && !mem) return SCM_BOOL_F; SCM_RETURN_NEWSMOB (scm_tc16_malloc, mem); diff --git a/libguile/ports.c b/libguile/ports.c index 80ef93d4e..bf3306d8f 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -446,36 +446,36 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0, /* The port table --- an array of pointers to ports. */ -scm_t_port **scm_port_table; +scm_t_port **scm_i_port_table; -long scm_port_table_size = 0; /* Number of ports in scm_port_table. */ -long scm_port_table_room = 20; /* Size of the array. */ +long scm_i_port_table_size = 0; /* Number of ports in scm_i_port_table. */ +long scm_i_port_table_room = 20; /* Size of the array. */ SCM scm_new_port_table_entry (scm_t_bits tag) #define FUNC_NAME "scm_new_port_table_entry" { - SCM z = scm_cell (SCM_EOL, SCM_EOL); + SCM z = scm_cons (SCM_EOL, SCM_EOL); scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port"); - if (scm_port_table_size == scm_port_table_room) + if (scm_i_port_table_size == scm_i_port_table_room) { /* initial malloc is in gc.c. this doesn't use scm_gc_malloc etc., since it can never be freed during gc. */ - void *newt = scm_realloc ((char *) scm_port_table, + void *newt = scm_realloc ((char *) scm_i_port_table, (size_t) (sizeof (scm_t_port *) - * scm_port_table_room * 2)); - scm_port_table = (scm_t_port **) newt; - scm_port_table_room *= 2; + * scm_i_port_table_room * 2)); + scm_i_port_table = (scm_t_port **) newt; + scm_i_port_table_room *= 2; } - entry->entry = scm_port_table_size; + entry->entry = scm_i_port_table_size; entry->file_name = SCM_BOOL_F; entry->rw_active = SCM_PORT_NEITHER; - scm_port_table[scm_port_table_size] = entry; - scm_port_table_size++; + scm_i_port_table[scm_i_port_table_size] = entry; + scm_i_port_table_size++; entry->port = z; SCM_SET_CELL_TYPE(z, tag); @@ -485,6 +485,22 @@ scm_new_port_table_entry (scm_t_bits tag) } #undef FUNC_NAME +#if SCM_ENABLE_DEPRECATED==1 +SCM_API scm_t_port * +scm_add_to_port_table (SCM port) +{ + SCM z = scm_new_port_table_entry (scm_tc7_port); + scm_t_port * pt = SCM_PTAB_ENTRY(z); + + pt->port = port; + SCM_SETCAR(z, SCM_EOL); + SCM_SETCDR(z, SCM_EOL); + + return pt; +} +#endif + + /* Remove a port from the table and destroy it. */ void scm_remove_from_port_table (SCM port) @@ -493,20 +509,20 @@ scm_remove_from_port_table (SCM port) scm_t_port *p = SCM_PTAB_ENTRY (port); long i = p->entry; - if (i >= scm_port_table_size) + if (i >= scm_i_port_table_size) SCM_MISC_ERROR ("Port not in table: ~S", scm_list_1 (port)); if (p->putback_buf) scm_gc_free (p->putback_buf, p->putback_buf_size, "putback buffer"); scm_gc_free (p, sizeof (scm_t_port), "port"); /* Since we have just freed slot i we can shrink the table by moving the last entry to that slot... */ - if (i < scm_port_table_size - 1) + if (i < scm_i_port_table_size - 1) { - scm_port_table[i] = scm_port_table[scm_port_table_size - 1]; - scm_port_table[i]->entry = i; + scm_i_port_table[i] = scm_i_port_table[scm_i_port_table_size - 1]; + scm_i_port_table[i]->entry = i; } SCM_SETPTAB_ENTRY (port, 0); - scm_port_table_size--; + scm_i_port_table_size--; } #undef FUNC_NAME @@ -520,7 +536,7 @@ SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0, "is only included in @code{--enable-guile-debug} builds.") #define FUNC_NAME s_scm_pt_size { - return SCM_MAKINUM (scm_port_table_size); + return SCM_MAKINUM (scm_i_port_table_size); } #undef FUNC_NAME @@ -533,10 +549,10 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0, { long i; SCM_VALIDATE_INUM_COPY (1, index, i); - if (i < 0 || i >= scm_port_table_size) + if (i < 0 || i >= scm_i_port_table_size) return SCM_BOOL_F; else - return scm_port_table[i]->port; + return scm_i_port_table[i]->port; } #undef FUNC_NAME #endif @@ -741,8 +757,8 @@ SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0, SCM_DEFER_INTS; scm_block_gc++; ports = SCM_EOL; - for (i = 0; i < scm_port_table_size; i++) - ports = scm_cons (scm_port_table[i]->port, ports); + for (i = 0; i < scm_i_port_table_size; i++) + ports = scm_cons (scm_i_port_table[i]->port, ports); scm_block_gc--; SCM_ALLOW_INTS; @@ -844,10 +860,10 @@ SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0, { size_t i; - for (i = 0; i < scm_port_table_size; i++) + for (i = 0; i < scm_i_port_table_size; i++) { - if (SCM_OPOUTPORTP (scm_port_table[i]->port)) - scm_flush (scm_port_table[i]->port); + if (SCM_OPOUTPORTP (scm_i_port_table[i]->port)) + scm_flush (scm_i_port_table[i]->port); } return SCM_UNSPECIFIED; } @@ -1497,7 +1513,7 @@ void scm_ports_prehistory () { scm_numptob = 0; - scm_ptobs = (scm_t_ptob_descriptor *) malloc (sizeof (scm_t_ptob_descriptor)); + scm_ptobs = (scm_t_ptob_descriptor *) scm_malloc (sizeof (scm_t_ptob_descriptor)); } diff --git a/libguile/ports.h b/libguile/ports.h index c85ecfd55..d4779177a 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -132,8 +132,8 @@ typedef struct size_t putback_buf_size; /* allocated size of putback_buf. */ } scm_t_port; -SCM_API scm_t_port **scm_port_table; -SCM_API long scm_port_table_size; /* Number of ports in scm_port_table. */ +SCM_API scm_t_port **scm_i_port_table; +SCM_API long scm_i_port_table_size; /* Number of ports in scm_i_port_table. */ #define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end) @@ -215,7 +215,7 @@ typedef struct scm_t_ptob_descriptor SCM_API scm_t_ptob_descriptor *scm_ptobs; SCM_API long scm_numptob; -SCM_API long scm_port_table_room; +SCM_API long scm_i_port_table_room; @@ -309,6 +309,11 @@ SCM_API SCM scm_void_port (char * mode_str); SCM_API SCM scm_sys_make_void_port (SCM mode); SCM_API void scm_init_ports (void); + +#if SCM_ENABLE_DEPRECATED==1 +SCM_API scm_t_port * scm_add_to_port_table (SCM port); +#endif + #ifdef GUILE_DEBUG SCM_API SCM scm_pt_size (void); SCM_API SCM scm_pt_member (SCM member); diff --git a/libguile/posix.c b/libguile/posix.c index a4da1a8cf..3fac8efd0 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -906,7 +906,7 @@ environ_list_to_c (SCM envlist, int arg, const char *proc) num_strings = scm_ilength (envlist); SCM_ASSERT (num_strings >= 0, envlist, arg, proc); - result = (char **) malloc ((num_strings + 1) * sizeof (char *)); + result = (char **) scm_malloc ((num_strings + 1) * sizeof (char *)); if (result == NULL) scm_memory_error (proc); for (i = 0; !SCM_NULL_OR_NIL_P (envlist); ++i, envlist = SCM_CDR (envlist)) @@ -918,7 +918,7 @@ environ_list_to_c (SCM envlist, int arg, const char *proc) SCM_ASSERT (SCM_STRINGP (str), envlist, arg, proc); len = SCM_STRING_LENGTH (str); src = SCM_STRING_CHARS (str); - result[i] = malloc (len + 1); + result[i] = scm_malloc (len + 1); if (result[i] == NULL) scm_memory_error (proc); memcpy (result[i], src, len); @@ -1193,7 +1193,7 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0, else { /* must make a new copy to be left in the environment, safe from gc. */ - ptr = malloc (SCM_STRING_LENGTH (str) + 1); + ptr = scm_malloc (SCM_STRING_LENGTH (str) + 1); if (ptr == NULL) SCM_MEMORY_ERROR; strncpy (ptr, SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str)); diff --git a/libguile/putenv.c b/libguile/putenv.c index ccfaaa2d8..88f82144f 100644 --- a/libguile/putenv.c +++ b/libguile/putenv.c @@ -115,7 +115,7 @@ putenv (const char *string) if (*ep == NULL) { static char **last_environ = NULL; - char **new_environ = (char **) malloc ((size + 2) * sizeof (char *)); + char **new_environ = (char **) scm_malloc ((size + 2) * sizeof (char *)); if (new_environ == NULL) return -1; memcpy ((char *) new_environ, (char *) environ, size * sizeof (char *)); diff --git a/libguile/random.c b/libguile/random.c index efdf59749..f39a0df3a 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -176,7 +176,7 @@ scm_i_init_rstate (scm_t_i_rstate *state, char *seed, int n) scm_t_i_rstate * scm_i_copy_rstate (scm_t_i_rstate *state) { - scm_t_rstate *new_state = malloc (scm_the_rng.rstate_size); + scm_t_rstate *new_state = scm_malloc (scm_the_rng.rstate_size); if (new_state == 0) scm_memory_error ("rstate"); return memcpy (new_state, state, scm_the_rng.rstate_size); @@ -190,7 +190,7 @@ scm_i_copy_rstate (scm_t_i_rstate *state) scm_t_rstate * scm_c_make_rstate (char *seed, int n) { - scm_t_rstate *state = malloc (scm_the_rng.rstate_size); + scm_t_rstate *state = scm_malloc (scm_the_rng.rstate_size); if (state == 0) scm_memory_error ("rstate"); state->reserved0 = 0; diff --git a/libguile/script.c b/libguile/script.c index 58d48fab4..6e328523a 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -83,7 +83,7 @@ scm_cat_path (char *str1, const char *str2, long n) strncat (str1 + len, str2, n); return str1; } - str1 = (char *) malloc ((size_t) (n + 1)); + str1 = (char *) scm_malloc ((size_t) (n + 1)); if (!str1) return 0L; str1[0] = 0; @@ -236,7 +236,7 @@ script_read_arg (FILE *f) #define FUNC_NAME "script_read_arg" { size_t size = 7; - char *buf = malloc (size + 1); + char *buf = scm_malloc (size + 1); size_t len = 0; if (! buf) @@ -315,7 +315,7 @@ scm_get_meta_args (int argc, char **argv) char *narg, **nargv; if (!(argc > 2 && script_meta_arg_P (argv[1]))) return 0L; - if (!(nargv = (char **) malloc ((1 + nargc) * sizeof (char *)))) + if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *)))) return 0L; nargv[0] = argv[0]; while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi]))) diff --git a/libguile/socket.c b/libguile/socket.c index bf1dc019e..86d01f3c5 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -707,7 +707,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg, SCM_VALIDATE_CONS (which_arg + 1, *args); SCM_VALIDATE_INUM_COPY (which_arg + 1, SCM_CAR (*args), port); *args = SCM_CDR (*args); - soka = (struct sockaddr_in *) malloc (sizeof (struct sockaddr_in)); + soka = (struct sockaddr_in *) scm_malloc (sizeof (struct sockaddr_in)); if (!soka) scm_memory_error (proc); /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN, @@ -745,7 +745,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg, *args = SCM_CDR (*args); } } - soka = (struct sockaddr_in6 *) malloc (sizeof (struct sockaddr_in6)); + soka = (struct sockaddr_in6 *) scm_malloc (sizeof (struct sockaddr_in6)); if (!soka) scm_memory_error (proc); #ifdef SIN_LEN6 @@ -777,7 +777,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg, member of the structure. */ addr_size = sizeof (struct sockaddr_un) + max (0, SCM_STRING_LENGTH (address) + 1 - (sizeof soka->sun_path)); - soka = (struct sockaddr_un *) malloc (addr_size); + soka = (struct sockaddr_un *) scm_malloc (addr_size); if (!soka) scm_memory_error (proc); memset (soka, 0, addr_size); /* for sun_len: see sin_len above. */ diff --git a/libguile/sort.c b/libguile/sort.c index e8b332e42..9e547e764 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -878,7 +878,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, the following array does not contain any new references to SCM objects, so we can get away with allocing it on the heap. */ - temp = malloc (len * sizeof(SCM)); + temp = scm_malloc (len * sizeof(SCM)); scm_merge_vector_step (items, temp, @@ -919,7 +919,7 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, else if (SCM_VECTORP (items)) { long len = SCM_VECTOR_LENGTH (items); - SCM *temp = malloc (len * sizeof (SCM)); + SCM *temp = scm_malloc (len * sizeof (SCM)); SCM retvec = scm_make_uve (len, scm_array_prototype (items)); scm_array_copy_x (items, retvec); diff --git a/libguile/srcprop.c b/libguile/srcprop.c index a47dfc0ea..b1e48eaa2 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -138,7 +138,7 @@ scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist) scm_t_srcprops_chunk *mem; size_t n = sizeof (scm_t_srcprops_chunk) + sizeof (scm_t_srcprops) * (SRCPROPS_CHUNKSIZE - 1); - SCM_SYSCALL (mem = (scm_t_srcprops_chunk *) malloc (n)); + SCM_SYSCALL (mem = (scm_t_srcprops_chunk *) scm_malloc (n)); if (mem == NULL) scm_memory_error ("srcprops"); scm_mallocated += n; diff --git a/libguile/strings.c b/libguile/strings.c index cbfab7b99..63078bc9f 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -363,7 +363,7 @@ scm_c_string2str (SCM obj, char *str, size_t *lenp) { /* FIXME: Should we use exported wrappers for malloc (and free), which * allow windows DLLs to call the correct freeing function? */ - str = (char *) malloc ((len + 1) * sizeof (char)); + str = (char *) scm_malloc ((len + 1) * sizeof (char)); if (str == NULL) return NULL; } diff --git a/libguile/symbols.c b/libguile/symbols.c index ecc701bdf..021fb7fd5 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -383,7 +383,7 @@ scm_c_symbol2str (SCM obj, char *str, size_t *lenp) { /* FIXME: Should we use exported wrappers for malloc (and free), which * allow windows DLLs to call the correct freeing function? */ - str = (char *) malloc ((len + 1) * sizeof (char)); + str = (char *) scm_malloc ((len + 1) * sizeof (char)); if (str == NULL) return NULL; } diff --git a/libguile/win32-dirent.c b/libguile/win32-dirent.c index 2f9458f2a..c3bdd434c 100644 --- a/libguile/win32-dirent.c +++ b/libguile/win32-dirent.c @@ -57,7 +57,7 @@ opendir (const char * name) if (!name || !*name) return NULL; - file = malloc (strlen (name) + 3); + file = scm_malloc (strlen (name) + 3); strcpy (file, name); if (file[strlen (name) - 1] != '/' && file[strlen (name) - 1] != '\\') strcat (file, "/*"); @@ -70,10 +70,10 @@ opendir (const char * name) return NULL; } - dir = malloc (sizeof (DIR)); + dir = scm_malloc (sizeof (DIR)); dir->mask = file; dir->fd = (int) hnd; - dir->data = malloc (sizeof (WIN32_FIND_DATA)); + dir->data = scm_malloc (sizeof (WIN32_FIND_DATA)); dir->allocation = sizeof (WIN32_FIND_DATA); dir->size = dir->allocation; dir->filepos = 0; From 85835e5991345089cc61e2f2b658aebd9f1198f4 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 16 Aug 2002 22:07:26 +0000 Subject: [PATCH 117/306] * ports.c (scm_add_to_port_table): small bugfix. * ports.c (scm_add_to_port_table): add backwards compatibility function --- libguile/ChangeLog | 2 +- libguile/ports.c | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 6af70e988..11094ec50 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,6 +1,6 @@ 2002-08-17 Han-Wen Nienhuys - * *.c: use scm_malloc in stead of malloc everywhere. + * ports.c (scm_add_to_port_table): small bugfix. * mallocs.c (scm_malloc_obj): use scm_gc_malloc in stead of malloc. diff --git a/libguile/ports.c b/libguile/ports.c index bf3306d8f..52a4dee28 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -456,6 +456,11 @@ SCM scm_new_port_table_entry (scm_t_bits tag) #define FUNC_NAME "scm_new_port_table_entry" { + /* + We initialize the cell to empty, this is in case scm_gc_calloc + triggers GC ; we don't want the GC to scan a half-finished Z. + */ + SCM z = scm_cons (SCM_EOL, SCM_EOL); scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port"); if (scm_i_port_table_size == scm_i_port_table_room) @@ -495,7 +500,7 @@ scm_add_to_port_table (SCM port) pt->port = port; SCM_SETCAR(z, SCM_EOL); SCM_SETCDR(z, SCM_EOL); - + SCM_SETPTAB_ENTRY (port, pt); return pt; } #endif From d900cd6dd406158c459bc133a20105ae16fe5064 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sat, 17 Aug 2002 20:39:35 +0000 Subject: [PATCH 118/306] * coop.c (coop_create): removed bogus 2nd argument in scm_malloc call. --- libguile/coop.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/libguile/coop.c b/libguile/coop.c index 2a39a5910..889276e23 100644 --- a/libguile/coop.c +++ b/libguile/coop.c @@ -40,7 +40,7 @@ * If you do not wish that, delete this exception notice. */ -/* $Id: coop.c,v 1.30 2002-08-16 22:01:09 hanwen Exp $ */ +/* $Id: coop.c,v 1.31 2002-08-17 20:39:35 ghouston Exp $ */ /* Cooperative thread library, based on QuickThreads */ @@ -620,8 +620,7 @@ coop_create (coop_userf_t *f, void *pu) else #endif { - t = scm_malloc (sizeof (coop_t), "coop"); - + t = scm_malloc (sizeof (coop_t)); t->specific = NULL; t->n_keys = 0; #ifdef GUILE_PTHREAD_COMPAT From f76af603e1a216f2eada17be467ee5d11fd5fb86 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 19 Aug 2002 23:22:42 +0000 Subject: [PATCH 119/306] (scm_iprin1): Print primitives generics always as "primitive-generic" even when they have no primitive methods yet. --- libguile/print.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/print.c b/libguile/print.c index a5e0fc818..cf1ba134d 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995-1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995-1999,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -601,7 +601,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) break; #endif case scm_tcs_subrs: - scm_puts (SCM_SUBR_GENERIC (exp) && *SCM_SUBR_GENERIC (exp) + scm_puts (SCM_SUBR_GENERIC (exp) ? "# Date: Mon, 19 Aug 2002 23:23:23 +0000 Subject: [PATCH 120/306] Updated copyright years. --- libguile/strports.c | 2 +- libguile/strports.h | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/strports.c b/libguile/strports.c index 44a8db53b..107fedd01 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by diff --git a/libguile/strports.h b/libguile/strports.h index 5f2625c05..52b976209 100644 --- a/libguile/strports.h +++ b/libguile/strports.h @@ -3,7 +3,7 @@ #ifndef SCM_STRPORTS_H #define SCM_STRPORTS_H -/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001,2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by From 483f518bd4112f0c5069e5f7a8d6b65e9fe9c6d4 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 19 Aug 2002 23:25:33 +0000 Subject: [PATCH 121/306] *** empty log message *** --- libguile/ChangeLog | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 11094ec50..dccf59600 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-08-20 Marius Vollmer + + * print.c (scm_iprin1): Print primitives generics always as + "primitive-generic" even when they have no primitive methods yet. + 2002-08-17 Han-Wen Nienhuys * ports.c (scm_add_to_port_table): small bugfix. @@ -13,7 +18,6 @@ * ports.h: use scm_i_ prefix for port table and port table size. - 2002-08-15 Mikael Djurfeldt * vports.c (scm_make_soft_port): Initialize pt variable. From f2893a253e7597363c5f6d2ee1c07aa64130154f Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 21 Aug 2002 22:40:03 +0000 Subject: [PATCH 122/306] make scm_cells_allocated unsigned again. Thanks to Bill Schottstaedt for the bug report --- libguile/ChangeLog | 5 +++++ libguile/gc-freelist.c | 2 +- libguile/gc-segment.c | 2 +- libguile/gc.c | 6 +++--- libguile/gc.h | 2 +- 5 files changed, 11 insertions(+), 6 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index dccf59600..7006dc570 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-08-22 Han-Wen Nienhuys + + * gc.h, gc.c: make scm_cells_allocated unsigned again. Thanks to + Bill Schottstaedt for the bug report + 2002-08-20 Marius Vollmer * print.c (scm_iprin1): Print primitives generics always as diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c index 21720534a..c885ceaf1 100644 --- a/libguile/gc-freelist.c +++ b/libguile/gc-freelist.c @@ -123,7 +123,7 @@ scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist) - (long) SCM_MAX (scm_gc_cells_collected_1, scm_gc_cells_collected)); #ifdef DEBUGINFO fprintf (stderr, " after GC = %lu, delta = %ld\n", - (long) scm_cells_allocated, + (unsigned long) scm_cells_allocated, (long) delta); #endif if (delta > 0) diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 46054fc53..e459291d3 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -228,7 +228,7 @@ scm_i_sweep_segment (scm_t_heap_segment * seg) scm_t_cell * p = seg->next_free_card; int yield = scm_gc_cells_collected; int coll = seg->freelist->collected; - int alloc = scm_cells_allocated ; + unsigned long alloc = scm_cells_allocated ; while (scm_i_sweep_some_cards (seg) != SCM_EOL) ; diff --git a/libguile/gc.c b/libguile/gc.c index 97ae62c45..fdc390e79 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -283,7 +283,7 @@ SCM scm_structs_to_free; /* GC Statistics Keeping */ -long scm_cells_allocated = 0; +unsigned long scm_cells_allocated = 0; unsigned long scm_mallocated = 0; unsigned long scm_gc_cells_collected; unsigned long scm_gc_cells_collected_1 = 0; /* previous GC yield */ @@ -337,7 +337,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, unsigned long int local_scm_heap_size; int local_scm_gc_cell_yield_percentage; int local_scm_gc_malloc_yield_percentage; - long int local_scm_cells_allocated; + unsigned long int local_scm_cells_allocated; unsigned long int local_scm_gc_time_taken; unsigned long int local_scm_gc_times; unsigned long int local_scm_gc_mark_time_taken; @@ -392,7 +392,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, } answer = scm_list_n (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)), - scm_cons (sym_cells_allocated, scm_long2num (local_scm_cells_allocated)), + scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)), scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)), scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)), scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)), diff --git a/libguile/gc.h b/libguile/gc.h index f0f89b7f7..7388d5e42 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -290,7 +290,7 @@ SCM_API unsigned long scm_gc_cells_collected; SCM_API unsigned long scm_gc_cells_collected; SCM_API unsigned long scm_gc_malloc_collected; SCM_API unsigned long scm_gc_ports_collected; -SCM_API long scm_cells_allocated; +SCM_API unsigned long scm_cells_allocated; SCM_API int scm_gc_cell_yield_percentage; SCM_API int scm_gc_malloc_yield_percentage; SCM_API unsigned long scm_mallocated; From 917adc55acec19ba5846179f3824d20f89acb456 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Thu, 22 Aug 2002 18:20:36 +0000 Subject: [PATCH 123/306] *** empty log message *** --- libguile/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7006dc570..3420fca5c 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -8,6 +8,11 @@ * print.c (scm_iprin1): Print primitives generics always as "primitive-generic" even when they have no primitive methods yet. +2002-08-17 Gary Houston + + * coop.c (coop_create): removed bogus 2nd argument in scm_malloc + call. + 2002-08-17 Han-Wen Nienhuys * ports.c (scm_add_to_port_table): small bugfix. From 4a5309c938fac5c5c65db0a8bacd5f7e20d918e5 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 23 Aug 2002 00:05:58 +0000 Subject: [PATCH 124/306] (scm_i_get_new_heap_segment): Oops. We want segment length *at* least SCM_MIN_HEAP_SEG_SIZE, not at most. --- libguile/ChangeLog | 5 +++++ libguile/gc-segment.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 3420fca5c..c0236c4e5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-08-23 Han-Wen Nienhuys + + * gc-segment.c (scm_i_get_new_heap_segment): Oops. We want segment + length *at* least SCM_MIN_HEAP_SEG_SIZE, not at most. + 2002-08-22 Han-Wen Nienhuys * gc.h, gc.c: make scm_cells_allocated unsigned again. Thanks to diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index e459291d3..53c02cd3a 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -512,7 +512,7 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro freelist->collected = LONG_MAX; } - if (len > SCM_MIN_HEAP_SEG_SIZE) + if (len < SCM_MIN_HEAP_SEG_SIZE) len = SCM_MIN_HEAP_SEG_SIZE; { From 34690e5338d8f4c8ccc992d3b2fe0f704db766a4 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Aug 2002 00:53:44 +0000 Subject: [PATCH 125/306] Do not expect the input file to be the first argument after the optional "-o" option, just pass everything to the pre-processor without extracting the input file name. --- libguile/guile-snarf.in | 82 ++++++++++++----------------------------- 1 file changed, 24 insertions(+), 58 deletions(-) diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in index 3d9ac957b..f1343aab2 100644 --- a/libguile/guile-snarf.in +++ b/libguile/guile-snarf.in @@ -20,64 +20,40 @@ # Commentary: -# Usage: guile-snarf [-d | -D] [-o OUTFILE] INFILE [CPP-OPTIONS ...] -# -# Process INFILE using the C pre-processor and some other programs. -# Write output to a file named OUTFILE or to the standard output when no -# OUTFILE has been specified or when OUTFILE is "-". -# -# If there are errors during processing, delete OUTFILE and exit with -# non-zero status. -# +# Usage: guile-snarf [-o OUTFILE] [CPP-ARGS ...] + +# Initialization actions are extracted to OUTFILE or to standard +# output when no OUTFILE has been specified or when OUTFILE is "-". +# The C preprocessor is called with CPP-ARGS (which usually include a +# input file) and the output is filtered for the actions. +# +# If there are errors during processing, OUTFILE is deleted and the +# program exits with non-zero status. +# # During snarfing, the pre-processor macro SCM_MAGIC_SNARFER is -# defined. -# -# Optional arg "-d" means grep INFILE for deprecated macros and -# issue a warning if any are found. Alternatively, "-D" means -# do the same thing but signal error and exit w/ non-zero status. -# -# If env var CPP is set, use its value instead of the C pre-processor -# determined at Guile configure-time: "@CPP@". +# defined. You can use this to avoid including snarfer output files +# that don't yet exist by writing code like this: +# +# #ifndef SCM_MAGIC_SNARFER +# #include "foo.x" +# #endif +# +# If the environment variable CPP is set, use its value instead of the +# C pre-processor determined at Guile configure-time: "@CPP@". # Code: -## config - -deprecated_list=" - SCM_CONST_LONG - SCM_VCELL - SCM_VCELL_INIT - SCM_GLOBAL_VCELL - SCM_GLOBAL_VCELL_INIT -" - ## funcs modern_snarf () # writes stdout { ## Apparently, AIX's preprocessor is unhappy if you try to #include an ## empty file. - echo "/* source: $infile */" ; echo "/* cpp arguments: $@ */" ; ${cpp} -DSCM_MAGIC_SNARF_INITS -DSCM_MAGIC_SNARFER "$@" > ${temp} && cpp_ok_p=true grep "^ *\^ *\^" ${temp} | sed -e "s/^ *\^ *\^//" -e "s/\^\ *:\ *\^.*/;/" } -grep_deprecated () # $1 is the filename -{ -regexp="(^greetings!spooks!hows!life)" -for dep in `echo $deprecated_list` ; do - regexp="(^${dep}[^_A-Z])|${regexp}" -done -egrep -n ${regexp} $1 /dev/null > ${temp} -if [ -s ${temp} ] ; then - if $grep_dep_exit_p ; then hey=ERROR ; else hey=WARNING ; fi - echo $0: $hey: deprecated macros found: - sed -e 's/.clean.c:/:/g' ${temp} - $grep_dep_exit_p && exit 1 -fi -} - ## main # process command line @@ -86,18 +62,11 @@ if [ x"$1" = x--help ] ; then | sed -e 1,2d -e 's/^. *//g' exit 0 fi -case x"$1" in x-d) grep_dep_p=true ; grep_dep_exit_p=false ; shift ;; - x-D) grep_dep_p=true ; grep_dep_exit_p=true ; shift ;; - *) grep_dep_p=false ;; -esac if [ x"$1" = x-o ] - then outfile=$2 ; shift ; shift ; infile=$1 ; shift - else outfile="-"; infile=$1 ; shift + then outfile="$2" ; shift ; shift ; + else outfile="-" ; fi -[ x"$infile" = x ] && { echo $0: No input file ; exit 1 ; } -[ ! -f "$infile" ] && { echo $0: No such file: $infile ; exit 1 ; } - # set vars and handler -- handle CPP override cpp_ok_p=false temp="/tmp/snarf.$$" @@ -105,15 +74,12 @@ if [ x"$CPP" = x ] ; then cpp="@CPP@" ; else cpp="$CPP" ; fi trap "rm -f $temp" 0 1 2 15 -if [ ! "$outfile" = "-" ]; then - modern_snarf "$@" $infile > $outfile +if [ ! "$outfile" = "-" ] ; then + modern_snarf "$@" > $outfile else - modern_snarf "$@" $infile + modern_snarf "$@" fi -# grep deprecated -$grep_dep_p && grep_deprecated $infile - # zonk outfile if errors occurred if $cpp_ok_p ; then exit 0 From 094489c62306d3d4ba2c690244ba0e5eabff64c6 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Aug 2002 00:54:37 +0000 Subject: [PATCH 126/306] (EXTRA_DIST): Added arm.h and arm.s. --- qt/md/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qt/md/Makefile.am b/qt/md/Makefile.am index 46fffd152..aee320ff7 100644 --- a/qt/md/Makefile.am +++ b/qt/md/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998 Free Software Foundation, Inc. +## Copyright (C) 1998, 2002 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -27,4 +27,4 @@ hppa-cnx.Makefile hppa.Makefile hppa.h hppa.s hppa_b.s i386.README \ i386.h i386.s i386_b.s ksr1.Makefile ksr1.h ksr1.s ksr1_b.s \ m88k.Makefile m88k.c m88k.h m88k.s m88k_b.s mips-irix5.s mips.h mips.s \ mips_b.s null.README null.c solaris.README sparc.h sparc.s sparc_b.s \ -vax.h vax.s vax_b.s i386.asm +vax.h vax.s vax_b.s i386.asm arm.h arm.s From d19c97670e4ef2be8c68a58bbd193202be47d1b8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Aug 2002 00:55:50 +0000 Subject: [PATCH 127/306] Check for __libc_stack_end. --- configure.in | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/configure.in b/configure.in index 01f1a1b5a..0b459bcba 100644 --- a/configure.in +++ b/configure.in @@ -1,7 +1,7 @@ dnl configuration script for Guile dnl Process this file with autoconf to produce configure. dnl -dnl Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +dnl Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. dnl dnl This file is part of GUILE dnl @@ -368,6 +368,18 @@ AC_CHECK_FUNCS(sethostent gethostent endhostent dnl inet_lnaof inet_makeaddr inet_netof hstrerror dnl inet_pton inet_ntop) +AC_MSG_CHECKING(for __libc_stack_end) +AC_TRY_LINK([extern char *__libc_stack_end;], + [char *p = __libc_stack_end;], + have_libc_stack_end=yes, + have_libc_stack_end=no) +AC_MSG_RESULT($have_libc_stack_end) + +if test $have_libc_stack_end = yes; then + AC_DEFINE(HAVE_LIBC_STACK_END, 1, + [Define if you have the __libc_stack_end variable.]) +fi + dnl Some systems do not declare this. Some systems do declare it, as a dnl macro. With cygwin it may be in a DLL. From 8cbb63c795b3f3b9d1565eec08e3433aca7dab4f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Aug 2002 00:57:14 +0000 Subject: [PATCH 128/306] When we have __libc_stack_end, use that directly instead the old tricks. --- libguile/gc_os_dep.c | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/libguile/gc_os_dep.c b/libguile/gc_os_dep.c index 0e387f029..4f766bede 100644 --- a/libguile/gc_os_dep.c +++ b/libguile/gc_os_dep.c @@ -3,7 +3,7 @@ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved. * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved. * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved. - * Copyright (c) 2000, 2001 Free Software Foundation + * Copyright (c) 2000, 2001, 2002 Free Software Foundation * * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED * OR IMPLIED. ANY USE IS AT YOUR OWN RISK. @@ -23,6 +23,19 @@ #include #include "libguile/gc.h" +#include "libguile/scmconfig.h" + +#ifdef HAVE_LIBC_STACK_END + +extern void *__libc_stack_end; + +void * +scm_get_stack_base () +{ + return __libc_stack_end; +} + +#else #define ABORT(msg) abort () @@ -1882,3 +1895,5 @@ void *scm_get_stack_base() # endif /* ! AMIGA */ # endif /* ! OS2 */ # endif /* ! MSWIN32 */ + +#endif /* ! HAVE_LIBC_STACK_END */ From f800ebfb009477bfeb9773be87bf131065595b91 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Aug 2002 00:57:47 +0000 Subject: [PATCH 129/306] *** empty log message *** --- ChangeLog | 4 ++++ libguile/ChangeLog | 9 +++++++++ qt/ChangeLog | 4 ++++ 3 files changed, 17 insertions(+) diff --git a/ChangeLog b/ChangeLog index 26554f651..a7cc991c2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2002-08-24 Marius Vollmer + + * configure.in: Check for __libc_stack_end. + 2002-08-05 Han-Wen Nienhuys * configure.in: add snprintf diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c0236c4e5..ebceef8a8 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,12 @@ +2002-08-24 Marius Vollmer + + * gc_os_dep.c: When we have __libc_stack_end, use that directly + instead the old tricks. + + * guile-snarf.in: Do not expect the input file to be the first + argument after the optional "-o" option, just pass everything to + the pre-processor without extracting the input file name. + 2002-08-23 Han-Wen Nienhuys * gc-segment.c (scm_i_get_new_heap_segment): Oops. We want segment diff --git a/qt/ChangeLog b/qt/ChangeLog index bc8f36856..96a61fde7 100644 --- a/qt/ChangeLog +++ b/qt/ChangeLog @@ -1,3 +1,7 @@ +2002-08-24 Marius Vollmer + + * md/Makefile.am (EXTRA_DIST): Added arm.h and arm.s. + 2002-07-17 Marius Vollmer * arm.s, arm.h: New. From bd9e426845f658ba70ad1fe25ef4986d4ac6add8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Aug 2002 01:08:56 +0000 Subject: [PATCH 130/306] (EXTRA_DIST): Do not distribute guile-api.alist, it can't be built currently. --- doc/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/Makefile.am b/doc/Makefile.am index 708899fe0..3b05f453a 100644 --- a/doc/Makefile.am +++ b/doc/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998 Free Software Foundation, Inc. +## Copyright (C) 1998, 2002 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -38,7 +38,7 @@ dist-hook: cp $(srcdir)/example-smob/$$f $(distdir)/example-smob/; \ done -EXTRA_DIST = groupings.alist guile-api.alist +EXTRA_DIST = groupings.alist # guile-api.alist # pending the papers from Robert Merkel # EXTRA_DIST = guile.1 From e99730fcc5b3cbc6548370007b4b492064f523ee Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Aug 2002 01:09:35 +0000 Subject: [PATCH 131/306] *** empty log message *** --- doc/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 6d496a88e..38a0e4599 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,3 +1,8 @@ +2002-08-24 Marius Vollmer + + * Makefile.am (EXTRA_DIST): Do not distribute guile-api.alist, it + can't be built currently. + 2002-05-13 Thien-Thi Nguyen * Makefile.am (EXTRA_DIST): New var. From 38d1262ab56f9c35965d94dced854162a993f6dd Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 25 Aug 2002 15:26:14 +0000 Subject: [PATCH 132/306] (scm_i_get_new_heap_segment): use float in stead of unsigned numbers for computing minimum heap increment. This prevents weird results when a a negative minimum increment is computed. --- libguile/ChangeLog | 7 +++++++ libguile/gc-segment.c | 21 +++++---------------- 2 files changed, 12 insertions(+), 16 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index ebceef8a8..9d09806e5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,10 @@ +2002-08-25 Han-Wen Nienhuys + + * gc-segment.c (scm_i_get_new_heap_segment): use float in stead of + unsigned numbers for computing minimum heap increment. This + prevents weird results when a a negative minimum increment is + computed. + 2002-08-24 Marius Vollmer * gc_os_dep.c: When we have __libc_stack_end, use that directly diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 53c02cd3a..bb2c3afa0 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -469,11 +469,6 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro abort (); } - - /* Pick a size for the new heap segment. - * The rule for picking the size of a segment is explained in - * gc.h - */ { /* Assure that the new segment is predicted to be large enough. * @@ -488,13 +483,10 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro * * This gives dh > (f * h - y) / (1 - f) */ - - /* - where is is this explanation supposed to be? --hwn - */ - int f = freelist->min_yield_fraction; - unsigned long h = SCM_HEAP_SIZE; - size_t min_cells = (f * h - 100 * (long) scm_gc_cells_collected) / (99 - f); + float f = freelist->min_yield_fraction / 100.0; + float h = SCM_HEAP_SIZE; + float min_cells + = (f * h - scm_gc_cells_collected) / (1.0 - f); /* Make heap grow with factor 1.5 */ len = freelist->heap_size / 2; @@ -502,11 +494,8 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells); #endif - /* - Original code adds freelist->cluster_size here. - */ if (len < min_cells) - len = min_cells; + len = (unsigned long) min_cells; len *= sizeof (scm_t_cell); /* force new sampling */ freelist->collected = LONG_MAX; From e62b37a0a3f2e3a9d5408139c856696352fb8070 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 26 Aug 2002 21:46:22 +0000 Subject: [PATCH 133/306] =?UTF-8?q?(scm=5Fcompile=5Fshell=5Fswitches):=20A?= =?UTF-8?q?dded=20"2002"=20to=20Copyright=20years.=20=20Thanks=20to=20Mart?= =?UTF-8?q?in=20Grabm=C3=BCller!?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- libguile/script.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/script.c b/libguile/script.c index 6e328523a..dfbe74d13 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc. * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) @@ -595,7 +595,7 @@ scm_compile_shell_switches (int argc, char **argv) { /* Print version number. */ printf ("Guile %s\n" - "Copyright (c) 1995, 1996, 1997, 2000, 2001 Free Software Foundation\n" + "Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002 Free Software Foundation\n" "Guile may be distributed under the terms of the GNU General Public Licence;\n" "certain other uses are permitted as well. For details, see the file\n" "`COPYING', which is included in the Guile distribution.\n" From 1964755626f73b242027e0714daa436fa9c9200c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 26 Aug 2002 21:46:43 +0000 Subject: [PATCH 134/306] *** empty log message *** --- libguile/ChangeLog | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 9d09806e5..5ddecadc7 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-08-26 Marius Vollmer + + * script.c (scm_compile_shell_switches): Added "2002" to Copyright + years. Thanks to Martin Grabmüller! + 2002-08-25 Han-Wen Nienhuys * gc-segment.c (scm_i_get_new_heap_segment): use float in stead of @@ -8,7 +13,7 @@ 2002-08-24 Marius Vollmer * gc_os_dep.c: When we have __libc_stack_end, use that directly - instead the old tricks. + instead of the old tricks. * guile-snarf.in: Do not expect the input file to be the first argument after the optional "-o" option, just pass everything to From 9981de3a2b069e990f99d9cf3a225d77fc02f418 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Tue, 27 Aug 2002 10:58:01 +0000 Subject: [PATCH 135/306] prepend libguile/ to include path --- libguile/ChangeLog | 4 ++++ libguile/eval.h | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5ddecadc7..2424d5fb2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-08-27 Han-Wen Nienhuys + + * eval.h: prepend libguile/ to include path + 2002-08-26 Marius Vollmer * script.c (scm_compile_shell_switches): Added "2002" to Copyright diff --git a/libguile/eval.h b/libguile/eval.h index 53e0a8315..6315fe4aa 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -48,7 +48,7 @@ #include "libguile/__scm.h" -#include "struct.h" +#include "libguile/struct.h" From 390e4d9d933db1746515a095c9daaa6b88d53b2a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 27 Aug 2002 17:40:10 +0000 Subject: [PATCH 136/306] Markup fixes and removal f gh_ references. Thanks to Dale Smith! --- doc/ref/scheme-modules.texi | 70 +++++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 30 deletions(-) diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index bc9aaa0b8..460891060 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -151,7 +151,7 @@ of symbols (names) to Scheme objects. An environment is a mapping from identifiers (or symbols) to locations, i.e., a set of bindings. There are top-level environments and lexical environments. -Environment in which a lambda is excuted is remembered as part of its +The environment in which a lambda is executed is remembered as part of its definition. Within a module, all bindings are visible. Certain bindings @@ -496,55 +496,55 @@ The following procedures are available. Return the module that is the @emph{current module}. @end deftypefn -@deftypefn {C Procedure} SCM scm_set_current_module (SCM module) +@deftypefn {C Procedure} SCM scm_set_current_module (SCM @var{module}) Set the current module to @var{module} and return the previous current module. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_call_with_current_module (SCM module, SCM (*func)(void *), void *data) +@deftypefn {C Procedure} SCM scm_c_call_with_current_module (SCM @var{module}, SCM (*@var{func})(void *), void *@var{data}) Call @var{func} and make @var{module} the current module during the call. The argument @var{data} is passed to @var{func}. The return value of @code{scm_c_call_with_current_module} is the return value of @var{func}. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_lookup (const char *name) +@deftypefn {C Procedure} SCM scm_c_lookup (const char *@var{name}) Return the variable bound to the symbol indicated by @var{name} in the current module. If there is no such binding or the symbol is not bound to a variable, signal an error. @end deftypefn -@deftypefn {C Procedure} SCM scm_lookup (SCM name) +@deftypefn {C Procedure} SCM scm_lookup (SCM @var{name}) Like @code{scm_c_lookup}, but the symbol is specified directly. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_module_lookup (SCM module, const char *name) -@deftypefnx {C Procedure} SCM scm_module_lookup (SCM module, SCM name) +@deftypefn {C Procedure} SCM scm_c_module_lookup (SCM @var{module}, const char *@var{name}) +@deftypefnx {C Procedure} SCM scm_module_lookup (SCM @var{module}, SCM @var{name}) Like @code{scm_c_lookup} and @code{scm_lookup}, but the specified module is used instead of the current one. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_define (const char *name, SCM val) +@deftypefn {C Procedure} SCM scm_c_define (const char *@var{name}, SCM @var{val}) Bind the symbol indicated by @var{name} to a variable in the current module and set that variable to @var{val}. When @var{name} is already bound to a variable, use that. Else create a new variable. @end deftypefn -@deftypefn {C Procedure} SCM scm_define (SCM name, SCM val) +@deftypefn {C Procedure} SCM scm_define (SCM @var{name}, SCM @var{val}) Like @code{scm_c_define}, but the symbol is specified directly. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_module_define (SCM module, const char *name, SCM val) -@deftypefnx {C Procedure} SCM scm_module_define (SCM module, SCM name, SCM val) +@deftypefn {C Procedure} SCM scm_c_module_define (SCM @var{module}, const char *@var{name}, SCM @var{val}) +@deftypefnx {C Procedure} SCM scm_module_define (SCM @var{module}, SCM @var{name}, SCM @var{val}) Like @code{scm_c_define} and @code{scm_define}, but the specified module is used instead of the current one. @end deftypefn -@deftypefn {C Procedure} SCM scm_module_reverse_lookup (SCM module, SCM variable) +@deftypefn {C Procedure} SCM scm_module_reverse_lookup (SCM @var{module}, SCM @var{variable}) Find the symbol that is bound to @var{variable} in @var{module}. When no such binding is found, return @var{#f}. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_define_module (const char *name, void (*init)(void *), void *data) +@deftypefn {C Procedure} SCM scm_c_define_module (const char *@var{name}, void (*@var{init})(void *), void *@var{data}) Define a new module named @var{name} and make it current while @var{init} is called, passing it @var{data}. Return the module. @@ -556,25 +556,25 @@ When there already exists a module named @var{name}, it is used unchanged, otherwise, an empty module is created. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_resolve_module (const char *name) +@deftypefn {C Procedure} SCM scm_c_resolve_module (const char *@var{name}) Find the module name @var{name} and return it. When it has not already been defined, try to auto-load it. When it can't be found that way either, create an empty module. The name is interpreted as for @code{scm_c_define_module}. @end deftypefn -@deftypefn {C Procedure} SCM scm_resolve_module (SCM name) +@deftypefn {C Procedure} SCM scm_resolve_module (SCM @var{name}) Like @code{scm_c_resolve_module}, but the name is given as a real list of symbols. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_use_module (const char *name) +@deftypefn {C Procedure} SCM scm_c_use_module (const char *@var{name}) Add the module named @var{name} to the uses list of the current module, as with @code{(use-modules @var{name})}. The name is interpreted as for @code{scm_c_define_module}. @end deftypefn -@deftypefn {C Procedure} SCM scm_c_export (const char *name, ...) +@deftypefn {C Procedure} SCM scm_c_export (const char *@var{name}, ...) Add the bindings designated by @var{name}, ... to the public interface of the current module. The list of names is terminated by @code{NULL}. @@ -607,7 +607,7 @@ to explicitly take advantage of it from within his program? Of course, many operating systems that support shared libraries do just that, and chances are that Guile will allow you to access this feature from within your Scheme programs. As you might have guessed already, this feature -is called @dfn{dynamic linking}@footnote{Some people also refer to the +is called @dfn{dynamic linking}.@footnote{Some people also refer to the final linking stage at program startup as `dynamic linking', so if you want to make yourself perfectly clear, it is probably best to use the more technical term @dfn{dlopening}, as suggested by Gordon Matzigkeit @@ -805,18 +805,18 @@ example, we will only implement this for the @code{j0} function. @smallexample #include -#include +#include SCM j0_wrapper (SCM x) @{ - return gh_double2scm (j0 (gh_scm2double (x))); + return scm_double2num (j0 (scm_num2dbl (x, "j0"))); @} void init_math_bessel () @{ - gh_new_procedure1_0 ("j0", j0_wrapper); + scm_c_define_gsubr ("j0", 1, 0, 0, j0_wrapper); @} @end smallexample @@ -851,24 +851,33 @@ Fun, isn't it? But we are only half way there. This is what @code{apropos} has to say about @code{j0}: @smallexample -(apropos 'j0) -@print{} the-root-module: j0 # +(apropos "j0") +@print{} (guile-user): j0 # @end smallexample As you can see, @code{j0} is contained in the root module, where all the other Guile primitives like @code{display}, etc live. In general, a primitive is put into whatever module is the @dfn{current module} at -the time @code{gh_new_procedure} is called. +the time @code{scm_c_define_gsubr} is called. A compiled module should have a specially named @dfn{module init function}. Guile knows about this special name and will call that function automatically after having linked in the shared library. For -our example, we add the following code to @file{bessel.c}: +our example, we replace @code{init_math_bessel} with the following code in +@file{bessel.c}: @smallexample -void scm_init_math_bessel_module () +void +init_math_bessel (void *unused) @{ - /* contents currently unavailable. */ + scm_c_define_gsubr ("j0", 1, 0, 0, j0_wrapper); + scm_c_export ("j0", NULL); +@} + +void +scm_init_math_bessel_module () +@{ + scm_c_define_module ("math bessel", init_math_bessel, NULL); @} @end smallexample @@ -877,18 +886,19 @@ The general pattern for the name of a module init function is: individual hierarchical components are concatenated with underscores, followed by @samp{_module}. -After @file{libbessel.so} has been rebuild, we need to place the shared +After @file{libbessel.so} has been rebuilt, we need to place the shared library into the right place. Once the module has been correctly installed, it should be possible to use it like this: @smallexample +guile> (load-extension "./libbessel.so" "scm_init_math_bessel_module") guile> (use-modules (math bessel)) guile> (j0 2) 0.223890779141236 -guile> (apropos 'j0) -@print{} bessel: j0 # +guile> (apropos "j0") +@print{} (math bessel): j0 # @end smallexample That's it! From 44ecca617249293baee2a3ac6dd573befb912ab3 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 27 Aug 2002 17:40:24 +0000 Subject: [PATCH 137/306] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 60de2f380..3ff16c44a 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-08-27 Marius Vollmer + + * scheme-modules.texi: Markup fixes and removal f gh_ references. + Thanks to Dale Smith! + 2002-08-14 Marius Vollmer * scheme-evaluation.texi (eval-string): Updated. From 7200a36b83f0dc9faa846776ad4e6804b8c5da96 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 28 Aug 2002 22:45:48 +0000 Subject: [PATCH 138/306] (scm_make_real): prevent reordering of statements --- libguile/ChangeLog | 4 ++++ libguile/numbers.c | 7 +++++++ 2 files changed, 11 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2424d5fb2..525562c39 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-08-29 Han-Wen Nienhuys + + * numbers.c (scm_make_real): prevent reordering of statements + 2002-08-27 Han-Wen Nienhuys * eval.h: prepend libguile/ to include path diff --git a/libguile/numbers.c b/libguile/numbers.c index 53a40a0bd..ebdacdc8f 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -3015,6 +3015,13 @@ scm_make_real (double x) { SCM z; z = scm_double_cell (scm_tc16_real, 0, 0, 0); + + /* + scm_double_cell is inlined. strict C aliasing rules say that it's + OK to interchange the initialization above and the one below. We + don't want that, of course. + */ + scm_remember_1 (z); SCM_REAL_VALUE (z) = x; return z; } From 8fa5786d7c10e8ee657aad8bf24ec5f229c5258e Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 28 Aug 2002 22:50:32 +0000 Subject: [PATCH 139/306] (scm_make_real): prevent reordering of statements num2float.i.c (FLOAT2NUM): idem --- libguile/ChangeLog | 1 + libguile/num2float.i.c | 4 ++++ libguile/numbers.c | 2 +- 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 525562c39..c0430a5b2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,6 +1,7 @@ 2002-08-29 Han-Wen Nienhuys * numbers.c (scm_make_real): prevent reordering of statements + num2float.i.c (FLOAT2NUM): idem 2002-08-27 Han-Wen Nienhuys diff --git a/libguile/num2float.i.c b/libguile/num2float.i.c index b393ba9b7..5fd9180c7 100644 --- a/libguile/num2float.i.c +++ b/libguile/num2float.i.c @@ -33,6 +33,10 @@ FLOAT2NUM (FTYPE n) { SCM z; z = scm_double_cell (scm_tc16_real, 0, 0, 0); + /* + See scm_make_real(). + */ + scm_remember_upto_here_1 (z); SCM_REAL_VALUE (z) = n; return z; } diff --git a/libguile/numbers.c b/libguile/numbers.c index ebdacdc8f..8393c62ca 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -3021,7 +3021,7 @@ scm_make_real (double x) OK to interchange the initialization above and the one below. We don't want that, of course. */ - scm_remember_1 (z); + scm_remember_upto_here_1 (z); SCM_REAL_VALUE (z) = x; return z; } From 1383773ba1e50b1c13bc4f4f3d5f0b69de07b5dd Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 28 Aug 2002 23:13:30 +0000 Subject: [PATCH 140/306] * gc.h: remove DOUBLECELL card flags. * gc-malloc.c (scm_calloc): try to use calloc() before calling scm_realloc(). * gc-segment.c (scm_i_initialize_heap_segment_data): remove card init loop; handle this from scm_init_card_freelist() * gc-card.c (scm_init_card_freelist): init bit vector here. --- libguile/ChangeLog | 10 ++++++++++ libguile/gc-card.c | 15 ++++++++++++--- libguile/gc-malloc.c | 12 +++++++++++- libguile/gc-segment.c | 36 +++++++++--------------------------- libguile/gc.h | 8 ++++---- libguile/private-gc.h | 10 +++++++--- 6 files changed, 53 insertions(+), 38 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c0430a5b2..788233eeb 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,15 @@ 2002-08-29 Han-Wen Nienhuys + * gc.h: remove DOUBLECELL card flags. + + * gc-malloc.c (scm_calloc): try to use calloc() before calling + scm_realloc(). + + * gc-segment.c (scm_i_initialize_heap_segment_data): remove card + init loop; handle this from scm_init_card_freelist() + + * gc-card.c (scm_init_card_freelist): init bit vector here. + * numbers.c (scm_make_real): prevent reordering of statements num2float.i.c (FLOAT2NUM): idem diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 5eb6d814e..f9c9c7d7d 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -80,11 +80,12 @@ long int scm_i_deprecated_memory_return; */ int -scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) +scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) #define FUNC_NAME "sweep_card" { scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p); scm_t_cell * end = p + SCM_GC_CARD_N_CELLS; + int span = seg->span; int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); int free_count = 0; @@ -294,11 +295,19 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) Like sweep, but no complicated logic to do the sweeping. */ int -scm_init_card_freelist (scm_t_cell * card, SCM *free_list, int span) +scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list, + scm_t_heap_segment*seg) { + int span = seg->span; scm_t_cell *end = card + SCM_GC_CARD_N_CELLS; scm_t_cell *p = end - span; + scm_t_c_bvec_long * bvec_ptr = (scm_t_c_bvec_long* ) seg->bounds[1]; + int idx = (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; + + bvec_ptr += idx *SCM_GC_CARD_BVEC_SIZE_IN_LONGS; + SCM_GC_CELL_BVEC (card) = bvec_ptr; + /* ASSUMPTION: n_header_cells <= 2. */ @@ -318,7 +327,7 @@ scm_init_card_freelist (scm_t_cell * card, SCM *free_list, int span) /* These functions are meant to be called from GDB as a debug aid. - I've left them as a convenience for future generations. + I've left them as a convenience for future generations. --hwn. */ diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 0cd6bfaad..1dbb448f1 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -150,7 +150,17 @@ scm_malloc (size_t sz) void * scm_calloc (size_t sz) { - void * ptr = scm_realloc (NULL, sz); + void * ptr; + + /* + By default, try to use calloc, as it is likely more efficient than + calling memset by hand. + */ + SCM_SYSCALL(ptr= calloc (sz, 1)); + if (ptr) + return ptr; + + ptr = scm_realloc (NULL, sz); memset (ptr, 0x0, sz); return ptr; } diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index bb2c3afa0..2cdbef2aa 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -50,10 +50,6 @@ -#define SCM_GC_CARD_BVEC_SIZE_IN_LONGS \ - ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LONG_BITS - 1) / SCM_C_BVEC_LONG_BITS) -#define SCM_GC_IN_CARD_HEADERP(x) \ - (scm_t_cell *) (x) < SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS size_t scm_max_segment_size; @@ -120,25 +116,11 @@ scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t request bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1]; - - { - scm_t_cell * ptr = segment->bounds [0]; - - for (; - ptr < segment->bounds[1]; ptr += SCM_GC_CARD_N_CELLS) - { - SCM_GC_CELL_BVEC (ptr) = bvec_ptr; - if (segment->span == 2) - SCM_GC_SET_CARD_DOUBLECELL (ptr); - - bvec_ptr += SCM_GC_CARD_BVEC_SIZE_IN_LONGS; - - /* - Don't init the mem. This is handled by lazy sweeping. - */ - } - } - + /* + Don't init the mem or the bitvector. This is handled by lazy + sweeping. + */ + segment->next_free_card = segment->bounds[0]; segment->first_time = 1; return 1; @@ -180,15 +162,15 @@ scm_i_sweep_some_cards (scm_t_heap_segment *seg) SCM cells = SCM_EOL; int threshold = 512; int collected = 0; - int (*sweeper) (scm_t_cell *, SCM *, int ) - = (seg->first_time) ? &scm_init_card_freelist : &scm_i_sweep_card; + int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment* ) + = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card; scm_t_cell * next_free = seg->next_free_card; int cards_swept = 0; while (collected < threshold && next_free < seg->bounds[1]) { - collected += (*sweeper) (next_free, &cells, seg->span); + collected += (*sweeper) (next_free, &cells, seg); next_free += SCM_GC_CARD_N_CELLS; cards_swept ++; } @@ -438,7 +420,7 @@ scm_i_find_heap_segment_containing_object (SCM obj) } } - if (!DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2) + if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2) return -1; else if (SCM_GC_IN_CARD_HEADERP (ptr)) return -1; diff --git a/libguile/gc.h b/libguile/gc.h index 7388d5e42..06f4eee0f 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -107,10 +107,10 @@ typedef struct scm_t_cell #define SCM_GC_CLEAR_CARD_FLAG(card, shift) \ (SCM_GC_SET_CARD_FLAGS (card, SCM_GC_GET_CARD_FLAGS(card) & ~(1L << (shift)))) -#define SCM_GC_CARDF_DOUBLECELL 0 - -#define SCM_GC_CARD_DOUBLECELLP(card) SCM_GC_GET_CARD_FLAG (card, SCM_GC_CARDF_DOUBLECELL) -#define SCM_GC_SET_CARD_DOUBLECELL(card) SCM_GC_SET_CARD_FLAG (card, SCM_GC_CARDF_DOUBLECELL) +/* + Remove card flags. They hamper lazy initialization, and aren't used + anyways. + */ /* card addressing. for efficiency, cards are *always* aligned to SCM_GC_CARD_SIZE. */ diff --git a/libguile/private-gc.h b/libguile/private-gc.h index f5acd9450..e9c170f12 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -63,9 +63,13 @@ #define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell)) -#define DOUBLECELL_ALIGNED_P(x) (((2 * sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0) +#define SCM_DOUBLECELL_ALIGNED_P(x) (((2 * sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0) +#define SCM_GC_CARD_BVEC_SIZE_IN_LONGS \ + ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LONG_BITS - 1) / SCM_C_BVEC_LONG_BITS) +#define SCM_GC_IN_CARD_HEADERP(x) \ + (scm_t_cell *) (x) < SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS int scm_getenv_int (const char *var, int def); @@ -204,8 +208,8 @@ extern scm_t_heap_segment ** scm_i_heap_segment_table; extern size_t scm_i_heap_segment_table_size; -int scm_init_card_freelist (scm_t_cell * card, SCM *free_list,int); -int scm_i_sweep_card (scm_t_cell * card, SCM *free_list,int); +int scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,scm_t_heap_segment*); +int scm_i_sweep_card (scm_t_cell * card, SCM *free_list, scm_t_heap_segment*); int scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested); int scm_i_segment_card_count (scm_t_heap_segment * seg); int scm_i_segment_cell_count (scm_t_heap_segment * seg); From aca23b65b47c6a38bf27c8150797479ac7efdbca Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 30 Aug 2002 21:57:10 +0000 Subject: [PATCH 141/306] (scm_addr_vector): Added size of address to arguments. Use it to avoid accessing a non-existent path in a sockaddr_un. Changed all callers. --- libguile/socket.c | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/libguile/socket.c b/libguile/socket.c index 86d01f3c5..7e450a1a9 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996,1997,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -922,7 +922,8 @@ SCM_DEFINE (scm_listen, "listen", 2, 0, 0, /* Put the components of a sockaddr into a new SCM vector. */ static SCM -scm_addr_vector (const struct sockaddr *address, const char *proc) +scm_addr_vector (const struct sockaddr *address, int addr_size, + const char *proc) { short int fam = address->sa_family; SCM result =SCM_EOL; @@ -967,7 +968,13 @@ scm_addr_vector (const struct sockaddr *address, const char *proc) result = scm_c_make_vector (2, SCM_UNSPECIFIED); SCM_VECTOR_SET(result, 0, scm_ulong2num ((unsigned long) fam)); - SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path))); + /* When addr_size is not enough to cover sun_path, do not try + to access it. */ + if (addr_size <= offsetof (struct sockaddr_un, sun_path)) + SCM_VECTOR_SET(result, 1, SCM_BOOL_F); + else + SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path, + strlen (nad->sun_path))); } break; #endif @@ -1028,7 +1035,7 @@ SCM_DEFINE (scm_accept, "accept", 1, 0, 0, if (newfd == -1) SCM_SYSERROR; newsock = SCM_SOCK_FD_TO_PORT (newfd); - address = scm_addr_vector (addr, FUNC_NAME); + address = scm_addr_vector (addr, addr_size, FUNC_NAME); return scm_cons (newsock, address); } #undef FUNC_NAME @@ -1050,7 +1057,7 @@ SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0, fd = SCM_FPORT_FDES (sock); if (getsockname (fd, addr, &addr_size) == -1) SCM_SYSERROR; - return scm_addr_vector (addr, FUNC_NAME); + return scm_addr_vector (addr, addr_size, FUNC_NAME); } #undef FUNC_NAME @@ -1072,7 +1079,7 @@ SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0, fd = SCM_FPORT_FDES (sock); if (getpeername (fd, addr, &addr_size) == -1) SCM_SYSERROR; - return scm_addr_vector (addr, FUNC_NAME); + return scm_addr_vector (addr, addr_size, FUNC_NAME); } #undef FUNC_NAME @@ -1199,7 +1206,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0, if (rv == -1) SCM_SYSERROR; if (addr->sa_family != AF_UNSPEC) - address = scm_addr_vector (addr, FUNC_NAME); + address = scm_addr_vector (addr, addr_size, FUNC_NAME); else address = SCM_BOOL_F; From f8a1712b11154c5bbdc015d052e76a1821c941fd Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 30 Aug 2002 21:57:38 +0000 Subject: [PATCH 142/306] *** empty log message *** --- libguile/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 788233eeb..57839a4df 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-08-30 Marius Vollmer + + * socket.c (scm_addr_vector): Added size of address to arguments. + Use it to avoid accessing a non-existent path in a sockaddr_un. + Changed all callers. + 2002-08-29 Han-Wen Nienhuys * gc.h: remove DOUBLECELL card flags. From 5527702a6513826e5ac3a47c8dcb283cebda5875 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 1 Sep 2002 16:19:18 +0000 Subject: [PATCH 143/306] (SCM_DEFINE_PUBLIC): New. --- libguile/snarf.h | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/libguile/snarf.h b/libguile/snarf.h index ac12f2bb9..50565bedd 100644 --- a/libguile/snarf.h +++ b/libguile/snarf.h @@ -3,7 +3,7 @@ #ifndef SCM_SNARF_H #define SCM_SNARF_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -108,6 +108,18 @@ scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ )\ SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) +#define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ +SCM_SNARF_HERE(\ +static const char s_ ## FNAME [] = PRIMNAME; \ +SCM FNAME ARGLIST\ +)\ +SCM_SNARF_INIT(\ +scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ + (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \ +scm_c_export (s_ ## FNAME, NULL); \ +)\ +SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) + #define SCM_DEFINE1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \ SCM_SNARF_HERE(\ static const char s_ ## FNAME [] = PRIMNAME; \ From ffd0ef3b7f53ffc8faa7c05a20546533c167b42a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 1 Sep 2002 16:20:02 +0000 Subject: [PATCH 144/306] *** empty log message *** --- NEWS | 11 ++++++++--- libguile/ChangeLog | 4 ++++ 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 25a081053..c05b1a25a 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,5 @@ Guile NEWS --- history of user-visible changes. -*- text -*- -Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. See the end for copying conditions. Please send Guile bug reports to bug-guile@gnu.org. @@ -103,9 +103,14 @@ during evaluation, but prior to evaluation. * Changes to the C interface +** New snarfer macro SCM_DEFINE_PUBLIC. + +This is like SCM_DEFINE, but also calls scm_c_export for the defined +function in the init section. + ** The SCM_VELTS macros now returns a read-only vector. For writing, -use the new macros SCM_WRITABLE_VELTS, SCM_SET_VECTOR_LENGTH. The use -of SCM_WRITABLE_VELTS is discouraged, though. +use the new macros SCM_WRITABLE_VELTS, SCM_VECTOR_SET. The use of +SCM_WRITABLE_VELTS is discouraged, though. ** Garbage collector rewrite. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 57839a4df..a3a90108a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-09-01 Marius Vollmer + + * snarf.h (SCM_DEFINE_PUBLIC): New. + 2002-08-30 Marius Vollmer * socket.c (scm_addr_vector): Added size of address to arguments. From 1f1270b96dc2e18272907809287c26b754179800 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 1 Sep 2002 16:29:06 +0000 Subject: [PATCH 145/306] (SCM_VECTOR_REF): New. --- libguile/vectors.h | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/libguile/vectors.h b/libguile/vectors.h index dda0c7612..4a8aecd5d 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -3,7 +3,7 @@ #ifndef SCM_VECTORS_H #define SCM_VECTORS_H -/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -61,7 +61,8 @@ #define SCM_VELTS(x) ((const SCM *) SCM_CELL_WORD_1 (x)) #define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_CELL_WORD_1 (x)) #define SCM_SETVELTS(x, v) (SCM_SET_CELL_WORD_1 ((x), (v))) -#define SCM_VECTOR_SET(x, idx, val) (((SCM*)SCM_CELL_WORD_1 (x))[(idx)] = (val)) +#define SCM_VECTOR_REF(x, idx) (((const SCM *) SCM_CELL_WORD_1 (x))[(idx)]) +#define SCM_VECTOR_SET(x, idx, val) (((SCM*)SCM_CELL_WORD_1 (x))[(idx)] = (val)) #define SCM_GC_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x)) From a27e3d1463770728e48d0a47339f779a11bf4c02 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 1 Sep 2002 16:29:35 +0000 Subject: [PATCH 146/306] *** empty log message *** --- libguile/ChangeLog | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index a3a90108a..10e45fce8 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,7 @@ 2002-09-01 Marius Vollmer + * vectors.h (SCM_VECTOR_REF): New. + * snarf.h (SCM_DEFINE_PUBLIC): New. 2002-08-30 Marius Vollmer From db3f1c7e61f8ea3d29ca6179f8ae4b2a3f1872a5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 4 Sep 2002 21:33:33 +0000 Subject: [PATCH 147/306] (expansion-eval-closure, env->eval-closure): New. (sc-macro): Set the expansion-eval-closure expanding the form. (putprop, getprop): Use the expansion-eval-closure to find variables instead of the current module. --- ice-9/syncase.scm | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/ice-9/syncase.scm b/ice-9/syncase.scm index 8d61bd120..fff3ca199 100644 --- a/ice-9/syncase.scm +++ b/ice-9/syncase.scm @@ -57,10 +57,20 @@ +(define expansion-eval-closure (make-fluid)) + +(define (env->eval-closure env) + (or (and env + (car (last-pair env))) + (module-eval-closure the-root-module))) + (define sc-macro (procedure->memoizing-macro (lambda (exp env) - (sc-expand exp)))) + (with-fluids ((expansion-eval-closure (env->eval-closure env))) + (sc-expand exp))))) + +(fluid-set! expansion-eval-closure (env->eval-closure #f)) ;;; Exported variables @@ -127,13 +137,12 @@ '()))) (define the-syncase-module (current-module)) +(define the-syncase-eval-closure (module-eval-closure the-syncase-module)) (define (putprop symbol key binding) - (let* ((m (current-module)) - (v (or (module-variable m symbol) - (module-make-local-var! m symbol)))) + (let* ((v ((fluid-ref expansion-eval-closure) symbol #t))) (if (symbol-property symbol 'primitive-syntax) - (if (eq? (current-module) the-syncase-module) + (if (eq? (fluid-ref expansion-eval-closure) the-syncase-eval-closure) (set-object-property! (module-variable the-root-module symbol) key binding)) @@ -141,8 +150,7 @@ (set-object-property! v key binding))) (define (getprop symbol key) - (let* ((m (current-module)) - (v (module-variable m symbol))) + (let* ((v ((fluid-ref expansion-eval-closure) symbol #f))) (and v (or (object-property v key) (let ((root-v (module-local-variable the-root-module symbol))) (and (equal? root-v v) From 719fb3f32155a9303ca64a5989a837daeae70a92 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 5 Sep 2002 17:51:58 +0000 Subject: [PATCH 148/306] Set the module transformer of the-syncase-module so that we can use define-syntax. (define-syntax-public): New and exported. --- ice-9/syncase.scm | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/ice-9/syncase.scm b/ice-9/syncase.scm index fff3ca199..dea7d615c 100644 --- a/ice-9/syncase.scm +++ b/ice-9/syncase.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1997, 2000, 2001, 2002 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -44,7 +44,8 @@ (define-module (ice-9 syncase) :use-module (ice-9 debug) :use-module (ice-9 threads) - :export-syntax (sc-macro define-syntax eval-when fluid-let-syntax + :export-syntax (sc-macro define-syntax define-syntax-public + eval-when fluid-let-syntax identifier-syntax let-syntax letrec-syntax syntax syntax-case syntax-rules with-syntax @@ -99,8 +100,8 @@ (define include sc-macro) (define primitive-syntax '(quote lambda letrec if set! begin define or - and let let* cond do quasiquote unquote - unquote-splicing case)) + and let let* cond do quasiquote unquote + unquote-splicing case)) (for-each (lambda (symbol) (set-symbol-property! symbol 'primitive-syntax #t)) @@ -237,3 +238,12 @@ '(define)))) (define syncase sc-expand) + +(set-module-transformer! the-syncase-module syncase) + +(define-syntax define-syntax-public + (syntax-rules () + ((_ name rules ...) + (begin + ;(eval-case ((load-toplevel) (export-syntax name))) + (define-syntax name rules ...))))) From cfcdb8e9a70757ca0121e44ee1498c827fbe5815 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 5 Sep 2002 17:52:14 +0000 Subject: [PATCH 149/306] *** empty log message *** --- ice-9/ChangeLog | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 18ef926ce..276b4f33f 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,16 @@ +2002-09-05 Marius Vollmer + + * syncase.scm: Set the module transformer of the-syncase-module so + that we can use define-syntax. + (define-syntax-public): New and exported. + +2002-09-04 Marius Vollmer + + * syncase.scm (expansion-eval-closure, env->eval-closure): New. + (sc-macro): Set the expansion-eval-closure expanding the form. + (putprop, getprop): Use the expansion-eval-closure to find + variables instead of the current module. + 2002-07-08 Marius Vollmer * slib.scm (make-exchanger): Added. Thanks to Clinton Ebadi! From 61ef9c1fa379e9682326d8ee32fc5ab1d08bf0e7 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 5 Sep 2002 20:43:43 +0000 Subject: [PATCH 150/306] add DEBUGINFO for mtrigger GCs. --- libguile/ChangeLog | 4 ++++ libguile/gc-malloc.c | 14 +++++++------- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 10e45fce8..80a2299c8 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-09-05 Han-Wen Nienhuys + + * gc-malloc.c: add DEBUGINFO for mtrigger GCs. + 2002-09-01 Marius Vollmer * vectors.h (SCM_VECTOR_REF): New. diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 1dbb448f1..7bf366b0d 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -95,6 +95,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #define SCM_DEFAULT_INIT_MALLOC_LIMIT 200*1024 #define SCM_DEFAULT_MALLOC_MINYIELD 40 +/* #define DEBUGINFO */ static int scm_i_minyield_malloc; @@ -207,11 +208,12 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) yield = (prev_alloced - scm_mallocated) / (float) prev_alloced; scm_gc_malloc_yield_percentage = (int) (100 * yield); - /* + +#ifdef DEBUGINFO fprintf (stderr, "prev %lud , now %lud, yield %4.2lf, want %d", prev_alloced, scm_mallocated, 100.0*yield, scm_i_minyield_malloc); - */ - +#endif + if (yield < scm_i_minyield_malloc / 100.0) { /* @@ -224,12 +226,10 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) */ scm_mtrigger = (scm_mallocated * 110) / (100 - scm_i_minyield_malloc); - /* +#ifdef DEBUGINFO fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n", scm_mtrigger); - */ +#endif } - - } #ifdef GUILE_DEBUG_MALLOC From 5bd4a949e87dce0abf8d140e2d9f2ca4ce808727 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 5 Sep 2002 20:47:35 +0000 Subject: [PATCH 151/306] include --- libguile/ChangeLog | 2 ++ libguile/gc-freelist.c | 1 + 2 files changed, 3 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 80a2299c8..8d984443f 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,7 @@ 2002-09-05 Han-Wen Nienhuys + * gc-freelist.c: include + * gc-malloc.c: add DEBUGINFO for mtrigger GCs. 2002-09-01 Marius Vollmer diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c index c885ceaf1..8425a6eea 100644 --- a/libguile/gc-freelist.c +++ b/libguile/gc-freelist.c @@ -40,6 +40,7 @@ * If you do not wish that, delete this exception notice. */ #include +#include #include "libguile/private-gc.h" #include "libguile/gc.h" From ffd724008bab4ee230af0a9210b19166b2c04f71 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 5 Sep 2002 21:12:21 +0000 Subject: [PATCH 152/306] * struct.h: change scm_structs_to_free to scm_i_structs_to_free * gc-malloc.c (scm_gc_register_collectable_memory): use floats; these won't ever wrap around with high memory usage. * gc-malloc.c: add DEBUGINFO for mtrigger GCs. --- libguile/ChangeLog | 5 +++++ libguile/gc-card.c | 9 +++++++-- libguile/gc-malloc.c | 6 ++++-- libguile/gc-segment.c | 13 ++++++++++++- libguile/gc.c | 15 +++++++++------ libguile/struct.c | 4 ++-- libguile/struct.h | 2 +- 7 files changed, 40 insertions(+), 14 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 8d984443f..d8eb34c4d 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,10 @@ 2002-09-05 Han-Wen Nienhuys + * struct.h: change scm_structs_to_free to scm_i_structs_to_free + + * gc-malloc.c (scm_gc_register_collectable_memory): use floats; + these won't ever wrap around with high memory usage. + * gc-freelist.c: include * gc-malloc.c: add DEBUGINFO for mtrigger GCs. diff --git a/libguile/gc-card.c b/libguile/gc-card.c index f9c9c7d7d..61bf5b2ad 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -68,6 +68,11 @@ long int scm_i_deprecated_memory_return; +/* During collection, this accumulates structures which are to be freed. + */ +SCM scm_i_structs_to_free; + + /* Init all the free cells in CARD, prepending to *FREE_LIST. @@ -109,8 +114,8 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) /* Structs need to be freed in a special order. * This is handled by GC C hooks in struct.c. */ - SCM_SET_STRUCT_GC_CHAIN (p, scm_structs_to_free); - scm_structs_to_free = scmptr; + SCM_SET_STRUCT_GC_CHAIN (p, scm_i_structs_to_free); + scm_i_structs_to_free = scmptr; } continue; diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 7bf366b0d..2f39db0da 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -200,13 +200,15 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) */ if (scm_mallocated > scm_mtrigger) { - long prev_alloced = scm_mallocated; + unsigned long prev_alloced = scm_mallocated; float yield; scm_igc (what); scm_i_sweep_all_segments("mtrigger"); - yield = (prev_alloced - scm_mallocated) / (float) prev_alloced; + yield = ((float)prev_alloced - (float) scm_mallocated) + / (float) prev_alloced; + scm_gc_malloc_yield_percentage = (int) (100 * yield); #ifdef DEBUGINFO diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 2cdbef2aa..ec0c2cf80 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -296,7 +296,7 @@ scm_i_insert_segment (scm_t_heap_segment * seg) highest_cell = SCM_MAX (highest_cell, seg->bounds[1]); } - + { int i = 0; int j = 0; @@ -304,6 +304,17 @@ scm_i_insert_segment (scm_t_heap_segment * seg) while (i < scm_i_heap_segment_table_size && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0]) i++; + + /* + We insert a new entry; if that happens to be before the + "current" segment of a freelist, we must move the freelist index + as well. + */ + if (scm_i_master_freelist.heap_segment_idx >= i) + scm_i_master_freelist.heap_segment_idx ++; + if (scm_i_master_freelist2.heap_segment_idx >= i) + scm_i_master_freelist2.heap_segment_idx ++; + for (j = scm_i_heap_segment_table_size; j > i; --j) scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1]; diff --git a/libguile/gc.c b/libguile/gc.c index fdc390e79..d5baf3cca 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -120,8 +120,6 @@ int scm_i_cell_validation_already_running ; periods. */ - - void scm_i_expensive_validation_check (SCM cell) { @@ -277,10 +275,6 @@ int scm_block_gc = 1; */ SCM scm_weak_vectors; -/* During collection, this accumulates structures which are to be freed. - */ -SCM scm_structs_to_free; - /* GC Statistics Keeping */ unsigned long scm_cells_allocated = 0; @@ -608,10 +602,19 @@ scm_igc (const char *what) scm_gc_sweep (); + + /* + TODO: this hook should probably be moved to just before the mark, + since that's where the sweep is finished in lazy sweeping. + */ scm_c_hook_run (&scm_after_sweep_c_hook, 0); gc_end_stats (); SCM_CRITICAL_SECTION_END; + + /* + See above. + */ scm_c_hook_run (&scm_after_gc_c_hook, 0); --scm_gc_running_p; diff --git a/libguile/struct.c b/libguile/struct.c index 308af78e7..c4f810260 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -360,7 +360,7 @@ scm_struct_gc_init (void *dummy1 SCM_UNUSED, void *dummy2 SCM_UNUSED, void *dummy3 SCM_UNUSED) { - scm_structs_to_free = SCM_EOL; + scm_i_structs_to_free = SCM_EOL; return 0; } @@ -369,7 +369,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED, void *dummy2 SCM_UNUSED, void *dummy3 SCM_UNUSED) { - SCM newchain = scm_structs_to_free; + SCM newchain = scm_i_structs_to_free; do { /* Mark vtables in GC chain. GC mark set means delay freeing. */ diff --git a/libguile/struct.h b/libguile/struct.h index 7c784b14d..5e4df9152 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -103,7 +103,7 @@ SCM_API SCM scm_struct_table; #define SCM_STRUCT_GC_CHAIN(X) SCM_CELL_OBJECT_3 (X) #define SCM_SET_STRUCT_GC_CHAIN(X, Y) SCM_SET_CELL_OBJECT_3 (X, Y) -SCM_API SCM scm_structs_to_free; +SCM_API SCM scm_i_structs_to_free; From dac04e9fb9fe0fcd39a375b57f8380e1798c7ef7 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 5 Sep 2002 21:55:33 +0000 Subject: [PATCH 153/306] * gc-segment.c (scm_i_make_initial_segment): check user settings for sanity. * gc-malloc.c (scm_gc_init_malloc): check user settings for sanity. (scm_gc_register_collectable_memory): prevent overflow of memory counts. * gc-freelist.c (scm_init_freelist): check user settings for sanity. * gc-malloc.c (scm_gc_register_collectable_memory): use floats; these won't ever wrap around with high memory usage. * gc-freelist.c: include * gc-malloc.c: add DEBUGINFO for mtrigger GCs. --- libguile/ChangeLog | 10 ++++++++++ libguile/gc-freelist.c | 16 +++++++++++----- libguile/gc-malloc.c | 13 ++++++++++++- libguile/gc-segment.c | 9 ++++++--- libguile/private-gc.h | 5 +++-- 5 files changed, 42 insertions(+), 11 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d8eb34c4d..7f722f3a9 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,15 @@ 2002-09-05 Han-Wen Nienhuys + * gc-segment.c (scm_i_make_initial_segment): check user settings + for sanity. + + * gc-malloc.c (scm_gc_init_malloc): check user settings for + sanity. + (scm_gc_register_collectable_memory): prevent overflow of memory + counts. + + * gc-freelist.c (scm_init_freelist): check user settings for sanity. + * struct.h: change scm_structs_to_free to scm_i_structs_to_free * gc-malloc.c (scm_gc_register_collectable_memory): use floats; diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c index 8425a6eea..1b9780531 100644 --- a/libguile/gc-freelist.c +++ b/libguile/gc-freelist.c @@ -138,6 +138,11 @@ scm_init_freelist (scm_t_cell_type_statistics *freelist, int span, int min_yield) { + if (min_yield < 1) + min_yield = 1; + if (min_yield > 99) + min_yield = 99; + freelist->heap_segment_idx = -1; freelist->min_yield = 0; freelist->min_yield_fraction = min_yield; @@ -158,10 +163,9 @@ scm_init_freelist (scm_t_cell_type_statistics *freelist, void scm_gc_init_freelist (void) { - size_t init_heap_size_1 + int init_heap_size_1 = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1); - - size_t init_heap_size_2 + int init_heap_size_2 = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", SCM_DEFAULT_INIT_HEAP_SIZE_2); scm_i_freelist = SCM_EOL; @@ -172,12 +176,14 @@ scm_gc_init_freelist (void) scm_init_freelist (&scm_i_master_freelist, 1, scm_getenv_int ("GUILE_MIN_YIELD_1", SCM_DEFAULT_MIN_YIELD_1)); - scm_max_segment_size = scm_getenv_int ("GUILE_MAX_SEGMENT_SIZE", SCM_DEFAULT_MAX_SEGMENT_SIZE); + + if (scm_max_segment_size <= 0) + scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE; + scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist); scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2); - #if (SCM_ENABLE_DEPRECATED == 1) if ( scm_default_init_heap_size_1 || diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 2f39db0da..9703051db 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -106,6 +106,14 @@ scm_gc_init_malloc (void) SCM_DEFAULT_INIT_MALLOC_LIMIT); scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC", SCM_DEFAULT_MALLOC_MINYIELD); + + if (scm_i_minyield_malloc >= 100) + scm_i_minyield_malloc = 99; + if (scm_i_minyield_malloc < 1) + scm_i_minyield_malloc = 1; + + if (scm_mtrigger < 0) + scm_mtrigger = SCM_DEFAULT_INIT_MALLOC_LIMIT; } @@ -226,7 +234,10 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) Instead of getting bogged down, we let the mtrigger grow strongly with it. */ - scm_mtrigger = (scm_mallocated * 110) / (100 - scm_i_minyield_malloc); + float no_overflow_trigger = (float)(scm_mallocated * 110); + + no_overflow_trigger /= (float) (100 - scm_i_minyield_malloc); + scm_mtrigger = (unsigned long) no_overflow_trigger; #ifdef DEBUGINFO fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n", scm_mtrigger); diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index ec0c2cf80..1596561b0 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -520,12 +520,15 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro return -1; } - - void -scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist) +scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist) { scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); + + if (init_heap_size < 1) + { + init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1; + } if (scm_i_initialize_heap_segment_data (seg, init_heap_size)) { diff --git a/libguile/private-gc.h b/libguile/private-gc.h index e9c170f12..484b34919 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -124,7 +124,8 @@ extern unsigned long scm_gc_cells_collected_1; void scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist); void scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist); int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist); - + + #define SCM_HEAP_SIZE \ (scm_i_master_freelist.heap_size + scm_i_master_freelist2.heap_size) @@ -228,7 +229,7 @@ void scm_i_sweep_segments (void); SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics * fl); void scm_i_reset_segments (void); void scm_i_sweep_all_segments (char const *reason); -void scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist); +void scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist); extern long int scm_i_deprecated_memory_return; From 1e71eafb34713a35cb95c459d3a26dd0ad0f38b5 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 8 Sep 2002 11:31:32 +0000 Subject: [PATCH 154/306] * inline.h: include stdio.h * smob.c (free_print): abort if scm_debug_cell_accesses_p is set --- libguile/ChangeLog | 11 ++++++++--- libguile/gc-card.c | 12 +++++++----- libguile/gc.c | 2 +- libguile/gc.h | 1 + libguile/inline.h | 42 +++++++++++++++++++++++++++++------------- libguile/smob.c | 7 ++++++- 6 files changed, 52 insertions(+), 23 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7f722f3a9..ed8ceb2c6 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-09-08 Han-Wen Nienhuys + + * inline.h: include stdio.h + + * smob.c (free_print): abort if scm_debug_cell_accesses_p is set + 2002-09-05 Han-Wen Nienhuys * gc-segment.c (scm_i_make_initial_segment): check user settings @@ -5,15 +11,14 @@ * gc-malloc.c (scm_gc_init_malloc): check user settings for sanity. - (scm_gc_register_collectable_memory): prevent overflow of memory - counts. * gc-freelist.c (scm_init_freelist): check user settings for sanity. * struct.h: change scm_structs_to_free to scm_i_structs_to_free * gc-malloc.c (scm_gc_register_collectable_memory): use floats; - these won't ever wrap around with high memory usage. + these won't ever wrap around with high memory usage. Thanks to + Sven Hartrumpf for finding this. * gc-freelist.c: include diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 61bf5b2ad..13cca2606 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -327,6 +327,13 @@ scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list, } +#if (SCM_DEBUG_CELL_ACCESSES == 1) +int +scm_gc_marked_p (SCM obj) +{ + return SCM_GC_MARK_P(obj); +} +#endif #if 0 /* @@ -355,11 +362,6 @@ typedef struct scm_t_double_cell } scm_t_double_cell; -int -scm_gc_marked_p (SCM obj) -{ - return SCM_GC_MARK_P(obj); -} scm_t_cell * scm_gc_get_card (SCM obj) diff --git a/libguile/gc.c b/libguile/gc.c index d5baf3cca..0650b4180 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -239,7 +239,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, /* do nothing */ - + fprintf (stderr, "\nWARNING: GUILE was not compiled with SCM_DEBUG_CELL_ACCESSES"); scm_remember_upto_here (flag); return SCM_UNSPECIFIED; } diff --git a/libguile/gc.h b/libguile/gc.h index 06f4eee0f..6e1fec939 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -251,6 +251,7 @@ typedef unsigned long scm_t_c_bvec_long; SCM_API int scm_debug_cell_accesses_p; SCM_API int scm_expensive_debug_cell_accesses_p; SCM_API int scm_debug_cells_gc_interval ; +void scm_i_expensive_validation_check (SCM cell); #endif SCM_API int scm_block_gc; diff --git a/libguile/inline.h b/libguile/inline.h index ea6b51277..31d06d798 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -50,6 +50,11 @@ */ +#if (SCM_DEBUG_CELL_ACCESSES == 1) +#include + +#endif + #include "libguile/pairs.h" #include "libguile/gc.h" @@ -94,20 +99,31 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) #if (SCM_DEBUG_CELL_ACCESSES == 1) if (scm_debug_cell_accesses_p) - { - if (SCM_GC_MARK_P (z)) - { - fprintf(stderr, "scm_cell tried to allocate a marked cell.\n"); - abort(); - } - else if (SCM_GC_CELL_TYPE(z) != scm_tc_free_cell) - { - fprintf(stderr, "cell from freelist is not a free cell.\n"); - abort(); - } + { + if (SCM_GC_MARK_P (z)) + { + fprintf(stderr, "scm_cell tried to allocate a marked cell.\n"); + abort(); + } + else if (SCM_GC_CELL_TYPE(z) != scm_tc_free_cell) + { + fprintf(stderr, "cell from freelist is not a free cell.\n"); + abort(); + } + } + + /* + Always set mark. Otherwise cells that are alloced before + scm_debug_cell_accesses_p is toggled seem invalid. + */ + SCM_SET_GC_MARK (z); + + /* + TODO: figure out if this use of mark bits is valid with + threading. What if another thread is doing GC at this point + ... ? + */ - SCM_SET_GC_MARK (z); - } #endif diff --git a/libguile/smob.c b/libguile/smob.c index 847748d33..5853e3abc 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -473,10 +473,15 @@ static int free_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { char buf[100]; - sprintf (buf, "#", (void *) SCM_UNPACK (exp)); scm_puts (buf, port); + +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (scm_debug_cell_accesses_p) + abort(); +#endif + return 1; } From e88e4f2ef31397506482f44d52ce8b2c1cd4d2de Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Mon, 9 Sep 2002 14:09:35 +0000 Subject: [PATCH 155/306] (scm_gc_register_collectable_memory): more overflow protection. --- libguile/ChangeLog | 5 +++++ libguile/gc-malloc.c | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index ed8ceb2c6..48cf939b0 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-09-09 Han-Wen Nienhuys + + * gc-malloc.c (scm_gc_register_collectable_memory): more overflow + protection. + 2002-09-08 Han-Wen Nienhuys * inline.h: include stdio.h diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 9703051db..54a162263 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -234,9 +234,9 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) Instead of getting bogged down, we let the mtrigger grow strongly with it. */ - float no_overflow_trigger = (float)(scm_mallocated * 110); + float no_overflow_trigger = scm_mallocated * 110.0; - no_overflow_trigger /= (float) (100 - scm_i_minyield_malloc); + no_overflow_trigger /= (float) (100.0 - scm_i_minyield_malloc); scm_mtrigger = (unsigned long) no_overflow_trigger; #ifdef DEBUGINFO From cc72f3bc35e7ab3b9edd42261b104594508814b1 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 20:01:18 +0000 Subject: [PATCH 156/306] Added www.schemers.org. Removed foldoc, it's too generic. Updated 'teach yourself ...' URL. --- doc/ref/scheme-reading.texi | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/doc/ref/scheme-reading.texi b/doc/ref/scheme-reading.texi index eea049d2d..6ec4a77b0 100644 --- a/doc/ref/scheme-reading.texi +++ b/doc/ref/scheme-reading.texi @@ -3,15 +3,17 @@ @chapter Further Reading @itemize @bullet + +@item +The website @url{http://www.schemers.org} is a good starting point for +all things Scheme. + @item Dorai Sitaram's online Scheme tutorial, @dfn{Teach Yourself Scheme in Fixnum Days}, at -@url{http://www.cs.rice.edu/~dorai/t-y-scheme/t-y-scheme.html}. +@url{http://www.ccs.neu.edu/home/dorai/t-y-scheme/t-y-scheme.html}. Includes a nice explanation of continuations. -@item -@url{http://wombat.doc.ic.ac.uk/foldoc/}. - @item The complete text of @dfn{Structure and Interpretation of Computer Programs}, the classic introduction to computer science and Scheme by From af31a24fd9f9a645f92d75e585865654cad558a8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 20:01:25 +0000 Subject: [PATCH 157/306] *** empty log message *** --- doc/ref/ChangeLog | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 3ff16c44a..355a0d58d 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,6 +1,11 @@ +2002-09-09 Marius Vollmer + + * scheme-reading.texi: Added www.schemers.org. Removed foldoc, + it's too generic. Updated 'teach yourself ...' URL. + 2002-08-27 Marius Vollmer - * scheme-modules.texi: Markup fixes and removal f gh_ references. + * scheme-modules.texi: Markup fixes and removal of gh_ references. Thanks to Dale Smith! 2002-08-14 Marius Vollmer From f30482f39636504ab7daef65de6c7463e0df6049 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 20:02:52 +0000 Subject: [PATCH 158/306] Updated. --- NEWS | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index c05b1a25a..afc95bfa7 100644 --- a/NEWS +++ b/NEWS @@ -22,6 +22,11 @@ debugging evaluator gives better error messages. ** New function 'unsetenv'. +** New macro 'define-syntax-public'. + +It works like 'define-syntax' and also exports the defined macro (but +only on top-level). + ** There is support for Infinity and NaNs. Following PLT Scheme, Guile can now work with infinite numbers, and @@ -108,8 +113,12 @@ during evaluation, but prior to evaluation. This is like SCM_DEFINE, but also calls scm_c_export for the defined function in the init section. +** New macros SCM_VECTOR_REF and SCM_VECTOR_SET. + +Use these in preference to SCM_VELTS. + ** The SCM_VELTS macros now returns a read-only vector. For writing, -use the new macros SCM_WRITABLE_VELTS, SCM_VECTOR_SET. The use of +use the new macros SCM_WRITABLE_VELTS or SCM_VECTOR_SET. The use of SCM_WRITABLE_VELTS is discouraged, though. ** Garbage collector rewrite. From 10eec59393b8b5cb8f510481e74dbbd9322244d5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 20:02:57 +0000 Subject: [PATCH 159/306] Added Eric Hanchrow. --- THANKS | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/THANKS b/THANKS index 7cccc4b41..0f22ff2c1 100644 --- a/THANKS +++ b/THANKS @@ -20,9 +20,10 @@ For fixes or providing information which led to a fix: Alexandre Duret-Lutz John W Eaton Clinton Ebadi - Aubrey Jaffer Eric Gillespie, Jr John Goerzen + Eric Hanchrow + Aubrey Jaffer Richard Kim Matthias Köppe Han-Wen Nienhuys From d9f352d46899895e5e474c3f1ad195532eb3cf2a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 20:58:26 +0000 Subject: [PATCH 160/306] (dist-hook): Do not distribute CVS directories. Thanks to Greg Troxel! --- test-suite/Makefile.am | 1 + 1 file changed, 1 insertion(+) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 727601ecd..5f9bd175c 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -49,4 +49,5 @@ EXTRA_DIST = guile-test lib.scm $(SCM_TESTS) dist-hook: for d in $(SCM_TESTS_DIRS); do \ cp -pR $(srcdir)/$$d $(distdir)/$$d; \ + rm -rf $(distdir)/$$d/CVS; \ done From 6b61da182e5287cd38f0fbc9817e0d930e382846 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 20:59:43 +0000 Subject: [PATCH 161/306] *** empty log message *** --- test-suite/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 0a6cca940..cd83f1f29 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2002-09-09 Marius Vollmer + + * Makefile.am (dist-hook): Do not distribute CVS directories. + Thanks to Greg Troxel! + 2002-08-06 Han-Wen Nienhuys * tests/reader.test: change misc-error in read-error. From 6e63303d3926767f6794635c504b973013272b92 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 21:32:29 +0000 Subject: [PATCH 162/306] Updated GNu ftp server name. Use "-lguile" instead of "libguile.a". Some small fixes/improvements. --- doc/ref/intro.texi | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/doc/ref/intro.texi b/doc/ref/intro.texi index d3af77a8a..f46b7ffb4 100644 --- a/doc/ref/intro.texi +++ b/doc/ref/intro.texi @@ -878,29 +878,34 @@ packages and documentation you might need or find interesting. @section The Basic Guile Package Guile can be obtained from the main GNU archive site -@url{ftp://prep.ai.mit.edu/pub/gnu} or any of its mirrors. The file +@url{ftp://ftp.gnu.org} or any of its mirrors. The file will be named guile-version.tar.gz. The current version is @value{VERSION}, so the file you should grab is: -@url{ftp://prep.ai.mit.edu/pub/gnu/guile-@value{VERSION}.tar.gz} +@url{ftp://ftp.gnu.org/pub/gnu/guile-@value{VERSION}.tar.gz} To unbundle Guile use the instruction + @example zcat guile-@value{VERSION}.tar.gz | tar xvf - @end example + which will create a directory called @file{guile-@value{VERSION}} with all the sources. You can look at the file @file{INSTALL} for detailed instructions on how to build and install Guile, but you should be able to just do + @example cd guile-@value{VERSION} ./configure +make make install @end example This will install the Guile executable @file{guile}, the Guile library -@file{libguile.a} and various associated header files and support -libraries. It will also install the Guile tutorial and reference manual. +@file{-lguile} and various associated header files and support +libraries. It will also install the Guile tutorial and reference +manual. @c [[include instructions for getting R5RS]] From 35e791bdb799b9bfdcd028a323840a1d0ec620e7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 21:32:36 +0000 Subject: [PATCH 163/306] *** empty log message *** --- doc/ref/ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 355a0d58d..46204f093 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,5 +1,8 @@ 2002-09-09 Marius Vollmer + * intro.texi: Updated GNu ftp server name. Use "-lguile" instead + of "libguile.a". Some small fixes/improvements. + * scheme-reading.texi: Added www.schemers.org. Removed foldoc, it's too generic. Updated 'teach yourself ...' URL. From 76fb48bfa711b3351379778f13c5addc78d75e9e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 21:34:39 +0000 Subject: [PATCH 164/306] Added P Pareit. --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index 0f22ff2c1..72874bb66 100644 --- a/THANKS +++ b/THANKS @@ -28,6 +28,7 @@ For fixes or providing information which led to a fix: Matthias Köppe Han-Wen Nienhuys Jan Nieuwenhuizen + Pieter Pareit Ron Peterson David Pirotte Ken Raeburn From c604da1be5e904b2381afb1a4d407a4ebdc0f93e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 21:48:12 +0000 Subject: [PATCH 165/306] (Creating a Procedure): Fixed typo. Thanks to Pieter Pareit! --- doc/ref/scheme-ideas.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ref/scheme-ideas.texi b/doc/ref/scheme-ideas.texi index 98ed953e8..052bdeb35 100644 --- a/doc/ref/scheme-ideas.texi +++ b/doc/ref/scheme-ideas.texi @@ -387,7 +387,7 @@ this: This is a valid procedure invocation expression, and its result is the string @code{"Name=FSF:Address=Cambridge"}. -It it more common, though, to store the procedure value in a variable --- +It is more common, though, to store the procedure value in a variable --- @lisp (define make-combined-string From 1381c5065fc812ec53e05912cf8caf892985eaff Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 9 Sep 2002 21:48:21 +0000 Subject: [PATCH 166/306] *** empty log message *** --- doc/ref/ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 46204f093..831b6899e 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,5 +1,8 @@ 2002-09-09 Marius Vollmer + * scheme-ideas.texi (Creating a Procedure): Fixed typo. Thanks to + Pieter Pareit! + * intro.texi: Updated GNu ftp server name. Use "-lguile" instead of "libguile.a". Some small fixes/improvements. From d3633db4138b90376cd306843b43716c5ac4c68b Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sun, 15 Sep 2002 01:08:32 +0000 Subject: [PATCH 167/306] * .cvsignore: new file. --- benchmark-suite/.cvsignore | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 benchmark-suite/.cvsignore diff --git a/benchmark-suite/.cvsignore b/benchmark-suite/.cvsignore new file mode 100644 index 000000000..282522db0 --- /dev/null +++ b/benchmark-suite/.cvsignore @@ -0,0 +1,2 @@ +Makefile +Makefile.in From f02ce8998d31ebdcc979077c5509835b9360a946 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sun, 15 Sep 2002 01:09:47 +0000 Subject: [PATCH 168/306] * .cvsignore: add stamp-vti.1 --- doc/.cvsignore | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/.cvsignore b/doc/.cvsignore index 86d66d588..6b7d23ff9 100644 --- a/doc/.cvsignore +++ b/doc/.cvsignore @@ -19,5 +19,6 @@ Makefile Makefile.in stamp-vti stamp-vti1 +stamp-vti.1 version-tutorial.texi version.texi From a0760d6173d6e133229f846c82aa7261b6adb05b Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sun, 15 Sep 2002 01:11:00 +0000 Subject: [PATCH 169/306] *** empty log message *** --- benchmark-suite/ChangeLog | 4 ++++ doc/ChangeLog | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog index a7d17d1ec..988bf584a 100644 --- a/benchmark-suite/ChangeLog +++ b/benchmark-suite/ChangeLog @@ -1,3 +1,7 @@ +2002-09-14 Rob Browning + + * .cvsignore: new file. + 2002-07-26 Marius Vollmer * Makefile.am (SCM_BENCHMARKS): List the real benchmarks, not foo diff --git a/doc/ChangeLog b/doc/ChangeLog index 38a0e4599..cab132e16 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,3 +1,7 @@ +2002-09-14 Rob Browning + + * .cvsignore: add stamp-vti.1 + 2002-08-24 Marius Vollmer * Makefile.am (EXTRA_DIST): Do not distribute guile-api.alist, it From 0ac6420c88f1acfa3663e9c9b34b467219981cd0 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sun, 15 Sep 2002 01:19:17 +0000 Subject: [PATCH 170/306] * boot-9.scm (sqrt): minor indentation fix. --- ice-9/boot-9.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 5fd5b638e..71bc2bff0 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -680,7 +680,7 @@ (define (sqrt z) (if (real? z) (if (negative? z) (make-rectangular 0 ($sqrt (- z))) - ($sqrt z)) + ($sqrt z)) (make-polar ($sqrt (magnitude z)) (/ (angle z) 2)))) (define expt From 5fc0857ef607e5deaa7818021f14602f6bdbb95b Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sun, 15 Sep 2002 01:21:37 +0000 Subject: [PATCH 171/306] *** empty log message *** --- ice-9/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 276b4f33f..dcdea356a 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,7 @@ +2002-09-14 Rob Browning + + * boot-9.scm (sqrt): minor indentation fix. + 2002-09-05 Marius Vollmer * syncase.scm: Set the module transformer of the-syncase-module so From f4232aa66425ae156f2636c9539ffd8d01b40af7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 15 Sep 2002 21:30:39 +0000 Subject: [PATCH 172/306] (feature?): Added deprecation message. --- ice-9/ChangeLog | 4 ++++ ice-9/boot-9.scm | 5 ++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index dcdea356a..6774ea708 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,7 @@ +2002-09-15 Marius Vollmer + + * boot-9.scm (feature?): Added deprecation message. + 2002-09-14 Rob Browning * boot-9.scm (sqrt): minor indentation fix. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 71bc2bff0..81b3ee3bb 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -83,7 +83,10 @@ (and (memq feature *features*) #t)) (begin-deprecated - (define feature? provided?)) + (define (feature? sym) + (issue-deprecation-warning + "`feature?' is deprecated. Use `provided?' instead.") + (provided? sym))) ;;; let format alias simple-format until the more complete version is loaded (define format simple-format) From 6f663ebc8ce6bd8b3fd78a99c06adf219090d16c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 15 Sep 2002 21:31:42 +0000 Subject: [PATCH 173/306] Tell them to use 'provided?' instead of '*feaures*'. --- doc/ref/ChangeLog | 5 +++++ doc/ref/scheme-data.texi | 10 +++++----- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 831b6899e..3e45ee932 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-09-15 Marius Vollmer + + * scheme-data.texi: Tell them to use 'provided?' instead of + '*feaures*'. + 2002-09-09 Marius Vollmer * scheme-ideas.texi (Creating a Procedure): Fixed typo. Thanks to diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index d64284925..16ced7f1a 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -1919,11 +1919,11 @@ an introduction can be found in the Emacs manual (@pxref{Regexps, , Syntax of Regular Expressions, emacs, The GNU Emacs Manual}), or in many general Unix reference books. -If your system does not include a POSIX regular expression library, and -you have not linked Guile with a third-party regexp library such as Rx, -these functions will not be available. You can tell whether your Guile -installation includes regular expression support by checking whether the -@code{*features*} list includes the @code{regex} symbol. +If your system does not include a POSIX regular expression library, +and you have not linked Guile with a third-party regexp library such +as Rx, these functions will not be available. You can tell whether +your Guile installation includes regular expression support by +checking whether @code{(provided? 'regex)} returns true. @menu * Regexp Functions:: Functions that create and match regexps. From 6852c744de160ac7c16ab5a95aa829110e754a16 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 16 Sep 2002 20:01:34 +0000 Subject: [PATCH 174/306] (Symbol Props): It's "set-symbol-property!", not "set-symbol-property". Thanks to Pieter Pareit! --- doc/ref/scheme-data.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index 16ced7f1a..b34a969a1 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -2665,7 +2665,7 @@ the property list has no entry for @var{prop}, @code{symbol-property} returns @code{#f}. @end deffn -@deffn {Scheme Procedure} set-symbol-property sym prop val +@deffn {Scheme Procedure} set-symbol-property! sym prop val In @var{sym}'s property list, set the value for property @var{prop} to @var{val}, or add a new entry for @var{prop}, with value @var{val}, if none already exists. For the structure of the property list, see From 2047e5d7c297f5529178d784d63b68899060c7c5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 16 Sep 2002 20:03:03 +0000 Subject: [PATCH 175/306] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 3e45ee932..9dff63143 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-09-16 Marius Vollmer + + * scheme-data.texi (Symbol Props): It's "set-symbol-property!", + not "set-symbol-property". Thanks to Pieter Pareit! + 2002-09-15 Marius Vollmer * scheme-data.texi: Tell them to use 'provided?' instead of From 4ad0814a57839b11916caa175a7967278d1c4e2b Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 19 Sep 2002 11:14:46 +0000 Subject: [PATCH 176/306] (scm_double_cell): move SET_GCMARK set out of if body. --- libguile/ChangeLog | 4 ++++ libguile/inline.h | 6 ++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 48cf939b0..fb7da086c 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-09-19 Han-Wen Nienhuys + + * inline.h (scm_double_cell): move SET_GCMARK set out of if body. + 2002-09-09 Han-Wen Nienhuys * gc-malloc.c (scm_gc_register_collectable_memory): more overflow diff --git a/libguile/inline.h b/libguile/inline.h index 31d06d798..d4cd67606 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -208,9 +208,11 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, "scm_double_cell tried to allocate a marked cell.\n"); abort(); } - - SCM_SET_GC_MARK (z); } + + /* see above. */ + SCM_SET_GC_MARK (z); + #endif return z; From c15030bebf555969379628ef154f7f26ce1c6cd1 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 19 Sep 2002 20:39:41 +0000 Subject: [PATCH 177/306] Improvements to hook docs. --- doc/ref/ChangeLog | 5 +++++ doc/ref/scheme-utility.texi | 25 +++++++++++++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 9dff63143..b541a74d6 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-09-19 Neil Jerram + + * scheme-utility.texi (Hook Reference): Improvements to hook docs. + Thanks to Thien-Thi Nguyen for the patches. + 2002-09-16 Marius Vollmer * scheme-data.texi (Symbol Props): It's "set-symbol-property!", diff --git a/doc/ref/scheme-utility.texi b/doc/ref/scheme-utility.texi index f544ac0da..b82497ebb 100644 --- a/doc/ref/scheme-utility.texi +++ b/doc/ref/scheme-utility.texi @@ -490,6 +490,10 @@ The ordering of the list of procedures returned by @code{hook->list} matches the order in which those procedures would be called if the hook was run using @code{run-hook}. +Note that the C functions in the following entries are for handling +@dfn{Scheme-level} hooks in C. There are also @dfn{C-level} hooks which +have their own interface (@pxref{C Hooks}). + @deffn {Scheme Procedure} make-hook [n_args] @deffnx {C Function} scm_make_hook (n_args) Create a hook for storing procedure of arity @var{n_args}. @@ -551,6 +555,27 @@ that @var{hook} is actually a hook object and that @var{args} is a well-formed list matching the arity of the hook. @end deftypefn +For C code, @code{SCM_HOOKP} is a faster alternative to +@code{scm_hook_p}: + +@deftypefn {C Macro} int SCM_HOOKP (x) +Return 1 if @var{x} is a Scheme-level hook, 0 otherwise. +@end deftypefn + + +@subsection Handling Scheme-level hooks from C code + +Here is an example of how to handle Scheme-level hooks from C code using +the above functions. + +@example +if (SCM_NFALSEP (scm_hook_p (obj))) + /* handle Scheme-level hook using C functions */ + scm_reset_hook_x (obj); +else + /* do something else (obj is not a hook) */ +@end example + @node C Hooks @subsection Hooks For C Code. From 3553e1d1f037df79b10e5f8589884c02e57fe144 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Tue, 24 Sep 2002 22:21:01 +0000 Subject: [PATCH 178/306] * inline.h (scm_double_cell): prevent reordering of statements with any following code (for GCC 3 strict-aliasing). * numbers.c (scm_make_real), num2float.i.c (FLOAT2NUM): removed the earlier version of the reordering prevention. --- libguile/ChangeLog | 7 +++++++ libguile/inline.h | 20 ++++++++++++++++++++ libguile/num2float.i.c | 8 ++------ libguile/numbers.c | 9 +-------- 4 files changed, 30 insertions(+), 14 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index fb7da086c..13ac529d0 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,10 @@ +2002-09-24 Gary Houston + + * inline.h (scm_double_cell): prevent reordering of statements + with any following code (for GCC 3 strict-aliasing). + * numbers.c (scm_make_real), num2float.i.c (FLOAT2NUM): removed + the earlier version of the reordering prevention. + 2002-09-19 Han-Wen Nienhuys * inline.h (scm_double_cell): move SET_GCMARK set out of if body. diff --git a/libguile/inline.h b/libguile/inline.h index d4cd67606..393182b6a 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -213,6 +213,26 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, /* see above. */ SCM_SET_GC_MARK (z); +#endif + + /* When this function is inlined, it's possible that the last + SCM_GC_SET_CELL_WORD above will be adjacent to a following + initialization of z. E.g., it occurred in scm_make_real. GCC + from around version 3 (e.g., certainly 3.2) began taking + advantage of strict C aliasing rules which say that it's OK to + interchange the initialization above and the one below when the + pointer types appear to differ sufficiently. We don't want that, + of course. GCC allows this behaviour to be disabled with the + -fno-strict-aliasing option, but would also need to be supplied + by Guile users. Instead, the following statements prevent the + reordering. + */ +#ifdef __GNUC__ + asm volatile ("" : : : "memory"); +#else + /* portable version, just in case any other compiler does the same + thing. */ + scm_remember_upto_here_1 (z); #endif return z; diff --git a/libguile/num2float.i.c b/libguile/num2float.i.c index 5fd9180c7..08687a875 100644 --- a/libguile/num2float.i.c +++ b/libguile/num2float.i.c @@ -31,12 +31,8 @@ NUM2FLOAT (SCM num, unsigned long int pos, const char *s_caller) SCM FLOAT2NUM (FTYPE n) { - SCM z; - z = scm_double_cell (scm_tc16_real, 0, 0, 0); - /* - See scm_make_real(). - */ - scm_remember_upto_here_1 (z); + SCM z = scm_double_cell (scm_tc16_real, 0, 0, 0); + SCM_REAL_VALUE (z) = n; return z; } diff --git a/libguile/numbers.c b/libguile/numbers.c index 8393c62ca..bb01d7ad3 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -3013,15 +3013,8 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0, SCM scm_make_real (double x) { - SCM z; - z = scm_double_cell (scm_tc16_real, 0, 0, 0); + SCM z = scm_double_cell (scm_tc16_real, 0, 0, 0); - /* - scm_double_cell is inlined. strict C aliasing rules say that it's - OK to interchange the initialization above and the one below. We - don't want that, of course. - */ - scm_remember_upto_here_1 (z); SCM_REAL_VALUE (z) = x; return z; } From c936bede422ef810909ed51379f41191627a5575 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 25 Sep 2002 00:06:38 +0000 Subject: [PATCH 179/306] Doc updates, including contribution from Ian Sheldon. --- doc/ref/ChangeLog | 33 ++ doc/ref/guile.texi | 4 +- doc/ref/repl-modules.texi | 2 +- doc/ref/scheme-data.texi | 126 ++++- doc/ref/scheme-debug.texi | 66 ++- doc/ref/scheme-evaluation.texi | 8 +- doc/ref/scheme-modules.texi | 34 +- doc/ref/scheme-options.texi | 822 +++++++++++++++++---------------- doc/ref/slib.texi | 4 +- 9 files changed, 670 insertions(+), 429 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index b541a74d6..bbd18a228 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,36 @@ +2002-09-25 Neil Jerram + + * scheme-debug.texi (Debugging): Make sections into nodes. + (Debugging Options): Node removed. + + * scheme-options.texi (Feature Tracking): Brought forward before + sections on options. + (Runtime Options): New section, to group options-related nodes. + +2002-09-24 Neil Jerram + + * scheme-options.texi (Options and Config): Chapter name changed, + and intro text improved. + (Install Config): Brought forward, and renamed Build + Configuration. + + The following doc updates are from Ian Sheldon - thanks! + + * scheme-data.texi (Appending Strings, Regexp Functions, Match + Structures): Add examples. + (Regular Expressions): Add instruction to use (ice-9 regex) + module. + + * slib.texi (SLIB): Remove duplicate `the'. + +2002-09-22 Neil Jerram + + * scheme-options.texi (General option interface): Mention + eval-options-interface and debug-options-interface. + + * scheme-debug.texi (Debugging): New node describing source + properties. + 2002-09-19 Neil Jerram * scheme-utility.texi (Hook Reference): Improvements to hook docs. diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index c819fb53d..22b308757 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -101,7 +101,7 @@ by the Free Software Foundation. @comment The title is printed in a large font. @title Guile Reference Manual @subtitle Edition @value{MANUAL_EDITION}, for use with Guile @value{VERSION} -@subtitle $Id: guile.texi,v 1.18 2002-04-20 19:26:40 ossau Exp $ +@subtitle $Id: guile.texi,v 1.19 2002-09-25 00:06:38 ossau Exp $ @c AUTHORS @@ -253,7 +253,7 @@ Part IV: Guile API Reference * Objects:: Low level object orientation support. * Modules:: Designing reusable code libraries. * Scheduling:: Threads, mutexes, asyncs and dynamic roots. -* Options and Config:: Runtime options and configuration. +* Options and Config:: Configuration, features and runtime options. * Translation:: Support for translating other languages. * Debugging:: Internal debugging interface. * Deprecated:: Features that are planned to disappear. diff --git a/doc/ref/repl-modules.texi b/doc/ref/repl-modules.texi index b136bd865..ea57e365b 100644 --- a/doc/ref/repl-modules.texi +++ b/doc/ref/repl-modules.texi @@ -68,7 +68,7 @@ expressions available. The readline interface module can be configured in several ways to better suit the user's needs. Configuration is done via the readline module's options interface, in a similar way to the evaluator and -debugging options (@pxref{General option interface}.) +debugging options (@pxref{User level options interfaces}.) Here is the list of readline options generated by typing @code{(readline-options 'full)} in Guile. You can also see the diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index b34a969a1..e557ecd6b 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -1901,6 +1901,12 @@ form a longer result string. @deffnx {C Function} scm_string_append (args) Return a newly allocated string whose characters form the concatenation of the given strings, @var{args}. + +@example +(let ((h "hello ")) + (string-append h "world")) +@result{} "hello world" +@end example @end deffn @@ -1925,6 +1931,11 @@ as Rx, these functions will not be available. You can tell whether your Guile installation includes regular expression support by checking whether @code{(provided? 'regex)} returns true. +The following regexp and string matching features are provided by the +@code{(ice-9 regex)} module. Before using the described functions, +you should load this module by executing @code{(use-modules (ice-9 +regex))}. + @menu * Regexp Functions:: Functions that create and match regexps. * Match Structures:: Finding what was matched by a regexp. @@ -1932,8 +1943,6 @@ checking whether @code{(provided? 'regex)} returns true. meta-characters. @end menu -[FIXME: it may be useful to include an Examples section. Parts of this -interface are bewildering on first glance.] @node Regexp Functions @subsection Regexp Functions @@ -1947,7 +1956,6 @@ This regular expression interface was modeled after that implemented by SCSH, the Scheme Shell. It is intended to be upwardly compatible with SCSH regular expressions. -@c begin (scm-doc-string "regex.scm" "string-match") @deffn {Scheme Procedure} string-match pattern str [start] Compile the string @var{pattern} into a regular expression and compare it with @var{str}. The optional numeric argument @var{start} specifies @@ -1959,6 +1967,18 @@ expression. @xref{Match Structures}. If @var{str} does not match @var{pattern} at all, @code{string-match} returns @code{#f}. @end deffn +Two examples of a match follow. In the first example, the pattern +matches the four digits in the match string. In the second, the pattern +matches nothing. + +@example +(string-match "[0-9][0-9][0-9][0-9]" "blah2002") +@result{} #("blah2002" (4 . 8)) + +(string-match "[A-Za-z]" "123456") +@result{} #f +@end example + Each time @code{string-match} is called, it must compile its @var{pattern} argument into a regular expression structure. This operation is expensive, which makes @code{string-match} inefficient if @@ -2030,6 +2050,22 @@ considered the end of a line. @end table @end deffn +@lisp +;; Regexp to match uppercase letters +(define r (make-regexp "[A-Z]*")) + +;; Regexp to match letters, ignoring case +(define ri (make-regexp "[A-Z]*" regexp/icase)) + +;; Search for bob using regexp r +(match:substring (regexp-exec r "bob")) +@result{} "" ; no match + +;; Search for bob using regexp ri +(match:substring (regexp-exec ri "Bob")) +@result{} "Bob" ; matched case insensitive +@end lisp + @deffn {Scheme Procedure} regexp? obj @deffnx {C Function} scm_regexp_p (obj) Return @code{#t} if @var{obj} is a compiled regular expression, @@ -2061,11 +2097,25 @@ The symbol @samp{post}. The portion of the matched string following the regexp match is written. @end itemize -@var{port} may be @code{#f}, in which case nothing is written; instead, -@code{regexp-substitute} constructs a string from the specified -@var{item}s and returns that. +The @var{port} argument may be @code{#f}, in which case nothing is +written; instead, @code{regexp-substitute} constructs a string from the +specified @var{item}s and returns that. @end deffn +The following example takes a regular expression that matches a standard +YYYYMMDD-format date such as @code{"20020828"}. The +@code{regexp-substitute} call returns a string computed from the +information in the match structure, consisting of the fields and text +from the original string reordered and reformatted. + +@lisp +(define date-regex "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])") +(define s "Date 20020429 12am.") +(define sm (string-match date-regex s)) +(regexp-substitute #f sm 'pre 2 "-" 3 "-" 1 'post " (" 0 ")") +@result{} "Date 04-29-2002 12am. (20020429)" +@end lisp + @c begin (scm-doc-string "regex.scm" "regexp-substitute") @deffn {Scheme Procedure} regexp-substitute/global port regexp target [item@dots{}] Similar to @code{regexp-substitute}, but can be used to perform global @@ -2092,6 +2142,18 @@ return after processing a single match. @end itemize @end deffn +The example above for @code{regexp-substitute} could be rewritten as +follows to remove the @code{string-match} stage: + +@lisp +(define date-regex "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])") +(define s "Date 20020429 12am.") +(regexp-substitute/global #f date-regex s + 'pre 2 "-" 3 "-" 1 'post " (" 0 ")") +@result{} "Date 04-29-2002 12am. (20020429)" +@end lisp + + @node Match Structures @subsection Match Structures @@ -2126,19 +2188,54 @@ If the regular expression as a whole matched, but the subexpression number @var{n} did not match, return @code{#f}. @end deffn +@lisp +(define s (string-match "[0-9][0-9][0-9][0-9]" "blah2002foo")) +(match:substring s) +@result{} "2002" + +;; match starting at offset 6 in the string +(match:substring + (string-match "[0-9][0-9][0-9][0-9]" "blah987654" 6)) +@result{} "7654" +@end lisp + @c begin (scm-doc-string "regex.scm" "match:start") @deffn {Scheme Procedure} match:start match [n] Return the starting position of submatch number @var{n}. @end deffn +In the following example, the result is 4, since the match starts at +character index 4: + +@lisp +(define s (string-match "[0-9][0-9][0-9][0-9]" "blah2002foo")) +(match:start s) +@result{} 4 +@end lisp + @c begin (scm-doc-string "regex.scm" "match:end") @deffn {Scheme Procedure} match:end match [n] Return the ending position of submatch number @var{n}. @end deffn +In the following example, the result is 8, since the match runs between +characters 4 and 8 (i.e. the ``2002''). + +@lisp +(define s (string-match "[0-9][0-9][0-9][0-9]" "blah2002foo")) +(match:end s) +@result{} 8 +@end lisp + @c begin (scm-doc-string "regex.scm" "match:prefix") @deffn {Scheme Procedure} match:prefix match Return the unmatched portion of @var{target} preceding the regexp match. + +@lisp +(define s (string-match "[0-9][0-9][0-9][0-9]" "blah2002foo")) +(match:prefix s) +@result{} "blah" +@end lisp @end deffn @c begin (scm-doc-string "regex.scm" "match:suffix") @@ -2146,6 +2243,12 @@ Return the unmatched portion of @var{target} preceding the regexp match. Return the unmatched portion of @var{target} following the regexp match. @end deffn +@lisp +(define s (string-match "[0-9][0-9][0-9][0-9]" "blah2002foo")) +(match:suffix s) +@result{} "foo" +@end lisp + @c begin (scm-doc-string "regex.scm" "match:count") @deffn {Scheme Procedure} match:count match Return the number of parenthesized subexpressions from @var{match}. @@ -2158,6 +2261,13 @@ subexpression, and failed submatches are included in the count. Return the original @var{target} string. @end deffn +@lisp +(define s (string-match "[0-9][0-9][0-9][0-9]" "blah2002foo")) +(match:string s) +@result{} "blah2002foo" +@end lisp + + @node Backslash Escapes @subsection Backslash Escapes @@ -2987,8 +3097,8 @@ recognizes the alternative read syntax @code{:NAME}. Otherwise, tokens of the form @code{:NAME} are read as symbols, as required by R5RS. To enable and disable the alternative non-R5RS keyword syntax, you use -the @code{read-options} procedure documented in @ref{General option -interface} and @ref{Reader options}. +the @code{read-set!} procedure documented in @ref{User level options +interfaces} and @ref{Reader options}. @smalllisp (read-set! keywords 'prefix) diff --git a/doc/ref/scheme-debug.texi b/doc/ref/scheme-debug.texi index 670bd0884..66526557f 100644 --- a/doc/ref/scheme-debug.texi +++ b/doc/ref/scheme-debug.texi @@ -2,14 +2,63 @@ @node Debugging @chapter Debugging Infrastructure -@deffn {Scheme Procedure} debug-options-interface [setting] -@deffnx {C Function} scm_debug_options (setting) -Option interface for the debug options. Instead of using -this procedure directly, use the procedures @code{debug-enable}, -@code{debug-disable}, @code{debug-set!} and @code{debug-options}. -@end deffn +@menu +* Source Properties:: Remembering the source of an expression. +* Using Traps:: +* Capturing the Stack or Innermost Stack Frame:: +* Examining the Stack:: +* Examining Stack Frames:: +* Decoding Memoized Source Expressions:: +* Starting a New Stack:: +@end menu +@node Source Properties +@section Source Properties + +@cindex source properties +As Guile reads in Scheme code from file or from standard input, it +remembers the file name, line number and column number where each +expression begins. These pieces of information are known as the +@dfn{source properties} of the expression. If an expression undergoes +transformation --- for example, if there is a syntax transformer in +effect, or the expression is a macro call --- the source properties are +copied from the untransformed to the transformed expression so that, if +an error occurs when evaluating the transformed expression, Guile's +debugger can point back to the file and location where the expression +originated. + +The way that source properties are stored means that Guile can only +associate source properties with parenthesized expressions, and not, for +example, with individual symbols, numbers or strings. The difference +can be seen by typing @code{(xxx)} and @code{xxx} at the Guile prompt +(where the variable @code{xxx} has not been defined): + +@example +guile> (xxx) +standard input:2:1: In expression (xxx): +standard input:2:1: Unbound variable: xxx +ABORT: (unbound-variable) +guile> xxx +: In expression xxx: +: Unbound variable: xxx +ABORT: (unbound-variable) +@end example + +@noindent +In the latter case, no source properties were stored, so the best that +Guile could say regarding the location of the problem was ``''. + +The recording of source properties is controlled by the read option +named ``positions'' (@pxref{Reader options}). This option is switched +@emph{on} by default, together with the debug options ``debug'' and +``backtrace'' (@pxref{Debugger options}), when Guile is run +interactively; all these options are @emph{off} by default when Guile +runs a script non-interactively. + + +@node Using Traps @section Using Traps @deffn {Scheme Procedure} with-traps thunk @@ -23,6 +72,7 @@ Return @code{#t} if @var{obj} is a debug object. @end deffn +@node Capturing the Stack or Innermost Stack Frame @section Capturing the Stack or Innermost Stack Frame When an error occurs in a running program, or the program hits a @@ -72,6 +122,7 @@ debug object or a continuation. @end deffn +@node Examining the Stack @section Examining the Stack @deffn {Scheme Procedure} stack? obj @@ -104,6 +155,7 @@ which means that default values will be used. @end deffn +@node Examining Stack Frames @section Examining Stack Frames @deffn {Scheme Procedure} frame? obj @@ -172,6 +224,7 @@ output. @end deffn +@node Decoding Memoized Source Expressions @section Decoding Memoized Source Expressions @deffn {Scheme Procedure} memoized? obj @@ -190,6 +243,7 @@ Return the environment of the memoized expression @var{m}. @end deffn +@node Starting a New Stack @section Starting a New Stack @deffn {Scheme Syntax} start-stack id exp diff --git a/doc/ref/scheme-evaluation.texi b/doc/ref/scheme-evaluation.texi index 6357c78cf..bb0f4b2e6 100644 --- a/doc/ref/scheme-evaluation.texi +++ b/doc/ref/scheme-evaluation.texi @@ -144,8 +144,8 @@ Any whitespace before the next token is discarded. @end deffn The behaviour of Guile's Scheme reader can be modified by manipulating -its read options. For more information about options, @xref{General -option interface}. If you want to know which reader options are +its read options. For more information about options, @xref{User level +options interfaces}. If you want to know which reader options are available, @xref{Reader options}. @c FIXME::martin: This is taken from libguile/options.c. Is there @@ -358,8 +358,8 @@ is implicit). @c `Evaluator options' under `Options and Config'. The behaviour of Guile's evaluator can be modified by manipulating the -evaluator options. For more information about options, @xref{General -option interface}. If you want to know which evaluator options are +evaluator options. For more information about options, @xref{User level +options interfaces}. If you want to know which evaluator options are available, @xref{Evaluator options}. @c FIXME::martin: This is taken from libguile/options.c. Is there diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index 460891060..5ff76c9b5 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -168,18 +168,18 @@ algorithmically @dfn{rename} bindings. In contrast, when using the providing module's public interface, the entire export list is available without renaming (@pxref{Using Guile Modules}). -To use a module, it must be found and loaded. All Guile modules have -a unique @dfn{module name}, which is a list of one or more symbols. -Examples are @code{(ice-9 popen)} or @code{(srfi srfi-11)}. When -Guile searches for the code of a module, it constructs the name of the -file to load by concatenating the name elements with slashes between -the elements and appending a number of file name extensions from the -list @code{%load-extensions} (@pxref{Loading}). The resulting file -name is then searched in all directories in the variable -@code{%load-path} (@pxref{Install Config}). For example, the -@code{(ice-9 popen)} module would result in the filename -@code{ice-9/popen.scm} and searched in the installation directories of -Guile and in all other directories in the load path. +To use a module, it must be found and loaded. All Guile modules have a +unique @dfn{module name}, which is a list of one or more symbols. +Examples are @code{(ice-9 popen)} or @code{(srfi srfi-11)}. When Guile +searches for the code of a module, it constructs the name of the file to +load by concatenating the name elements with slashes between the +elements and appending a number of file name extensions from the list +@code{%load-extensions} (@pxref{Loading}). The resulting file name is +then searched in all directories in the variable @code{%load-path} +(@pxref{Build Config}). For example, the @code{(ice-9 popen)} module +would result in the filename @code{ice-9/popen.scm} and searched in the +installation directories of Guile and in all other directories in the +load path. @c FIXME::martin: Not sure about this, maybe someone knows better? Every module has a so-called syntax transformer associated with it. @@ -200,11 +200,11 @@ address these eventually. To use a Guile module is to access either its public interface or a custom interface (@pxref{General Information about Modules}). Both types of access are handled by the syntactic form @code{use-modules}, -which accepts one or more interface specifications and, upon -evaluation, arranges for those interfaces to be available to the -current module. This process may include locating and loading code -for a given module if that code has not yet been loaded, following -%load-path (@pxref{Install Config}). +which accepts one or more interface specifications and, upon evaluation, +arranges for those interfaces to be available to the current module. +This process may include locating and loading code for a given module if +that code has not yet been loaded, following %load-path (@pxref{Build +Config}). An @dfn{interface specification} has one of two forms. The first variation is simply to name the module, in which case its public diff --git a/doc/ref/scheme-options.texi b/doc/ref/scheme-options.texi index 63b7a2c57..0492ce9ed 100644 --- a/doc/ref/scheme-options.texi +++ b/doc/ref/scheme-options.texi @@ -1,371 +1,42 @@ @page @node Options and Config -@chapter Runtime Options and Configuration +@chapter Configuration, Features and Runtime Options -Guile's behaviour can be modified by setting options. For example, is -the language that Guile accepts case sensitive, or should the debugger -automatically show a backtrace on error? +Why is my Guile different from your Guile? There are three kinds of +possible variation: -Guile has two levels of interface for managing options: a low-level -control interface, and a user-level interface which allows the enabling -or disabling of options. +@itemize @bullet +@item +build differences --- different versions of the Guile source code, +installation directories, configuration flags that control pieces of +functionality being included or left out, etc. -Moreover, the options are classified in groups according to whether they -configure @emph{reading}, @emph{printing}, @emph{debugging} or -@emph{evaluating}. +@item +differences in dynamically loaded code --- behaviour and features +provided by modules that can be dynamically loaded into a running Guile + +@item +different runtime options --- some of the options that are provided for +controlling Guile's behaviour may be set differently. +@end itemize + +Guile provides ``introspective'' variables and procedures to query all +of these possible variations at runtime. For runtime options, it also +provides procedures to change the settings of options and to obtain +documentation on what the options mean. @menu -* General option interface:: -* Reader options:: -* Printing options:: -* Debugger options:: -* Evaluator options:: -* Evaluator trap options:: -* Examples of option use:: -* Install Config:: Installation and configuration data. +* Build Config:: Build and installation configuration. * Feature Tracking:: Available features in the Guile process. +* Runtime Options:: Controlling Guile's runtime behaviour. @end menu -@node General option interface -@section General option interface -We will use the expression @code{} to represent @code{read}, -@code{print}, @code{debug} or @code{evaluator}. +@node Build Config +@section Configuration, Build and Installation -@subheading Low level - -@c NJFIXME -@deffn {Scheme Procedure} -options-interface -@deffnx {Scheme Procedure} read-options-interface [SOME-INT] -@deffnx {Scheme Procedure} print-options-interface [SOME-INT] -@deffnx {Scheme Procedure} evaluator-traps-interface [SOME-INT] -@deffnx {Scheme Procedure} read-options-interface [SOME-INT] -[FIXME: I have just taken the comments for C routine scm_options that -implements all of these. It needs to be presented better.] - -If scm_options is called without arguments, the current option setting -is returned. If the argument is an option setting, options are altered -and the old setting is returned. If the argument isn't a list, a list -of sublists is returned, where each sublist contains option name, value -and documentation string. -@end deffn - - -@subheading User level - -@c @deftp {Data type} scm_option -@c @code{scm_option} is used to represent run time options. It can be a -@c @emph{boolean} type, in which case the option will be set by the strings -@c @code{"yes"} and @code{"no"}. It can be a -@c @end deftp - -@c NJFIXME -@deffn {Scheme Procedure} -options [arg] -@deffnx {Scheme Procedure} read-options [arg] -@deffnx {Scheme Procedure} print-options [arg] -@deffnx {Scheme Procedure} debug-options [arg] -@deffnx {Scheme Procedure} traps [arg] -These functions list the options in their group. The optional argument -@var{arg} is a symbol which modifies the form in which the options are -presented. - -With no arguments, @code{-options} returns the values of the -options in that particular group. If @var{arg} is @code{'help}, a -description of each option is given. If @var{arg} is @code{'full}, -programmers' options are also shown. - -@var{arg} can also be a list representing the state of all options. In -this case, the list contains single symbols (for enabled boolean -options) and symbols followed by values. -@end deffn -[FIXME: I don't think 'full is ever any different from 'help. What's -up?] - -@c NJFIXME -@deffn {Scheme Procedure} -enable option-symbol -@deffnx {Scheme Procedure} read-enable option-symbol -@deffnx {Scheme Procedure} print-enable option-symbol -@deffnx {Scheme Procedure} debug-enable option-symbol -@deffnx {Scheme Procedure} trap-enable option-symbol -These functions set the specified @var{option-symbol} in their options -group. They only work if the option is boolean, and throw an error -otherwise. -@end deffn - -@c NJFIXME -@deffn {Scheme Procedure} -disable option-symbol -@deffnx {Scheme Procedure} read-disable option-symbol -@deffnx {Scheme Procedure} print-disable option-symbol -@deffnx {Scheme Procedure} debug-disable option-symbol -@deffnx {Scheme Procedure} trap-disable option-symbol -These functions turn off the specified @var{option-symbol} in their -options group. They only work if the option is boolean, and throw an -error otherwise. -@end deffn - -@c NJFIXME -@deffn syntax -set! option-symbol value -@deffnx syntax read-set! option-symbol value -@deffnx syntax print-set! option-symbol value -@deffnx syntax debug-set! option-symbol value -@deffnx syntax trap-set! option-symbol value -These functions set a non-boolean @var{option-symbol} to the specified -@var{value}. -@end deffn - - -@node Reader options -@section Reader options -@cindex options - read -@cindex read options - -Here is the list of reader options generated by typing -@code{(read-options 'full)} in Guile. You can also see the default -values. - -@smalllisp -keywords #f Style of keyword recognition: #f or 'prefix -case-insensitive no Convert symbols to lower case. -positions yes Record positions of source code expressions. -copy no Copy source code expressions. -@end smalllisp - -Notice that while Standard Scheme is case insensitive, to ease -translation of other Lisp dialects, notably Emacs Lisp, into Guile, -Guile is case-sensitive by default. - -To make Guile case insensitive, you can type - -@smalllisp -(read-enable 'case-insensitive) -@end smalllisp - -@node Printing options -@section Printing options - -Here is the list of print options generated by typing -@code{(print-options 'full)} in Guile. You can also see the default -values. - -@smallexample -source no Print closures with source. -closure-hook #f Hook for printing closures. -@end smallexample - - -@node Evaluator options -@section Evaluator options - -These are the evaluator options with their default values, as they are -printed by typing @code{(eval-options 'full)} in Guile. - -@smallexample -stack 22000 Size of thread stacks (in machine words). -@end smallexample - -@node Evaluator trap options -@section Evaluator trap options -[FIXME: These flags, together with their corresponding handlers, are not -user level options. Probably this entire section should be moved to the -documentation about the low-level programmer debugging interface.] - -Here is the list of evaluator trap options generated by typing -@code{(traps 'full)} in Guile. You can also see the default values. - -@smallexample -exit-frame no Trap when exiting eval or apply. -apply-frame no Trap when entering apply. -enter-frame no Trap when eval enters new frame. -traps yes Enable evaluator traps. -@end smallexample - -@deffn apply-frame-handler key cont tailp -Called when a procedure is being applied. - -Called if: - -@itemize @bullet -@item -evaluator traps are enabled [traps interface], and -@item -either -@itemize @minus -@item -@code{apply-frame} is enabled [traps interface], or -@item -trace mode is on [debug-options interface], and the procedure being -called has the trace property enabled. -@end itemize -@end itemize - -If cheap traps are enabled [debug-options interface], @var{cont} is a -debug object, otherwise it is a restartable continuation. - -@var{tailp} is true if this is a tail call -@end deffn - -@deffn exit-frame-handler key cont retval -Called when a value is returned from a procedure. - -Called if: - -@itemize @bullet -@item -evaluator traps are enabled [traps interface], and -@item -either -@itemize @minus -@item - @code{exit-frame} is enabled [traps interface], or -@item -trace mode is on [debug-options interface], and the procedure being -called has the trace property enabled. -@end itemize -@end itemize - -If cheap traps are enabled [debug-options interface], @var{cont} is a -debug object, otherwise it is a restartable continuation. - -@var{retval} is the return value. -@end deffn - -@node Debugger options -@section Debugger options - -Here is the list of print options generated by typing -@code{(debug-options 'full)} in Guile. You can also see the default -values. - -@smallexample -stack 20000 Stack size limit (0 = no check). -debug yes Use the debugging evaluator. -backtrace no Show backtrace on error. -depth 20 Maximal length of printed backtrace. -maxdepth 1000 Maximal number of stored backtrace frames. -frames 3 Maximum number of tail-recursive frames in backtrace. -indent 10 Maximal indentation in backtrace. -backwards no Display backtrace in anti-chronological order. -procnames yes Record procedure names at definition. -trace no *Trace mode. -breakpoints no *Check for breakpoints. -cheap yes *Flyweight representation of the stack at traps. -@end smallexample - -@subsection Stack overflow - -@cindex overflow, stack -@cindex stack overflow -Stack overflow errors are caused by a computation trying to use more -stack space than has been enabled by the @code{stack} option. They are -reported like this: - -@lisp -(non-tail-recursive-factorial 500) -@print{} -ERROR: Stack overflow -ABORT: (stack-overflow) -@end lisp - -If you get an error like this, you can either try rewriting your code to -use less stack space, or increase the maximum stack size. To increase -the maximum stack size, use @code{debug-set!}, for example: - -@lisp -(debug-set! stack 200000) -@result{} -(show-file-name #t stack 200000 debug backtrace depth 20 maxdepth 1000 frames 3 indent 10 width 79 procnames cheap) - -(non-tail-recursive-factorial 500) -@result{} -122013682599111006870123878542304692625357434@dots{} -@end lisp - -If you prefer to try rewriting your code, you may be able to save stack -space by making some of your procedures @dfn{tail recursive}. For a -description of what this means, see @ref{Proper tail -recursion,,,r5rs,The Revised^5 Report on Scheme}. - - -@node Examples of option use -@section Examples of option use - -Here is an example of a session in which some read and debug option -handling procedures are used. In this example, the user - -@enumerate -@item -Notices that the symbols @code{abc} and @code{aBc} are not the same -@item -Examines the @code{read-options}, and sees that @code{case-insensitive} -is set to ``no''. -@item -Enables @code{case-insensitive} -@item -Verifies that now @code{aBc} and @code{abc} are the same -@item -Disables @code{case-insensitive} and enables debugging @code{backtrace} -@item -Reproduces the error of displaying @code{aBc} with backtracing enabled -[FIXME: this last example is lame because there is no depth in the -backtrace. Need to give a better example, possibly putting debugging -option examples in a separate session.] -@end enumerate - - -@smalllisp -guile> (define abc "hello") -guile> abc -"hello" -guile> aBc -ERROR: In expression aBc: -ERROR: Unbound variable: aBc -ABORT: (misc-error) - -Type "(backtrace)" to get more information. -guile> (read-options 'help) -keywords #f Style of keyword recognition: #f or 'prefix -case-insensitive no Convert symbols to lower case. -positions yes Record positions of source code expressions. -copy no Copy source code expressions. -guile> (debug-options 'help) -stack 20000 Stack size limit (0 = no check). -debug yes Use the debugging evaluator. -backtrace no Show backtrace on error. -depth 20 Maximal length of printed backtrace. -maxdepth 1000 Maximal number of stored backtrace frames. -frames 3 Maximum number of tail-recursive frames in backtrace. -indent 10 Maximal indentation in backtrace. -backwards no Display backtrace in anti-chronological order. -procnames yes Record procedure names at definition. -trace no *Trace mode. -breakpoints no *Check for breakpoints. -cheap yes *Flyweight representation of the stack at traps. -guile> (read-enable 'case-insensitive) -(keywords #f case-insensitive positions) -guile> aBc -"hello" -guile> (read-disable 'case-insensitive) -(keywords #f positions) -guile> (debug-enable 'backtrace) -(stack 20000 debug backtrace depth 20 maxdepth 1000 frames 3 indent 10 procnames cheap) -guile> aBc - -Backtrace: -0* aBc - -ERROR: In expression aBc: -ERROR: Unbound variable: aBc -ABORT: (misc-error) -guile> -@end smalllisp - - -@node Install Config -@section Installation and Configuration Data - -It is often useful to have site-specific information about the current -Guile installation. This chapter describes how to find out about -Guile's configuration at run time. +The following procedures and variables provide information about how +Guile was configured, built and installed on your system. @deffn {Scheme Procedure} version @deffnx {Scheme Procedure} major-version @@ -386,33 +57,39 @@ or micro version number, respectively. @end lisp @end deffn -@c NJFIXME not in libguile! -@deffn {Scheme Procedure} libguile-config-stamp -Return a string describing the date on which @code{libguile} was -configured. This is used to determine whether the Guile core -interpreter and the ice-9 runtime have grown out of date with one -another. -@end deffn - @deffn {Scheme Procedure} %package-data-dir @deffnx {C Function} scm_sys_package_data_dir () -Return the name of the directory where Scheme packages, modules and -libraries are kept. On most Unix systems, this will be -@samp{/usr/local/share/guile}. +Return the name of the directory under which Guile Scheme files in +general are stored. On Unix-like systems, this is usually +@file{/usr/local/share/guile} or @file{/usr/share/guile}. @end deffn @deffn {Scheme Procedure} %library-dir @deffnx {C Function} scm_sys_library_dir () -Return the directory where the Guile Scheme library files are installed. -E.g., may return "/usr/share/guile/1.3.5". +Return the name of the directory where the Guile Scheme files that +belong to the core Guile installation (as opposed to files from a 3rd +party package) are installed. On Unix-like systems, this is usually +@file{/usr/local/share/guile/} or +@file{/usr/share/guile/}, for example: +@file{/usr/local/share/guile/1.6.0}. @end deffn @deffn {Scheme Procedure} %site-dir @deffnx {C Function} scm_sys_site_dir () -Return the directory where the Guile site files are installed. -E.g., may return "/usr/share/guile/site". +Return the name of the directory where Guile Scheme files specific to +your site should be installed. On Unix-like systems, this is usually +@file{/usr/local/share/guile/site} or @file{/usr/share/guile/site}. @end deffn +@cindex GUILE_LOAD_PATH +@defvar %load-path +List of directories which should be searched for Scheme modules and +libraries. @code{%load-path} is initialized when Guile starts up to +@code{(list (%site-dir) (%library-dir) (%package-data-dir) ".")}, +prepended with the contents of the GUILE_LOAD_PATH environment variable, +if it is set. +@end defvar + @deffn {Scheme Procedure} parse-path path [tail] @deffnx {C Function} scm_parse_path (path, tail) Parse @var{path}, which is expected to be a colon-separated @@ -432,34 +109,30 @@ directory in @var{path}, we search for @var{filename} concatenated with each @var{extension}. @end deffn -@defvar %load-path -List of directories which should be searched for Scheme -modules and libraries. -@end defvar - @defvar %guile-build-info Alist of information collected during the building of a particular -@code{guile} program. Entries can be grouped into one of several -categories: directories, env vars, and versioning info. +Guile. Entries can be grouped into one of several categories: +directories, env vars, and versioning info. Briefly, here are the keys in @code{%guile-build-info}, by group: -@itemize @bullet -@item directories + +@table @asis +@item directories srcdir, top_srcdir, prefix, exec_prefix, bindir, sbindir, libexecdir, datadir, sysconfdir, sharedstatedir, localstatedir, libdir, infodir, mandir, includedir, pkgdatadir, pkglibdir, pkgincludedir -@item env vars +@item env vars LIBS -@item versioning info +@item versioning info guileversion, libguileinterface, buildstamp -@end itemize +@end table -Values are all strings. The value for @code{LIBS} is typically found also as -a part of "guile-config link" output. The value for @code{guileversion} has -form X.Y.Z, and should be the same as returned by @code{version}. The value -for @code{libguileinterface} is libtool compatible and has form -CURRENT:REVISION:AGE. The value for @code{buildstamp} is the output of the -date(1) command. +Values are all strings. The value for @code{LIBS} is typically found +also as a part of "guile-config link" output. The value for +@code{guileversion} has form X.Y.Z, and should be the same as returned +by @code{(version)}. The value for @code{libguileinterface} is libtool +compatible and has form CURRENT:REVISION:AGE. The value for +@code{buildstamp} is the output of the date(1) command. In the source, @code{%guile-build-info} is initialized from libguile/libpath.h, which is completely generated, so deleting this file @@ -646,6 +319,377 @@ is probably safer to do so directly using the @code{defined?} procedure than to test for the corresponding feature using @code{feature?}. +@node Runtime Options +@section Runtime Options + +Guile's runtime behaviour can be modified by setting options. For +example, is the language that Guile accepts case sensitive, or should +the debugger automatically show a backtrace on error? + +Guile has two levels of interface for managing options: a low-level +control interface, and a user-level interface which allows the enabling +or disabling of options. + +Moreover, the options are classified in groups according to whether they +configure @emph{reading}, @emph{printing}, @emph{debugging} or +@emph{evaluating}. + +@menu +* Low level options interfaces:: +* User level options interfaces:: +* Reader options:: +* Printing options:: +* Debugger options:: +* Evaluator options:: +* Evaluator trap options:: +* Examples of option use:: +@end menu + + +@node Low level options interfaces +@subsection Low Level Options Interfaces + +@deffn {Scheme Procedure} read-options-interface [setting] +@deffnx {Scheme Procedure} eval-options-interface [setting] +@deffnx {Scheme Procedure} print-options-interface [setting] +@deffnx {Scheme Procedure} debug-options-interface [setting] +@deffnx {Scheme Procedure} evaluator-traps-interface [setting] +@deffnx {C Function} scm_read_options (setting) +@deffnx {C Function} scm_eval_options_interface (setting) +@deffnx {C Function} scm_print_options (setting) +@deffnx {C Function} scm_debug_options (setting) +@deffnx {C Function} scm_evaluator_traps (setting) +If one of these procedures is called with no arguments (or with +@code{setting == SCM_UNDEFINED} in C code), it returns a list describing +the current setting of the read, eval, print, debug or evaluator traps +options respectively. The setting of a boolean option is indicated +simply by the presence or absence of the option symbol in the list. The +setting of a non-boolean option is indicated by the presence of the +option symbol immediately followed by the option's current value. + +If called with a list argument, these procedures interpret the list as +an option setting and modify the relevant options accordingly. [FIXME +--- this glosses over a lot of details!] + +If called with any other argument, such as @code{'help}, these +procedures return a list of entries like @code{(@var{OPTION-SYMBOL} +@var{DEFAULT-VALUE} @var{DOC-STRING})}, with each entry giving the +default value and documentation for each option symbol in the relevant +set of options. +@end deffn + + +@node User level options interfaces +@subsection User Level Options Interfaces + +@c @deftp {Data type} scm_option +@c @code{scm_option} is used to represent run time options. It can be a +@c @emph{boolean} type, in which case the option will be set by the strings +@c @code{"yes"} and @code{"no"}. It can be a +@c @end deftp + +@c NJFIXME +@deffn {Scheme Procedure} -options [arg] +@deffnx {Scheme Procedure} read-options [arg] +@deffnx {Scheme Procedure} print-options [arg] +@deffnx {Scheme Procedure} debug-options [arg] +@deffnx {Scheme Procedure} traps [arg] +These functions list the options in their group. The optional argument +@var{arg} is a symbol which modifies the form in which the options are +presented. + +With no arguments, @code{-options} returns the values of the +options in that particular group. If @var{arg} is @code{'help}, a +description of each option is given. If @var{arg} is @code{'full}, +programmers' options are also shown. + +@var{arg} can also be a list representing the state of all options. In +this case, the list contains single symbols (for enabled boolean +options) and symbols followed by values. +@end deffn +[FIXME: I don't think 'full is ever any different from 'help. What's +up?] + +@c NJFIXME +@deffn {Scheme Procedure} -enable option-symbol +@deffnx {Scheme Procedure} read-enable option-symbol +@deffnx {Scheme Procedure} print-enable option-symbol +@deffnx {Scheme Procedure} debug-enable option-symbol +@deffnx {Scheme Procedure} trap-enable option-symbol +These functions set the specified @var{option-symbol} in their options +group. They only work if the option is boolean, and throw an error +otherwise. +@end deffn + +@c NJFIXME +@deffn {Scheme Procedure} -disable option-symbol +@deffnx {Scheme Procedure} read-disable option-symbol +@deffnx {Scheme Procedure} print-disable option-symbol +@deffnx {Scheme Procedure} debug-disable option-symbol +@deffnx {Scheme Procedure} trap-disable option-symbol +These functions turn off the specified @var{option-symbol} in their +options group. They only work if the option is boolean, and throw an +error otherwise. +@end deffn + +@c NJFIXME +@deffn syntax -set! option-symbol value +@deffnx syntax read-set! option-symbol value +@deffnx syntax print-set! option-symbol value +@deffnx syntax debug-set! option-symbol value +@deffnx syntax trap-set! option-symbol value +These functions set a non-boolean @var{option-symbol} to the specified +@var{value}. +@end deffn + + +@node Reader options +@subsection Reader options +@cindex options - read +@cindex read options + +Here is the list of reader options generated by typing +@code{(read-options 'full)} in Guile. You can also see the default +values. + +@smalllisp +keywords #f Style of keyword recognition: #f or 'prefix +case-insensitive no Convert symbols to lower case. +positions yes Record positions of source code expressions. +copy no Copy source code expressions. +@end smalllisp + +Notice that while Standard Scheme is case insensitive, to ease +translation of other Lisp dialects, notably Emacs Lisp, into Guile, +Guile is case-sensitive by default. + +To make Guile case insensitive, you can type + +@smalllisp +(read-enable 'case-insensitive) +@end smalllisp + +@node Printing options +@subsection Printing options + +Here is the list of print options generated by typing +@code{(print-options 'full)} in Guile. You can also see the default +values. + +@smallexample +source no Print closures with source. +closure-hook #f Hook for printing closures. +@end smallexample + + +@node Evaluator options +@subsection Evaluator options + +These are the evaluator options with their default values, as they are +printed by typing @code{(eval-options 'full)} in Guile. + +@smallexample +stack 22000 Size of thread stacks (in machine words). +@end smallexample + + +@node Evaluator trap options +@subsection Evaluator trap options +[FIXME: These flags, together with their corresponding handlers, are not +user level options. Probably this entire section should be moved to the +documentation about the low-level programmer debugging interface.] + +Here is the list of evaluator trap options generated by typing +@code{(traps 'full)} in Guile. You can also see the default values. + +@smallexample +exit-frame no Trap when exiting eval or apply. +apply-frame no Trap when entering apply. +enter-frame no Trap when eval enters new frame. +traps yes Enable evaluator traps. +@end smallexample + +@deffn apply-frame-handler key cont tailp +Called when a procedure is being applied. + +Called if: + +@itemize @bullet +@item +evaluator traps are enabled [traps interface], and +@item +either +@itemize @minus +@item +@code{apply-frame} is enabled [traps interface], or +@item +trace mode is on [debug-options interface], and the procedure being +called has the trace property enabled. +@end itemize +@end itemize + +If cheap traps are enabled [debug-options interface], @var{cont} is a +debug object, otherwise it is a restartable continuation. + +@var{tailp} is true if this is a tail call +@end deffn + +@deffn exit-frame-handler key cont retval +Called when a value is returned from a procedure. + +Called if: + +@itemize @bullet +@item +evaluator traps are enabled [traps interface], and +@item +either +@itemize @minus +@item + @code{exit-frame} is enabled [traps interface], or +@item +trace mode is on [debug-options interface], and the procedure being +called has the trace property enabled. +@end itemize +@end itemize + +If cheap traps are enabled [debug-options interface], @var{cont} is a +debug object, otherwise it is a restartable continuation. + +@var{retval} is the return value. +@end deffn + +@node Debugger options +@subsection Debugger options + +Here is the list of print options generated by typing +@code{(debug-options 'full)} in Guile. You can also see the default +values. + +@smallexample +stack 20000 Stack size limit (0 = no check). +debug yes Use the debugging evaluator. +backtrace no Show backtrace on error. +depth 20 Maximal length of printed backtrace. +maxdepth 1000 Maximal number of stored backtrace frames. +frames 3 Maximum number of tail-recursive frames in backtrace. +indent 10 Maximal indentation in backtrace. +backwards no Display backtrace in anti-chronological order. +procnames yes Record procedure names at definition. +trace no *Trace mode. +breakpoints no *Check for breakpoints. +cheap yes *Flyweight representation of the stack at traps. +@end smallexample + +@subsubsection Stack overflow + +@cindex overflow, stack +@cindex stack overflow +Stack overflow errors are caused by a computation trying to use more +stack space than has been enabled by the @code{stack} option. They are +reported like this: + +@lisp +(non-tail-recursive-factorial 500) +@print{} +ERROR: Stack overflow +ABORT: (stack-overflow) +@end lisp + +If you get an error like this, you can either try rewriting your code to +use less stack space, or increase the maximum stack size. To increase +the maximum stack size, use @code{debug-set!}, for example: + +@lisp +(debug-set! stack 200000) +@result{} +(show-file-name #t stack 200000 debug backtrace depth 20 maxdepth 1000 frames 3 indent 10 width 79 procnames cheap) + +(non-tail-recursive-factorial 500) +@result{} +122013682599111006870123878542304692625357434@dots{} +@end lisp + +If you prefer to try rewriting your code, you may be able to save stack +space by making some of your procedures @dfn{tail recursive}. For a +description of what this means, see @ref{Proper tail +recursion,,,r5rs,The Revised^5 Report on Scheme}. + + +@node Examples of option use +@subsection Examples of option use + +Here is an example of a session in which some read and debug option +handling procedures are used. In this example, the user + +@enumerate +@item +Notices that the symbols @code{abc} and @code{aBc} are not the same +@item +Examines the @code{read-options}, and sees that @code{case-insensitive} +is set to ``no''. +@item +Enables @code{case-insensitive} +@item +Verifies that now @code{aBc} and @code{abc} are the same +@item +Disables @code{case-insensitive} and enables debugging @code{backtrace} +@item +Reproduces the error of displaying @code{aBc} with backtracing enabled +[FIXME: this last example is lame because there is no depth in the +backtrace. Need to give a better example, possibly putting debugging +option examples in a separate session.] +@end enumerate + + +@smalllisp +guile> (define abc "hello") +guile> abc +"hello" +guile> aBc +ERROR: In expression aBc: +ERROR: Unbound variable: aBc +ABORT: (misc-error) + +Type "(backtrace)" to get more information. +guile> (read-options 'help) +keywords #f Style of keyword recognition: #f or 'prefix +case-insensitive no Convert symbols to lower case. +positions yes Record positions of source code expressions. +copy no Copy source code expressions. +guile> (debug-options 'help) +stack 20000 Stack size limit (0 = no check). +debug yes Use the debugging evaluator. +backtrace no Show backtrace on error. +depth 20 Maximal length of printed backtrace. +maxdepth 1000 Maximal number of stored backtrace frames. +frames 3 Maximum number of tail-recursive frames in backtrace. +indent 10 Maximal indentation in backtrace. +backwards no Display backtrace in anti-chronological order. +procnames yes Record procedure names at definition. +trace no *Trace mode. +breakpoints no *Check for breakpoints. +cheap yes *Flyweight representation of the stack at traps. +guile> (read-enable 'case-insensitive) +(keywords #f case-insensitive positions) +guile> aBc +"hello" +guile> (read-disable 'case-insensitive) +(keywords #f positions) +guile> (debug-enable 'backtrace) +(stack 20000 debug backtrace depth 20 maxdepth 1000 frames 3 indent 10 procnames cheap) +guile> aBc + +Backtrace: +0* aBc + +ERROR: In expression aBc: +ERROR: Unbound variable: aBc +ABORT: (misc-error) +guile> +@end smalllisp + + @c Local Variables: @c TeX-master: "guile.texi" @c End: diff --git a/doc/ref/slib.texi b/doc/ref/slib.texi index 4d9e8c14c..a4eea1c19 100644 --- a/doc/ref/slib.texi +++ b/doc/ref/slib.texi @@ -2,8 +2,8 @@ @node SLIB @chapter SLIB -Before the the SLIB facilities can be used, the following Scheme -expression must be executed: +Before the SLIB facilities can be used, the following Scheme expression +must be executed: @smalllisp (use-modules (ice-9 slib)) From 878caca5e3bce59270b56dcc07828b82ce2455b6 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 15:25:04 +0000 Subject: [PATCH 180/306] (How guile-snarf works): Updated. (Writing your own snarfing macros): New. --- doc/ref/tools.texi | 119 +++++++++++++++++++++++---------------------- 1 file changed, 62 insertions(+), 57 deletions(-) diff --git a/doc/ref/tools.texi b/doc/ref/tools.texi index 061e34477..e3e588117 100644 --- a/doc/ref/tools.texi +++ b/doc/ref/tools.texi @@ -60,8 +60,9 @@ generate a file of calls to @code{scm_c_define_gsubr} which you can @code{#include} into an initialization function. @menu -* How guile-snarf works:: Using @code{guile-snarf}, with example. -* Macros guile-snarf recognizes:: How to mark up code for @code{guile-snarf}. +* How guile-snarf works:: Using @code{guile-snarf}, with example. +* Macros guile-snarf recognizes:: How to mark up code for @code{guile-snarf}. +* Writing your own snarfing macros:: How to define new things to snarf. @end menu @c --------------------------------------------------------------------------- @@ -70,32 +71,29 @@ generate a file of calls to @code{scm_c_define_gsubr} which you can @cindex guile-snarf invocation @cindex guile-snarf example -Usage: guile-snarf [-d | -D] [-o OUTFILE] INFILE [CPP-OPTIONS ...] +Usage: guile-snarf [-o @var{outfile}] [@var{cpp-args} ...] -What @code{guile-snarf} does: +The @code{guile-snarf} program will extract initialization actions to +@var{outfile} or to standard output when no @var{outfile} has been +specified or when @var{outfile} is @code{-}. The C preprocessor is +called with @var{cpp-args} (which usually include an input file) and +the output is filtered to extract the initialization actions. -Process INFILE using the C pre-processor and some other programs. -Write output to a file named OUTFILE or to the standard output when no -OUTFILE has been specified or when OUTFILE is @code{-}. When writing -to a file, ignore lines from the input matching the following grep(1) -regular expression: - -@example - ^#include ".*OUTFILE" -@end example - -If there are errors during processing, delete OUTFILE and exit with -non-zero status. - -Optional arg "-d" means grep INFILE for deprecated macros and -issue a warning if any are found. Alternatively, "-D" means -do the same thing but signal error and exit with non-zero status. - -If env var CPP is set, use its value instead of the C pre-processor -determined at Guile configure-time. +If there are errors during processing, @var{outfile} is deleted and the +program exits with non-zero status. During snarfing, the pre-processor macro @code{SCM_MAGIC_SNARFER} is -defined. +defined. You could use this to avoid including snarfer output files +that don't yet exist by writing code like this: + +@smallexample +#ifndef SCM_MAGIC_SNARFER +#include "foo.x" +#endif +@end smallexample + +If the environment variable @code{CPP} is set, use its value instead of the +C pre-processor determined at Guile configure-time. @xref{Macros guile-snarf recognizes}, for a list of the special (some would say magic) cpp macros you can use, including the list of deprecated macros. @@ -112,7 +110,7 @@ SCM_DEFINE (clear_image, "clear-image", 1, 0, 0, "Clear the image.") #define FUNC_NAME s_clear_image @{ - /* C code to clear the image... */ + /* C code to clear the image in @code{image_smob}... */ @} #undef FUNC_NAME @@ -126,8 +124,8 @@ init_image_type () The @code{SCM_DEFINE} declaration says that the C function @code{clear_image} implements a Scheme subr called @code{clear-image}, -which takes one required argument (type @code{SCM} named -@code{image_smob}), no optional arguments, and no tail argument. +which takes one required argument (of type @code{SCM} and named +@code{image_smob}), no optional arguments, and no rest argument. @xref{Doc Snarfing}, for info on the docstring. This works in concert with @code{FUNC_NAME} to also define a static @@ -140,7 +138,7 @@ Assuming the text above lives in a file named @file{image-type.c}, you will need to execute the following command to prepare this file for compilation: @example -guile-snarf image-type.c +guile-snarf -o image-type.x image-type.c @end example This scans @file{image-type.c} for @code{SCM_DEFINE} @@ -150,8 +148,9 @@ declarations, and writes to @file{image-type.x} the output: scm_c_define_gsubr (s_clear_image, 1, 0, 0, (SCM (*)() ) clear_image); @end example -When compiled normally, @code{SCM_DEFINE} is a macro which expands to a -declaration of the @code{s_clear_image} string. +When compiled normally, @code{SCM_DEFINE} is a macro which expands to +a declaration of the @code{s_clear_image} string and the function +header for @code{clear_image}. Note that the output file name matches the @code{#include} from the input file. Also, you still need to provide all the same information @@ -172,11 +171,11 @@ snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) This tells make to run @code{guile-snarf} to produce each needed @file{.x} file from the corresponding @file{.c} file. -Aside from the required argument INFILE, @code{guile-snarf} passes its -command-line arguments directly to the C preprocessor, which it uses to -extract the information it needs from the source code. this means you can pass -normal compilation flags to @code{guile-snarf} to define preprocessor symbols, -add header file directories, and so on. +The program @code{guile-snarf} passes its command-line arguments +directly to the C preprocessor, which it uses to extract the +information it needs from the source code. this means you can pass +normal compilation flags to @code{guile-snarf} to define preprocessor +symbols, add header file directories, and so on. @c --------------------------------------------------------------------------- @node Macros guile-snarf recognizes @@ -225,40 +224,46 @@ ARGLIST is an argument list (in parentheses); and lastly, @var{init_val} is a expression suitable for initializing a new variable. For procedures, you can use @code{SCM_DEFINE} for most purposes. Use -@code{SCM_PROC} along with @code{SCM_REGISTER_PROC} when you don't want -to be bothered with docstrings. Use @code{SCM_GPROC} for generic -functions (@pxref{GOOPS,,,goops}). All procedures are declared -@code{static} with return type @code{SCM}. +@code{SCM_PROC} along with @code{SCM_REGISTER_PROC} when you don't +want to be bothered with docstrings. Use @code{SCM_GPROC} for generic +functions (@pxref{GOOPS,,,goops}). All procedures are declared with +return type @code{SCM}. For everything else, use the appropriate macro (@code{SCM_SYMBOL} for -symbols, and so on). The "_GLOBAL_" variants omit @code{static} -declaration. +symbols, and so on). Without "_GLOBAL_", the declarations are +@code{static}. All these macros should be used at top-level, outside function bodies. Also, it's a good idea to define @var{FUNC_NAME} immediately after using @code{SCM_DEFINE} (and similar), and then the function body, and then @code{#undef FUNC_NAME}. -Here is the list of deprecated macros: - -@c reminder: sync w/ libguile/guile-snarf.in var `deprecated_list' -@example - SCM_CONST_LONG - SCM_VCELL - SCM_VCELL_INIT - SCM_GLOBAL_VCELL - SCM_GLOBAL_VCELL_INIT -@end example - -Some versions of guile (and guile-snarf) will continue to recognize them but -at some point they will no longer work. You can pass either @code{-d} or -@code{-D} option to have guile-snarf warn or signal error, respectively, if -any of these are found in the input file. - @xref{How guile-snarf works}, and also libguile source, for examples. @xref{Subrs}, for details on argument passing and how to write C functions. +@c --------------------------------------------------------------------------- +@node Writing your own snarfing macros +@subsubsection Writing your own snarfing macros + +When you want to use the general snarfing machanism, but none of the +provided macros fits your need, you can use the macro +@code{SCM_SNARF_INIT}. + +For example, the @code{SCM_SYMBOL} macro can be defined like this: + +@example +#define SCM_SYMBOL(c_name, scheme_name) \ +static SCM c_name \ +SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name))) +@end example + +@defmac SCM_SNARF_INIT (code) +When processed normally, @code{SCM_SNARF_INIT} expands to nothing; +when processed by the snarfer, it causes @var{code} to be included in +the initialization action file, followed by a semicolon. +@end defmac + @c --------------------------------------------------------------------------- @node Doc Snarfing @subsection Doc Snarfing From ba20db9bc15d43b8241def7836fe2fcb930748d8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 15:25:12 +0000 Subject: [PATCH 181/306] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index bbd18a228..1fb625e0c 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-10-03 Marius Vollmer + + * tools.texi (How guile-snarf works): Updated. + (Writing your own snarfing macros): New. + 2002-09-25 Neil Jerram * scheme-debug.texi (Debugging): Make sections into nodes. From 8734ce02b1917411da2d28eec4d1a1bebd97e185 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 15:30:21 +0000 Subject: [PATCH 182/306] *** empty log message *** --- NEWS | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS b/NEWS index afc95bfa7..bcefed180 100644 --- a/NEWS +++ b/NEWS @@ -113,6 +113,8 @@ during evaluation, but prior to evaluation. This is like SCM_DEFINE, but also calls scm_c_export for the defined function in the init section. +** The snarfer macro SCM_SNARF_INIT is now officially supported. + ** New macros SCM_VECTOR_REF and SCM_VECTOR_SET. Use these in preference to SCM_VELTS. From 6c26e47ba9c6d5c569b8e53e86d188981cf8b1fd Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 21:57:09 +0000 Subject: [PATCH 183/306] Added locally hacked copy of libltdl. --- libltdl/Makefile.am | 0 libltdl/README | 0 libltdl/acinclude.m4 | 0 libltdl/configure.in | 0 libltdl/ltdl.c | 0 libltdl/ltdl.h | 0 6 files changed, 0 insertions(+), 0 deletions(-) create mode 100644 libltdl/Makefile.am create mode 100644 libltdl/README create mode 100644 libltdl/acinclude.m4 create mode 100644 libltdl/configure.in create mode 100644 libltdl/ltdl.c create mode 100644 libltdl/ltdl.h diff --git a/libltdl/Makefile.am b/libltdl/Makefile.am new file mode 100644 index 000000000..e69de29bb diff --git a/libltdl/README b/libltdl/README new file mode 100644 index 000000000..e69de29bb diff --git a/libltdl/acinclude.m4 b/libltdl/acinclude.m4 new file mode 100644 index 000000000..e69de29bb diff --git a/libltdl/configure.in b/libltdl/configure.in new file mode 100644 index 000000000..e69de29bb diff --git a/libltdl/ltdl.c b/libltdl/ltdl.c new file mode 100644 index 000000000..e69de29bb diff --git a/libltdl/ltdl.h b/libltdl/ltdl.h new file mode 100644 index 000000000..e69de29bb From 65ded5d06c26815ebe4f2eae5884570dd31128a9 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 21:57:42 +0000 Subject: [PATCH 184/306] New file. --- libltdl/COPYING.LIB | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 libltdl/COPYING.LIB diff --git a/libltdl/COPYING.LIB b/libltdl/COPYING.LIB new file mode 100644 index 000000000..e69de29bb From c70f1244b00b6390d30b069bbf9b7f93ff049f9f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 21:58:30 +0000 Subject: [PATCH 185/306] Removed libltdl. --- .cvsignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.cvsignore b/.cvsignore index cdcf44864..7e0793c94 100644 --- a/.cvsignore +++ b/.cvsignore @@ -14,7 +14,6 @@ config.sub configure guile-*.tar.gz guile-tools -libltdl libtool ltconfig ltmain.sh From abd2bc18614a6d2e6ac28689d0e7727ca465f170 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:02:14 +0000 Subject: [PATCH 186/306] Use AC_LIBLTDL_CONVENIENCE instead of AC_LIBLTDL_INSTALLABLE. --- configure.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.in b/configure.in index 0b459bcba..1ac6d2c82 100644 --- a/configure.in +++ b/configure.in @@ -150,7 +150,7 @@ AC_CYGWIN AC_MINGW32 AC_LIBTOOL_WIN32_DLL -AC_LIBLTDL_INSTALLABLE +AC_LIBLTDL_CONVENIENCE AC_CONFIG_SUBDIRS(libltdl) AC_PROG_INSTALL From 99fd355abaf5faa55d0381eb0a6cb08431a74f0e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:02:27 +0000 Subject: [PATCH 187/306] *** empty log message *** --- ChangeLog | 11 +++++++++++ autogen.sh | 39 +-------------------------------------- 2 files changed, 12 insertions(+), 38 deletions(-) diff --git a/ChangeLog b/ChangeLog index a7cc991c2..f93272162 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2002-10-04 Marius Vollmer + + * configure.in: Use AC_LIBLTDL_CONVENIENCE instead of + AC_LIBLTDL_INSTALLABLE. + +2002-10-03 Marius Vollmer + + * autogen.sh: Do not instruct libtoolize to copy libltdl into our + sources. Do not patch it. We have our own version now that is + only being used as a convenience library. + 2002-08-24 Marius Vollmer * configure.in: Check for __libc_stack_end. diff --git a/autogen.sh b/autogen.sh index f06a127ac..c4924e6d8 100755 --- a/autogen.sh +++ b/autogen.sh @@ -44,44 +44,7 @@ $mscripts/render-bugs > BUGS ### Libtool setup. # Get a clean version. -rm -rf libltdl -libtoolize --force --copy --automake --ltdl - -# Fix older versions of libtool. -# Make sure we use a ./configure.in compatible autoconf in ./libltdl/ -if [ -f libltdl/configure.in ]; then - mv libltdl/configure.in libltdl/configure.tmp - echo 'AC_PREREQ(2.50)' > libltdl/configure.in - cat libltdl/configure.tmp >> libltdl/configure.in - rm libltdl/configure.tmp -fi - -# Maybe patch ltdl.c. This is only needed for 1.4.2 and earlier. -if patch libltdl/ltdl.c < Date: Thu, 3 Oct 2002 22:10:00 +0000 Subject: [PATCH 188/306] New file. --- libltdl/ChangeLog | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 libltdl/ChangeLog diff --git a/libltdl/ChangeLog b/libltdl/ChangeLog new file mode 100644 index 000000000..e69de29bb From 66add4ebf558f47afcc8bf5898d7dc4ebb7debe6 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 3 Oct 2002 22:16:17 +0000 Subject: [PATCH 189/306] Refer to provided? rather than the deprecated feature?. --- doc/ref/ChangeLog | 5 +++++ doc/ref/posix.texi | 8 ++++---- doc/ref/scheme-options.texi | 2 +- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 1fb625e0c..bdeafd188 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-10-03 Neil Jerram + + * posix.texi (Processes), scheme-options.texi (Common Feature + Symbols): Refer to provided? rather than deprecated feature?. + 2002-10-03 Marius Vollmer * tools.texi (How guile-snarf works): Updated. diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index dcac9d900..776f2485e 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -1229,7 +1229,7 @@ Return an integer representing the current real group ID. @deffnx {C Function} scm_geteuid () Return an integer representing the current effective user ID. If the system does not support effective IDs, then the real ID -is returned. @code{(feature? 'EIDs)} reports whether the +is returned. @code{(provided? 'EIDs)} reports whether the system supports effective IDs. @end deffn @@ -1237,7 +1237,7 @@ system supports effective IDs. @deffnx {C Function} scm_getegid () Return an integer representing the current effective group ID. If the system does not support effective IDs, then the real ID -is returned. @code{(feature? 'EIDs)} reports whether the +is returned. @code{(provided? 'EIDs)} reports whether the system supports effective IDs. @end deffn @@ -1259,7 +1259,7 @@ The return value is unspecified. @deffnx {C Function} scm_seteuid (id) Sets the effective user ID to the integer @var{id}, provided the process has appropriate privileges. If effective IDs are not supported, the -real ID is set instead -- @code{(feature? 'EIDs)} reports whether the +real ID is set instead -- @code{(provided? 'EIDs)} reports whether the system supports effective IDs. The return value is unspecified. @end deffn @@ -1268,7 +1268,7 @@ The return value is unspecified. @deffnx {C Function} scm_setegid (id) Sets the effective group ID to the integer @var{id}, provided the process has appropriate privileges. If effective IDs are not supported, the -real ID is set instead -- @code{(feature? 'EIDs)} reports whether the +real ID is set instead -- @code{(provided? 'EIDs)} reports whether the system supports effective IDs. The return value is unspecified. @end deffn diff --git a/doc/ref/scheme-options.texi b/doc/ref/scheme-options.texi index 0492ce9ed..425ff6a61 100644 --- a/doc/ref/scheme-options.texi +++ b/doc/ref/scheme-options.texi @@ -316,7 +316,7 @@ practice to rely on them, as the correspondences between feature symbols and available procedures/behaviour are not strictly defined. If you are writing code that needs to check for the existence of some procedure, it is probably safer to do so directly using the @code{defined?} procedure -than to test for the corresponding feature using @code{feature?}. +than to test for the corresponding feature using @code{provided?}. @node Runtime Options From 480fa28d20cd1a51bab03867bc077a047bc89dda Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 3 Oct 2002 22:23:43 +0000 Subject: [PATCH 190/306] Refer to provided? rather than the deprecated feature?. --- libguile/ChangeLog | 10 ++++++++++ libguile/posix.c | 8 ++++---- libguile/script.c | 4 ++-- 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 13ac529d0..1969205d8 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,13 @@ +2002-09-29 Neil Jerram + + * script.c (scm_compile_shell_switches): Fix bad spelling of + `explicitly' in comment. + +2002-09-28 Neil Jerram + + * posix.c (scm_geteuid, scm_getegid, scm_seteuid, scm_setegid): + Refer to provided? in doc string rather than deprecated feature?. + 2002-09-24 Gary Houston * inline.h (scm_double_cell): prevent reordering of statements diff --git a/libguile/posix.c b/libguile/posix.c index 3fac8efd0..45b175c6f 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -572,7 +572,7 @@ SCM_DEFINE (scm_geteuid, "geteuid", 0, 0, 0, (), "Return an integer representing the current effective user ID.\n" "If the system does not support effective IDs, then the real ID\n" - "is returned. @code{(feature? 'EIDs)} reports whether the\n" + "is returned. @code{(provided? 'EIDs)} reports whether the\n" "system supports effective IDs.") #define FUNC_NAME s_scm_geteuid { @@ -589,7 +589,7 @@ SCM_DEFINE (scm_getegid, "getegid", 0, 0, 0, (), "Return an integer representing the current effective group ID.\n" "If the system does not support effective IDs, then the real ID\n" - "is returned. @code{(feature? 'EIDs)} reports whether the\n" + "is returned. @code{(provided? 'EIDs)} reports whether the\n" "system supports effective IDs.") #define FUNC_NAME s_scm_getegid { @@ -634,7 +634,7 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0, (SCM id), "Sets the effective user ID to the integer @var{id}, provided the process\n" "has appropriate privileges. If effective IDs are not supported, the\n" - "real ID is set instead -- @code{(feature? 'EIDs)} reports whether the\n" + "real ID is set instead -- @code{(provided? 'EIDs)} reports whether the\n" "system supports effective IDs.\n" "The return value is unspecified.") #define FUNC_NAME s_scm_seteuid @@ -660,7 +660,7 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0, (SCM id), "Sets the effective group ID to the integer @var{id}, provided the process\n" "has appropriate privileges. If effective IDs are not supported, the\n" - "real ID is set instead -- @code{(feature? 'EIDs)} reports whether the\n" + "real ID is set instead -- @code{(provided? 'EIDs)} reports whether the\n" "system supports effective IDs.\n" "The return value is unspecified.") #define FUNC_NAME s_scm_setegid diff --git a/libguile/script.c b/libguile/script.c index dfbe74d13..f3d89dc3e 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -656,8 +656,8 @@ scm_compile_shell_switches (int argc, char **argv) } /* If debugging was requested, or we are interactive and debugging - was not explicitely turned off, turn on debugging. */ - if (turn_on_debugging || (interactive && !dont_turn_on_debugging)) + was not explicitly turned off, turn on debugging. */ + if (turn_on_debugging || (interactive && !dont_turn_on_debugging)) { tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail); } From 4e250dedc2c5dba2e52071d4d30d72c8432b89d2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:27:28 +0000 Subject: [PATCH 191/306] *** empty log message *** --- NEWS | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/NEWS b/NEWS index bcefed180..e1f4454c1 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,13 @@ Please send Guile bug reports to bug-guile@gnu.org. Changes since the stable branch: +* Changes to the distribution + +** Guile now includes its own version of libltdl. + +We now use a modified version of libltdl that allows us to make +improvements to it without having to rely on libtool releases. + * Changes to the standalone interpreter ** New command line option `--no-debug'. From 8e583c6e1b2e6b4c117db730aff60912130d5eac Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:44:48 +0000 Subject: [PATCH 192/306] Use scm_lt_ prefix for libltdl functions. --- libguile/dynl.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/libguile/dynl.c b/libguile/dynl.c index cb1e71fbd..b567796bc 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -1,6 +1,6 @@ /* dynl.c - dynamic linking * - * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc. + * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -91,14 +91,14 @@ static void * sysdep_dynl_link (const char *fname, const char *subr) { lt_dlhandle handle; - handle = lt_dlopenext (fname); + handle = scm_lt_dlopenext (fname); if (NULL == handle) { SCM fn; SCM msg; fn = scm_makfrom0str (fname); - msg = scm_makfrom0str (lt_dlerror ()); + msg = scm_makfrom0str (scm_lt_dlerror ()); scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg)); } return (void *) handle; @@ -107,9 +107,9 @@ sysdep_dynl_link (const char *fname, const char *subr) static void sysdep_dynl_unlink (void *handle, const char *subr) { - if (lt_dlclose ((lt_dlhandle) handle)) + if (scm_lt_dlclose ((lt_dlhandle) handle)) { - scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); + scm_misc_error (subr, (char *) scm_lt_dlerror (), SCM_EOL); } } @@ -118,10 +118,10 @@ sysdep_dynl_func (const char *symb, void *handle, const char *subr) { void *fptr; - fptr = lt_dlsym ((lt_dlhandle) handle, symb); + fptr = scm_lt_dlsym ((lt_dlhandle) handle, symb); if (!fptr) { - scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL); + scm_misc_error (subr, (char *) scm_lt_dlerror (), SCM_EOL); } return fptr; } @@ -129,7 +129,7 @@ sysdep_dynl_func (const char *symb, void *handle, const char *subr) static void sysdep_dynl_init () { - lt_dlinit (); + scm_lt_dlinit (); } scm_t_bits scm_tc16_dynamic_obj; From f7eca35dfe7461fe2a8eb9c6da18a0e921366db5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:48:15 +0000 Subject: [PATCH 193/306] * threads.h (scm_current_thread, scm_all_threads): New prototypes. * threads.c (scm_current_thread, scm_all_threads): Register as primitives. --- libguile/threads.c | 5 ++++- libguile/threads.h | 8 +++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/libguile/threads.c b/libguile/threads.c index 9c984f4e7..e06d7402c 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 1997, 1998, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -101,6 +101,9 @@ with-new-thread was evaluated, but not in the callers thread. All the evaluation rules for dynamic roots apply to threads. */ +SCM_REGISTER_PROC(s_current_thread, "current-thread", 0, 0, 0, scm_current_thread); +SCM_REGISTER_PROC(s_all_thread, "all-threads", 0, 0, 0, scm_all_threads); + SCM_REGISTER_PROC(s_join_thread, "join-thread", 1, 0, 0, scm_join_thread); /* Suspend execution of the calling thread until the target @var{thread} terminates, unless the target @var{thread} has already terminated. diff --git a/libguile/threads.h b/libguile/threads.h index cbd60f075..e4106b2b1 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -3,7 +3,7 @@ #ifndef SCM_THREADS_H #define SCM_THREADS_H -/* Copyright (C) 1996,1997,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -49,6 +49,7 @@ #include "libguile/__scm.h" #include "libguile/procs.h" #include "libguile/throw.h" +#include "libguile/root.h" @@ -100,6 +101,11 @@ SCM_API SCM scm_make_condition_variable (void); SCM_API SCM scm_wait_condition_variable (SCM cond, SCM mutex); SCM_API SCM scm_signal_condition_variable (SCM cond); +SCM_API SCM scm_current_thread (void); +SCM_API SCM scm_all_threads (void); + +SCM_API scm_root_state *scm_i_thread_root (SCM thread); + #ifdef USE_COOP_THREADS #include "libguile/coop-defs.h" #endif From 9997213b7d2385970ba90ad69df63460f1d6b962 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:53:17 +0000 Subject: [PATCH 194/306] * coop-defs.h (coop_t): Added new "handle" slot. * coop-threads.c (all_threads, scm_current_thread, scm_all_threads, scm_i_thread_root): New. (scm_threads_init): Add main thread to all_threads. (scheme_launch_thread): Remove thread from all_threads when it terminates. (scm_call_with_new_thread): Initialize handle slot of coop_t structure and add new thread to all_threads. (scm_spawn_thread): Likewise. --- libguile/coop-defs.h | 2 ++ libguile/coop-threads.c | 35 ++++++++++++++++++++++++++++++++++- 2 files changed, 36 insertions(+), 1 deletion(-) diff --git a/libguile/coop-defs.h b/libguile/coop-defs.h index 3863b1690..e84a352d3 100644 --- a/libguile/coop-defs.h +++ b/libguile/coop-defs.h @@ -104,6 +104,8 @@ typedef struct coop_t { void *joining; /* A queue of threads waiting to join this thread */ + SCM handle; /* SCM handle, protected via scm_all_threads. */ + #ifdef GUILE_ISELECT int nfds; SELECT_TYPE *readfds; diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index a3f4018e0..cf099cf60 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -59,6 +59,8 @@ size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT; coop_m scm_critical_section_mutex; +static SCM all_threads; + void scm_threads_init (SCM_STACKITEM *i) { @@ -76,6 +78,12 @@ scm_threads_init (SCM_STACKITEM *i) coop_mutex_init (&scm_critical_section_mutex); coop_global_main.data = 0; /* Initialized in init.c */ + + coop_global_main.handle = scm_cell (scm_tc16_thread, + (scm_t_bits) &coop_global_main); + + scm_gc_register_root (&all_threads); + all_threads = scm_cons (coop_global_main.handle, SCM_EOL); } void @@ -212,6 +220,7 @@ scheme_launch_thread (void *p) (SCM_STACKITEM *) &thread); SCM_SET_CELL_WORD_1 (thread, 0); scm_thread_count--; + all_threads = scm_delq (thread, all_threads); SCM_DEFER_INTS; } @@ -264,8 +273,10 @@ scm_call_with_new_thread (SCM argl) argl variable may not exist in memory when the thread starts. */ t = coop_create (scheme_launch_thread, (void *) argl); t->data = SCM_ROOT_STATE (root); + t->handle = thread; SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t); scm_thread_count++; + all_threads = scm_cons (thread, all_threads); /* Note that the following statement also could cause coop_yield.*/ SCM_ALLOW_INTS; @@ -353,10 +364,11 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, data->handler_data = handler_data; t = coop_create (c_launch_thread, (void *) data); - t->data = SCM_ROOT_STATE (root); + t->handle = thread; SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t); scm_thread_count++; + all_threads = scm_cons (thread, all_threads); /* Note that the following statement also could cause coop_yield.*/ SCM_ALLOW_INTS; @@ -369,6 +381,27 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, return thread; } +SCM +scm_current_thread (void) +{ + return coop_global_curr->handle; +} + +SCM +scm_all_threads (void) +{ + return all_threads; +} + +scm_root_state * +scm_i_thread_root (SCM thread) +#define FUNC_NAME "scm_i_thread_root" +{ + SCM_VALIDATE_THREAD (1, thread); + return (scm_root_state *)((coop_t *)SCM_THREAD_DATA (thread))->data; +} +#undef FUNC_NAME + SCM scm_join_thread (SCM thread) #define FUNC_NAME s_join_thread From 3b1df924800707bb8f0343f593cf2035fea4f031 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:54:25 +0000 Subject: [PATCH 195/306] (scm_root_state): Added new "active_asyncs" slot. --- libguile/root.h | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/libguile/root.h b/libguile/root.h index 7b0fb2a43..f332d0054 100644 --- a/libguile/root.h +++ b/libguile/root.h @@ -3,7 +3,7 @@ #ifndef SCM_ROOT_H #define SCM_ROOT_H -/* Copyright (C) 1996,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1996,1998,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -106,6 +106,9 @@ typedef struct scm_root_state SCM handle; /* The root object for this root state */ SCM parent; /* The parent root object */ + + SCM active_asyncs; /* The thunks to be run at the next + safe point */ } scm_root_state; #define scm_stack_base (scm_root->stack_base) @@ -123,7 +126,8 @@ typedef struct scm_root_state #define scm_cur_outp (scm_root->cur_outp) #define scm_cur_errp (scm_root->cur_errp) #define scm_cur_loadp (scm_root->cur_loadp) - +#define scm_active_asyncs (scm_root->active_asyncs) + #ifdef USE_THREADS #define scm_root ((scm_root_state *) SCM_THREAD_LOCAL_DATA) #define scm_set_root(new_root) SCM_SET_THREAD_LOCAL_DATA (new_root) From d4719ab89265bff48f083b4e029b801c8f69a906 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:56:52 +0000 Subject: [PATCH 196/306] * root.h (scm_root_state): Added new "active_asyncs" slot. * root.c (scm_make_root): Initialize it to SCM_EOL. --- libguile/root.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/libguile/root.c b/libguile/root.c index dd174db5b..6f7d20297 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000, 2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -128,6 +128,9 @@ scm_make_root (SCM parent) = root_state->parent = SCM_BOOL_F; } + + root_state->active_asyncs = SCM_EOL; + SCM_REDEFER_INTS; SCM_NEWSMOB (root, scm_tc16_root, root_state); root_state->handle = root; From a6b54e30d3ea90f4e92859e3490fedd359198e74 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 22:59:08 +0000 Subject: [PATCH 197/306] Removed GUILE_OLD_ASYNC_CLICK code. --- libguile/__scm.h | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/libguile/__scm.h b/libguile/__scm.h index a7829ba4a..f8a8ee7ac 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -406,15 +406,6 @@ typedef long SCM_STACKITEM; #define SCM_THREAD_SWITCHING_CODE #endif -#ifdef GUILE_OLD_ASYNC_CLICK -SCM_API unsigned int scm_async_clock; - -#define SCM_ASYNC_TICK \ -do { \ - if (0 == --scm_async_clock) \ - scm_async_click (); \ -} while(0) -#else SCM_API int scm_asyncs_pending_p; #define SCM_ASYNC_TICK /*fixme* should change names */ \ @@ -422,7 +413,6 @@ do { \ if (scm_asyncs_pending_p) \ scm_async_click (); \ } while (0) -#endif #if (SCM_DEBUG_INTERRUPTS == 1) #include From 61c95a4992409fbfd559dda293c2ffe37756a090 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 3 Oct 2002 23:00:58 +0000 Subject: [PATCH 198/306] (scm_system_async_mark_for_thread): New prototype. --- libguile/async.h | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libguile/async.h b/libguile/async.h index e27cd2ccb..48cf15aee 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -3,7 +3,7 @@ #ifndef SCM_ASYNC_H #define SCM_ASYNC_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -61,6 +61,7 @@ SCM_API SCM scm_async (SCM thunk); SCM_API SCM scm_system_async (SCM thunk); SCM_API SCM scm_async_mark (SCM a); SCM_API SCM scm_system_async_mark (SCM a); +SCM_API SCM scm_system_async_mark_for_thread (SCM a, SCM thread); SCM_API void scm_system_async_mark_from_signal_handler (SCM a); SCM_API SCM scm_run_asyncs (SCM list_of_a); SCM_API SCM scm_noop (SCM args); From f823f7e774ec6fbb24bb713d5f88a50ec2bf5404 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 4 Oct 2002 13:09:30 +0000 Subject: [PATCH 199/306] (top-repl): Use "1" instead of "%deliver-signals" to limit the signal stack. --- ice-9/boot-9.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 81b3ee3bb..6e6f1e1fb 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2872,7 +2872,7 @@ ;; Make a backup copy of the stack (fluid-set! before-signal-stack (fluid-ref the-last-stack)) - (save-stack %deliver-signals) + (save-stack 1) (scm-error 'signal #f msg From 3538c2b2a6d2199d1f061f4b326539eb68788ed2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 4 Oct 2002 13:09:45 +0000 Subject: [PATCH 200/306] *** empty log message *** --- ice-9/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 6774ea708..cf5517ab0 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2002-10-04 Marius Vollmer + + * boot-9.scm (top-repl): Use "1" instead of "%deliver-signals" to + limit the signal stack. + 2002-09-15 Marius Vollmer * boot-9.scm (feature?): Added deprecation message. From 2592c4c765c3d3b5820cf7f3518bf585e3e3ea58 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 4 Oct 2002 13:42:43 +0000 Subject: [PATCH 201/306] (scm_init_gc): Do not use scm_system_async. --- libguile/gc.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/libguile/gc.c b/libguile/gc.c index 0650b4180..9c5de1d92 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -981,17 +981,13 @@ mark_gc_async (void * hook_data SCM_UNUSED, void scm_init_gc () { - SCM after_gc_thunk; - - scm_gc_init_mark (); scm_after_gc_hook = scm_permanent_object (scm_make_hook (SCM_INUM0)); scm_c_define ("after-gc-hook", scm_after_gc_hook); - after_gc_thunk = scm_c_make_subr ("%gc-thunk", scm_tc7_subr_0, - gc_async_thunk); - gc_async = scm_system_async (after_gc_thunk); /* protected via scm_asyncs */ + gc_async = scm_c_make_subr ("%gc-thunk", scm_tc7_subr_0, + gc_async_thunk); scm_c_hook_add (&scm_after_gc_c_hook, mark_gc_async, NULL, 0); From 5b900ecff2f33b4815f54327e00584facb4c7164 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 4 Oct 2002 13:47:35 +0000 Subject: [PATCH 202/306] * async.h (scm_asyncs_pending, scm_set_tick_rate, scm_set_switch_rate, scm_system_async_mark_from_signal_handler): Removed prototypes. (scm_i_queue_async_cell): New. --- libguile/async.h | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/libguile/async.h b/libguile/async.h index 48cf15aee..64f1945af 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -47,6 +47,7 @@ #include "libguile/__scm.h" +#include "libguile/root.h" @@ -54,7 +55,6 @@ SCM_API unsigned int scm_mask_ints; -SCM_API int scm_asyncs_pending (void); SCM_API void scm_async_click (void); SCM_API void scm_switch (void); SCM_API SCM scm_async (SCM thunk); @@ -62,11 +62,9 @@ SCM_API SCM scm_system_async (SCM thunk); SCM_API SCM scm_async_mark (SCM a); SCM_API SCM scm_system_async_mark (SCM a); SCM_API SCM scm_system_async_mark_for_thread (SCM a, SCM thread); -SCM_API void scm_system_async_mark_from_signal_handler (SCM a); +SCM_API void scm_i_queue_async_cell (SCM cell, scm_root_state *); SCM_API SCM scm_run_asyncs (SCM list_of_a); SCM_API SCM scm_noop (SCM args); -SCM_API SCM scm_set_tick_rate (SCM n); -SCM_API SCM scm_set_switch_rate (SCM n); SCM_API SCM scm_unmask_signals (void); SCM_API SCM scm_mask_signals (void); SCM_API void scm_init_async (void); From 2d3179db77d2d3a1c1b51390278ba591ef28b448 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 4 Oct 2002 13:49:13 +0000 Subject: [PATCH 203/306] Removed GUILE_OLD_ASYNC_CLICK code. Reorganized so that system asnycs and user asyncs are separated. Reimplemented system asyncs to work per-thread. --- libguile/async.c | 375 ++++++++++++----------------------------------- 1 file changed, 97 insertions(+), 278 deletions(-) diff --git a/libguile/async.c b/libguile/async.c index f0a2b2eae..53edabda2 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -49,6 +49,7 @@ #include "libguile/root.h" #include "libguile/smob.h" #include "libguile/lang.h" +#include "libguile/deprecation.h" #include "libguile/validate.h" #include "libguile/async.h" @@ -64,28 +65,30 @@ /* {Asynchronous Events} * + * There are two kinds of asyncs: system asyncs and user asyncs. The + * two kinds have some concepts in commen but work slightly + * differently and are not interchangeable. * - * Async == thunk + mark. + * System asyncs are used to run arbitrary code at the next safe point + * in a specified thread. You can use them to trigger execution of + * Scheme code from signal handlers or to interrupt a thread, for + * example. * - * Setting the mark guarantees future execution of the thunk. More - * than one set may be satisfied by a single execution. + * Each thread has a list of 'activated asyncs', which is a normal + * Scheme list of procedures with zero arguments. When a thread + * executes a SCM_ASYNC_TICK statement (which is included in + * SCM_TICK), it will call all procedures on this list. * - * scm_tick_clock decremented once per SCM_ALLOW_INTS. - * Async execution triggered by SCM_ALLOW_INTS when scm_tick_clock drops to 0. - * Async execution prevented by scm_mask_ints != 0. + * Also, a thread will wake up when a procedure is added to its list + * of active asyncs and call them. After that, it will go to sleep + * again. (Not implemented yet.) * - * If the clock reaches 0 when scm_mask_ints != 0, then reset the clock - * to 1. - * - * If the clock reaches 0 any other time, run marked asyncs. - * - * From a unix signal handler, mark a corresponding async and set the clock - * to 1. Do SCM_REDEFER_INTS;/SCM_REALLOW_INTS so that if the signal handler is not - * called in the dynamic scope of a critical section, it is excecuted immediately. - * - * Overall, closely timed signals of a particular sort may be combined. Pending signals - * are delivered in a fixed priority order, regardless of arrival order. * + * User asyncs are a little data structure that consists of a + * procedure of zero arguments and a mark. There are functions for + * setting the mark of a user async and for calling all procedures of + * marked asyncs in a given list. Nothing you couldn't quickly + * implement yourself. */ /* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and @@ -94,24 +97,12 @@ int scm_ints_disabled = 1; unsigned int scm_mask_ints = 1; -#ifdef GUILE_OLD_ASYNC_CLICK -unsigned int scm_async_clock = 20; -static unsigned int scm_async_rate = 20; + -static unsigned int scm_tick_clock = 0; -static unsigned int scm_tick_rate = 0; -static unsigned int scm_desired_tick_rate = 0; -static unsigned int scm_switch_clock = 0; -static unsigned int scm_switch_rate = 0; -static unsigned int scm_desired_switch_rate = 0; -#else -int scm_asyncs_pending_p = 0; -#endif +/* User asyncs. */ static scm_t_bits tc16_async; - - /* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it. this is ugly. */ #define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X) @@ -121,169 +112,12 @@ static scm_t_bits tc16_async; #define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) << 16))) #define ASYNC_THUNK(X) SCM_CELL_OBJECT_1 (X) - - -#ifdef GUILE_OLD_ASYNC_CLICK -int -scm_asyncs_pending () -{ - SCM pos; - pos = scm_asyncs; - while (!SCM_NULL_OR_NIL_P (pos)) - { - SCM a = SCM_CAR (pos); - if (ASYNC_GOT_IT (a)) - return 1; - pos = SCM_CDR (pos); - } - return 0; -} - - -void -scm_async_click () -{ - int owe_switch; - int owe_tick; - - if (!scm_switch_rate) - { - owe_switch = 0; - scm_switch_clock = scm_switch_rate = scm_desired_switch_rate; - scm_desired_switch_rate = 0; - } - else - { - owe_switch = (scm_async_rate >= scm_switch_clock); - if (owe_switch) - { - if (scm_desired_switch_rate) - { - scm_switch_clock = scm_switch_rate = scm_desired_switch_rate; - scm_desired_switch_rate = 0; - } - else - scm_switch_clock = scm_switch_rate; - } - else - { - if (scm_desired_switch_rate) - { - scm_switch_clock = scm_switch_rate = scm_desired_switch_rate; - scm_desired_switch_rate = 0; - } - else - scm_switch_clock -= scm_async_rate; - } - } - - if (scm_mask_ints) - { - if (owe_switch) - scm_switch (); - scm_async_clock = 1; - return;; - } - - if (!scm_tick_rate) - { - unsigned int r; - owe_tick = 0; - r = scm_desired_tick_rate; - if (r) - { - scm_desired_tick_rate = 0; - scm_tick_rate = r; - scm_tick_clock = r; - } - } - else - { - owe_tick = (scm_async_rate >= scm_tick_clock); - if (owe_tick) - { - scm_tick_clock = scm_tick_rate = scm_desired_tick_rate; - scm_desired_tick_rate = 0; - } - else - { - if (scm_desired_tick_rate) - { - scm_tick_clock = scm_tick_rate = scm_desired_tick_rate; - scm_desired_tick_rate = 0; - } - else - scm_tick_clock -= scm_async_rate; - } - } - - SCM_DEFER_INTS; - if (scm_tick_rate && scm_switch_rate) - { - scm_async_rate = min (scm_tick_clock, scm_switch_clock); - scm_async_clock = scm_async_rate; - } - else if (scm_tick_rate) - { - scm_async_clock = scm_async_rate = scm_tick_clock; - } - else if (scm_switch_rate) - { - scm_async_clock = scm_async_rate = scm_switch_clock; - } - else - scm_async_clock = scm_async_rate = 1 << 16; - SCM_ALLOW_INTS_ONLY; - - tail: - scm_run_asyncs (scm_asyncs); - - SCM_DEFER_INTS; - if (scm_asyncs_pending ()) - { - SCM_ALLOW_INTS_ONLY; - goto tail; - } - SCM_ALLOW_INTS; - - if (owe_switch) - scm_switch (); -} - -void -scm_switch () -{ -#if 0 /* Thread switching code should probably reside here, but the - async switching code doesn't seem to work, so it's put in the - SCM_DEFER_INTS macro instead. /mdj */ - SCM_THREAD_SWITCHING_CODE; -#endif -} - -#else - -void -scm_async_click () -{ - if (!scm_mask_ints) - do - scm_run_asyncs (scm_asyncs); - while (scm_asyncs_pending_p); -} - -#endif - - - - static SCM -async_mark (SCM obj) +async_gc_mark (SCM obj) { return ASYNC_THUNK (obj); } - - SCM_DEFINE (scm_async, "async", 1, 0, 0, (SCM thunk), "Create a new async for the procedure @var{thunk}.") @@ -293,70 +127,22 @@ SCM_DEFINE (scm_async, "async", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0, - (SCM thunk), - "Create a new async for the procedure @var{thunk}. Also\n" - "add it to the system's list of active async objects.") -#define FUNC_NAME s_scm_system_async -{ - SCM it = scm_async (thunk); - scm_asyncs = scm_cons (it, scm_asyncs); - return it; -} -#undef FUNC_NAME - SCM_DEFINE (scm_async_mark, "async-mark", 1, 0, 0, (SCM a), "Mark the async @var{a} for future execution.") #define FUNC_NAME s_scm_async_mark { VALIDATE_ASYNC (1, a); -#ifdef GUILE_OLD_ASYNC_CLICK SET_ASYNC_GOT_IT (a, 1); -#else - SET_ASYNC_GOT_IT (a, scm_asyncs_pending_p = 1); -#endif return SCM_UNSPECIFIED; } #undef FUNC_NAME - -SCM_DEFINE (scm_system_async_mark, "system-async-mark", 1, 0, 0, - (SCM a), - "Mark the async @var{a} for future execution.") -#define FUNC_NAME s_scm_system_async_mark -{ - VALIDATE_ASYNC (1, a); - SCM_REDEFER_INTS; -#ifdef GUILE_OLD_ASYNC_CLICK - SET_ASYNC_GOT_IT (a, 1); - scm_async_rate = 1 + scm_async_rate - scm_async_clock; - scm_async_clock = 1; -#else - SET_ASYNC_GOT_IT (a, scm_asyncs_pending_p = 1); -#endif - SCM_REALLOW_INTS; - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -void -scm_system_async_mark_from_signal_handler (SCM a) -{ - SET_ASYNC_GOT_IT (a, scm_asyncs_pending_p = 1); -} - SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, (SCM list_of_a), "Execute all thunks from the asyncs of the list @var{list_of_a}.") #define FUNC_NAME s_scm_run_asyncs { -#ifdef GUILE_OLD_ASYNC_CLICK - if (scm_mask_ints) - return SCM_BOOL_F; -#else - scm_asyncs_pending_p = 0; -#endif while (! SCM_NULL_OR_NIL_P (list_of_a)) { SCM a; @@ -378,6 +164,78 @@ SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, +/* System asyncs. */ + +void +scm_async_click () +{ + SCM asyncs; + + if (!scm_mask_ints) + { + while (!SCM_NULLP(asyncs = scm_active_asyncs)) + { + scm_active_asyncs = SCM_EOL; + do + { + SCM c = SCM_CDR (asyncs); + SCM_SETCDR (asyncs, SCM_EOL); + scm_call_0 (SCM_CAR (asyncs)); + asyncs = c; + } + while (!SCM_NULLP(asyncs)); + } + } +} + +SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0, + (SCM thunk), + "This function is deprecated. You can use @var{thunk} directly\n" + "instead of explicitely creating a asnc object.\n") +#define FUNC_NAME s_scm_system_async +{ + scm_c_issue_deprecation_warning + ("'system-async' is deprecated. " + "Use the procedure directly with 'system-async-mark'."); + return thunk; +} +#undef FUNC_NAME + +void +scm_i_queue_async_cell (SCM c, scm_root_state *root) +{ + if (SCM_CDR (c) == SCM_EOL) + { + SCM_SETCDR (c, root->active_asyncs); + root->active_asyncs = c; + } +} + +SCM_DEFINE (scm_system_async_mark_for_thread, "system-async-mark", 1, 1, 0, + (SCM proc, SCM thread), + "Register the procedure @var{proc} for future execution\n" + "in @var{thread}. When @var{thread} is not specified,\n" + "use the current thread.") +#define FUNC_NAME s_scm_system_async_mark_for_thread +{ + scm_i_queue_async_cell (scm_cons (proc, SCM_EOL), + (SCM_UNBNDP (thread) + ? scm_root + : scm_i_thread_root (thread))); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM +scm_system_async_mark (SCM proc) +#define FUNC_NAME s_scm_system_async_mark_for_thread +{ + return scm_system_async_mark_for_thread (proc, SCM_UNDEFINED); +} +#undef FUNC_NAME + + + SCM_DEFINE (scm_noop, "noop", 0, 0, 1, (SCM args), @@ -391,45 +249,6 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1, #undef FUNC_NAME - - -#ifdef GUILE_OLD_ASYNC_CLICK - -SCM_DEFINE (scm_set_tick_rate, "set-tick-rate", 1, 0, 0, - (SCM n), - "Set the rate of async ticks to @var{n}. Return the old rate\n" - "value.") -#define FUNC_NAME s_scm_set_tick_rate -{ - unsigned int old_n = scm_tick_rate; - SCM_VALIDATE_INUM (1, n); - scm_desired_tick_rate = SCM_INUM (n); - scm_async_rate = 1 + scm_async_rate - scm_async_clock; - scm_async_clock = 1; - return SCM_MAKINUM (old_n); -} -#undef FUNC_NAME - - - - -SCM_DEFINE (scm_set_switch_rate, "set-switch-rate", 1, 0, 0, - (SCM n), - "Set the async switch rate to @var{n}. Return the old value\n" - "of the switch rate.") -#define FUNC_NAME s_scm_set_switch_rate -{ - unsigned int old_n = scm_switch_rate; - SCM_VALIDATE_INUM (1, n); - scm_desired_switch_rate = SCM_INUM (n); - scm_async_rate = 1 + scm_async_rate - scm_async_clock; - scm_async_clock = 1; - return SCM_MAKINUM (old_n); -} -#undef FUNC_NAME - -#endif - SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0, @@ -460,7 +279,7 @@ scm_init_async () { scm_asyncs = SCM_EOL; tc16_async = scm_make_smob_type ("async", 0); - scm_set_smob_mark (tc16_async, async_mark); + scm_set_smob_mark (tc16_async, async_gc_mark); #include "libguile/async.x" } From e3c9bec302dcd1c92872f0b0f58573b05f7abc78 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 4 Oct 2002 13:49:29 +0000 Subject: [PATCH 204/306] * __scm.h (scm_asyncs_pending_p): Removed. (SCM_ASYNC_CLICK): Check scm_active_asyncs instead of scm_asyncs_pending_p. --- libguile/__scm.h | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/libguile/__scm.h b/libguile/__scm.h index f8a8ee7ac..4539800d2 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -406,11 +406,9 @@ typedef long SCM_STACKITEM; #define SCM_THREAD_SWITCHING_CODE #endif -SCM_API int scm_asyncs_pending_p; - #define SCM_ASYNC_TICK /*fixme* should change names */ \ do { \ - if (scm_asyncs_pending_p) \ + if (scm_active_asyncs != SCM_EOL) \ scm_async_click (); \ } while (0) From 2fbc8609b25e9985133e7795f3e79288c90a0391 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 4 Oct 2002 14:13:26 +0000 Subject: [PATCH 205/306] * scmsigs.h (scm_sigaction_for_thread): New prototype. * scmsigs.c (got_signal): Removed. (signal_handler_cells, signal_handler_threads): New. (take_signal): Queue the cell of the signal for the specified thread. Reset the signal handler on systems that don't have sigaction. (sys_deliver_signals): Removed. (close_1): New. (scm_sigaction_for_thread): Renamed from scm_sigaction and extended to also set the thread of a signal and allocate a cell for it. Keep the Scheme name "sigaction". Check that signum is within range. Also, use SCM_VECTOR_REF instead of SCM_VELTS. (scm_sigaction): Implement in terms of scm_sigaction_for_thread. (scm_init_scmsigs): Allocate signal_handler_cells and signal_handler_threads vectors. --- libguile/scmsigs.c | 102 ++++++++++++++++++++++++--------------------- libguile/scmsigs.h | 4 +- 2 files changed, 58 insertions(+), 48 deletions(-) diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index 95e15ec4d..c77fad0a9 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -102,18 +102,19 @@ int usleep (); /* take_signal is installed as the C signal handler whenever a Scheme - handler is set. when a signal arrives, take_signal marks the corresponding - element of got_signal and marks signal_async. the thunk in signal_async - (sys_deliver_signals) will be run at the next opportunity, outside a - critical section. sys_deliver_signals runs each Scheme handler for - which got_signal is set. */ + handler is set. when a signal arrives, take_signal will queue the + Scheme handler procedure for its thread. */ -static SCM signal_async; -static char got_signal[NSIG]; - -/* a Scheme vector of handler procedures. */ +/* Scheme vectors with information about a signal. signal_handlers + contains the handler procedure or #f, signal_handler_cells contains + preallocated cells for queuing the handler in take_signal since we + can't allocate during signal delivery, signal_handler_threads + points to the thread that a signal should be delivered to. +*/ static SCM *signal_handlers; +static SCM signal_handler_cells; +static SCM signal_handler_threads; /* saves the original C handlers, when a new handler is installed. set to SIG_ERR if the original handler is installed. */ @@ -126,52 +127,51 @@ static SIGRETTYPE (*orig_handlers[NSIG])(int); static SIGRETTYPE take_signal (int signum) { - got_signal[signum] = 1; - scm_system_async_mark_from_signal_handler (signal_async); + if (signum >= 0 && signum < NSIG) + { + SCM thread = SCM_VECTOR_REF (signal_handler_threads, signum); + scm_i_queue_async_cell (SCM_VECTOR_REF(signal_handler_cells, signum), + scm_i_thread_root (thread)); + } +#ifndef HAVE_SIGACTION + signal (signum, take_signal); +#endif +} + +SCM +scm_sigaction (SCM signum, SCM handler, SCM flags) +{ + return scm_sigaction_for_thread (signum, handler, flags, SCM_UNDEFINED); } static SCM -sys_deliver_signals (void) +close_1 (SCM proc, SCM arg) { - int i; - - for (i = 0; i < NSIG; i++) - { - if (got_signal[i]) - { - /* The flag is reset before calling the handler in case the - handler doesn't return. If the handler doesn't return - but leaves other signals flagged, they their handlers - will be applied some time later when the async is checked - again. It would probably be better to reset the flags - after doing a longjmp. */ - got_signal[i] = 0; -#ifndef HAVE_SIGACTION - signal (i, take_signal); -#endif - scm_call_1 (SCM_VELTS (*signal_handlers)[i], SCM_MAKINUM (i)); - } - } - return SCM_UNSPECIFIED; + return scm_primitive_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL, + scm_list_2 (proc, arg))); } /* user interface for installation of signal handlers. */ -SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, - (SCM signum, SCM handler, SCM flags), +SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, + (SCM signum, SCM handler, SCM flags, SCM thread), "Install or report the signal handler for a specified signal.\n\n" "@var{signum} is the signal number, which can be specified using the value\n" "of variables such as @code{SIGINT}.\n\n" - "If @var{action} is omitted, @code{sigaction} returns a pair: the\n" + "If @var{handler} is omitted, @code{sigaction} returns a pair: the\n" "CAR is the current\n" "signal hander, which will be either an integer with the value @code{SIG_DFL}\n" "(default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which\n" "handles the signal, or @code{#f} if a non-Scheme procedure handles the\n" "signal. The CDR contains the current @code{sigaction} flags for the handler.\n\n" - "If @var{action} is provided, it is installed as the new handler for\n" - "@var{signum}. @var{action} can be a Scheme procedure taking one\n" + "If @var{handler} is provided, it is installed as the new handler for\n" + "@var{signum}. @var{handler} can be a Scheme procedure taking one\n" "argument, or the value of @code{SIG_DFL} (default action) or\n" "@code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler\n" - "was installed before @code{sigaction} was first used. Flags can\n" + "was installed before @code{sigaction} was first used. When\n" + "a scheme procedure has been specified, that procedure will run\n" + "in the given @var{thread}. When no thread has been given, the\n" + "thread that made this call to @code{sigaction} is used.\n" + "Flags can " "optionally be specified for the new handler (@code{SA_RESTART} will\n" "always be added if it's available and the system is using restartable\n" "system calls.) The return value is a pair with information about the\n" @@ -180,7 +180,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, "facility. Maybe this is not needed, since the thread support may\n" "provide solutions to the problem of consistent access to data\n" "structures.") -#define FUNC_NAME s_scm_sigaction +#define FUNC_NAME s_scm_sigaction_for_thread { int csig; #ifdef HAVE_SIGACTION @@ -196,6 +196,8 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, SCM old_handler; SCM_VALIDATE_INUM_COPY (1, signum, csig); + if (csig < 0 || csig > NSIG) + SCM_OUT_OF_RANGE (1, signum); #if defined(HAVE_SIGACTION) #if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS) /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS @@ -211,9 +213,13 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, action.sa_flags |= SCM_INUM (flags); } sigemptyset (&action.sa_mask); + if (SCM_UNBNDP (thread)) + thread = scm_current_thread (); + else + SCM_VALIDATE_THREAD (4, thread); #endif SCM_DEFER_INTS; - old_handler = SCM_VELTS(*signal_handlers)[csig]; + old_handler = SCM_VECTOR_REF(*signal_handlers, csig); if (SCM_UNBNDP (handler)) query_only = 1; else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T)) @@ -267,7 +273,11 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0, if (orig_handlers[csig] == SIG_ERR) save_handler = 1; #endif + handler = close_1 (handler, signum); SCM_VECTOR_SET (*signal_handlers, csig, handler); + SCM_VECTOR_SET (signal_handler_cells, csig, + scm_cons (handler, SCM_EOL)); + SCM_VECTOR_SET (signal_handler_threads, csig, thread); } /* XXX - Silently ignore setting handlers for `program error signals' @@ -555,20 +565,18 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0, void scm_init_scmsigs () { - SCM thunk; int i; signal_handlers = SCM_VARIABLE_LOC (scm_c_define ("signal-handlers", scm_c_make_vector (NSIG, SCM_BOOL_F))); - /* XXX - use scm_c_make_gsubr here instead of `define'? */ - thunk = scm_c_define_gsubr ("%deliver-signals", 0, 0, 0, - sys_deliver_signals); - signal_async = scm_system_async (thunk); + signal_handler_cells = + scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F)); + signal_handler_threads = + scm_permanent_object (scm_c_make_vector (NSIG, SCM_BOOL_F)); for (i = 0; i < NSIG; i++) { - got_signal[i] = 0; #ifdef HAVE_SIGACTION orig_handlers[i].sa_handler = SIG_ERR; diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h index a9391b515..7a49173a4 100644 --- a/libguile/scmsigs.h +++ b/libguile/scmsigs.h @@ -3,7 +3,7 @@ #ifndef SCM_SCMSIGS_H #define SCM_SCMSIGS_H -/* Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -51,6 +51,8 @@ SCM_API SCM scm_sigaction (SCM signum, SCM handler, SCM flags); +SCM_API SCM scm_sigaction_for_thread (SCM signum, SCM handler, SCM flags, + SCM thread); SCM_API SCM scm_restore_signals (void); SCM_API SCM scm_alarm (SCM i); SCM_API SCM scm_setitimer (SCM which_timer, From 497092c9d10e04e2e2582e8785240d4e8bc2264c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 4 Oct 2002 14:13:51 +0000 Subject: [PATCH 206/306] *** empty log message *** --- libguile/ChangeLog | 56 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 1969205d8..c10eca596 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,59 @@ +2002-10-04 Marius Vollmer + + * scmsigs.h (scm_sigaction_for_thread): New prototype. + * scmsigs.c (got_signal): Removed. + (signal_handler_cells, signal_handler_threads): New. + (take_signal): Queue the cell of the signal for the specified + thread. Reset the signal handler on systems that don't have + sigaction. + (sys_deliver_signals): Removed. + (close_1): New. + (scm_sigaction_for_thread): Renamed from scm_sigaction and + extended to also set the thread of a signal and allocate a cell + for it. Keep the Scheme name "sigaction". Check that signum is + within range. Also, use SCM_VECTOR_REF instead of SCM_VELTS. + (scm_sigaction): Implement in terms of scm_sigaction_for_thread. + (scm_init_scmsigs): Allocate signal_handler_cells and + signal_handler_threads vectors. + + * async.c: Removed GUILE_OLD_ASYNC_CLICK code. Reorganized so + that system asnycs and user asyncs are separated. Reimplemented + system asyncs to work per-thread. + + * gc.c (scm_init_gc): Do not use scm_system_async. + + * async.h (scm_asyncs_pending, scm_set_tick_rate, + scm_set_switch_rate, scm_system_async_mark_from_signal_handler): + Removed prototypes. + (scm_i_queue_async_cell): New. + + * __scm.h (scm_asyncs_pending_p): Removed. + (SCM_ASYNC_CLICK): Check scm_active_asyncs instead of + scm_asyncs_pending_p. + + * async.h (scm_system_async_mark_for_thread): New prototype. + + * __scm.h: Removed GUILE_OLD_ASYNC_CLICK code. + + * root.h (scm_root_state): Added new "active_asyncs" slot. + * root.c (scm_make_root): Initialize it to SCM_EOL. + + * coop-defs.h (coop_t): Added new "handle" slot. + * coop-threads.c (all_threads, scm_current_thread, + scm_all_threads, scm_i_thread_root): New. + (scm_threads_init): Add main thread to all_threads. + (scheme_launch_thread): Remove thread from all_threads when it + terminates. + (scm_call_with_new_thread): Initialize handle slot of coop_t + structure and add new thread to all_threads. + (scm_spawn_thread): Likewise. + + * threads.h (scm_current_thread, scm_all_threads): New prototypes. + * threads.c (scm_current_thread, scm_all_threads): Register as + primitives. + + * dynl.c: Use scm_lt_ prefix for libltdl functions. + 2002-09-29 Neil Jerram * script.c (scm_compile_shell_switches): Fix bad spelling of From 0ad7cc4f972609128a84c3845f3d29ac14e7e32f Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:10:48 +0000 Subject: [PATCH 207/306] * boot-9.scm (expt): switch if sense and use negative? rather than >= 0. --- ice-9/boot-9.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 6e6f1e1fb..c1a03f000 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -690,9 +690,9 @@ (let ((integer-expt integer-expt)) (lambda (z1 z2) (cond ((integer? z2) - (if (>= z2 0) - (integer-expt z1 z2) - (/ 1 (integer-expt z1 (- z2))))) + (if (negative? z2) + (/ 1 (integer-expt z1 (- z2))) + (integer-expt z1 z2))) ((and (real? z2) (real? z1) (>= z1 0)) ($expt z1 z2)) (else From 201e7da7916d771fbce1d99ca1d4d0f56863e36e Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:11:51 +0000 Subject: [PATCH 208/306] * summarize-guile-TODO (as-leaf): make #\: a char-set. --- scripts/summarize-guile-TODO | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/scripts/summarize-guile-TODO b/scripts/summarize-guile-TODO index fb659c836..9abdd6c9a 100755 --- a/scripts/summarize-guile-TODO +++ b/scripts/summarize-guile-TODO @@ -74,6 +74,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" :use-module (scripts read-text-outline) :use-module (ice-9 getopt-long) :autoload (srfi srfi-13) (string-tokenize) ; string library + :autoload (srfi srfi-14) (char-set) ; string library :autoload (ice-9 common-list) (remove-if-not) :export (summarize-guile-TODO)) @@ -85,7 +86,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" => (lambda (who) (put x 'who (map string->symbol - (string-tokenize who #\:)))))) + (string-tokenize who (char-set #\:))))))) (cond ((get x 'pct-done) => (lambda (pct-done) (put x 'pct-done (string->number pct-done))))) From 46f2c0f148846089b9d5c3beb7facb699c02c7c4 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:12:23 +0000 Subject: [PATCH 209/306] * tests/numbers.test ("expt"): add tests. --- test-suite/tests/numbers.test | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 951325f71..9177184dc 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1461,6 +1461,16 @@ ;;; ceiling ;;; +;;; +;;; expt +;;; + +(with-test-prefix "expt" + (pass-if "(= 1 (expt 0 0))" (= 1 (expt 0 0))) + (pass-if "(= 1 (expt 0 0.0))" (= 1 (expt 0 0.0))) + (pass-if "(= 1 (expt 0.0 0))" (= 1 (expt 0.0 0))) + (pass-if "(= 1 (expt 0.0 0.0))" (= 1 (expt 0.0 0.0)))) + ;;; ;;; make-rectangular ;;; From 9bc548798dae75b30ed397ede02449754822c18a Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:21:04 +0000 Subject: [PATCH 210/306] *** empty log message *** --- ice-9/ChangeLog | 5 +++++ scripts/ChangeLog | 4 ++++ test-suite/ChangeLog | 4 ++++ 3 files changed, 13 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index cf5517ab0..badbb5337 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2002-10-04 Rob Browning + + * boot-9.scm (expt): switch if sense and use negative? rather than + >= 0. + 2002-10-04 Marius Vollmer * boot-9.scm (top-repl): Use "1" instead of "%deliver-signals" to diff --git a/scripts/ChangeLog b/scripts/ChangeLog index e6b36f8f1..6efb5a853 100644 --- a/scripts/ChangeLog +++ b/scripts/ChangeLog @@ -1,3 +1,7 @@ +2002-10-04 Rob Browning + + * summarize-guile-TODO (as-leaf): make #\: a char-set. + 2002-05-18 Thien-Thi Nguyen * api-diff (group-diff): Also output +N and -N adds and subs diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index cd83f1f29..28668e6ba 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2002-10-04 Rob Browning + + * tests/numbers.test ("expt"): add tests. + 2002-09-09 Marius Vollmer * Makefile.am (dist-hook): Do not distribute CVS directories. From 20bf9a3cfedda4831896d895055481fc310dae3e Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:27:35 +0000 Subject: [PATCH 211/306] * numbers.c (s_scm_integer_expt): (expt 0 1) should be 1. --- libguile/numbers.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index bb01d7ad3..24c1e0f9a 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1245,7 +1245,7 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, int i2; #ifdef SCM_BIGDIG if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc)) - return n; + return acc; else if (SCM_EQ_P (n, SCM_MAKINUM (-1L))) return SCM_FALSEP (scm_even_p (k)) ? n : acc; #endif From ac48c7193e3e3de3558b01b526ac0395bf87e2ec Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:33:35 +0000 Subject: [PATCH 212/306] *** empty log message *** --- libguile/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c10eca596..af28abc96 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-10-04 Rob Browning + + * numbers.c (s_scm_integer_expt): (expt 0 1) should be 1. + 2002-10-04 Marius Vollmer * scmsigs.h (scm_sigaction_for_thread): New prototype. From 7971b3b82d1ef71c88a6d39f83868802831eb7c7 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:45:15 +0000 Subject: [PATCH 213/306] *** empty log message *** --- libltdl/COPYING.LIB => libguile-ltdl/.cvsignore | 0 libltdl/ChangeLog => libguile-ltdl/upstream/.cvsignore | 0 libltdl/Makefile.am | 0 libltdl/README | 0 libltdl/acinclude.m4 | 0 libltdl/configure.in | 0 libltdl/ltdl.c | 0 libltdl/ltdl.h | 0 8 files changed, 0 insertions(+), 0 deletions(-) rename libltdl/COPYING.LIB => libguile-ltdl/.cvsignore (100%) rename libltdl/ChangeLog => libguile-ltdl/upstream/.cvsignore (100%) delete mode 100644 libltdl/Makefile.am delete mode 100644 libltdl/README delete mode 100644 libltdl/acinclude.m4 delete mode 100644 libltdl/configure.in delete mode 100644 libltdl/ltdl.c delete mode 100644 libltdl/ltdl.h diff --git a/libltdl/COPYING.LIB b/libguile-ltdl/.cvsignore similarity index 100% rename from libltdl/COPYING.LIB rename to libguile-ltdl/.cvsignore diff --git a/libltdl/ChangeLog b/libguile-ltdl/upstream/.cvsignore similarity index 100% rename from libltdl/ChangeLog rename to libguile-ltdl/upstream/.cvsignore diff --git a/libltdl/Makefile.am b/libltdl/Makefile.am deleted file mode 100644 index e69de29bb..000000000 diff --git a/libltdl/README b/libltdl/README deleted file mode 100644 index e69de29bb..000000000 diff --git a/libltdl/acinclude.m4 b/libltdl/acinclude.m4 deleted file mode 100644 index e69de29bb..000000000 diff --git a/libltdl/configure.in b/libltdl/configure.in deleted file mode 100644 index e69de29bb..000000000 diff --git a/libltdl/ltdl.c b/libltdl/ltdl.c deleted file mode 100644 index e69de29bb..000000000 diff --git a/libltdl/ltdl.h b/libltdl/ltdl.h deleted file mode 100644 index e69de29bb..000000000 From a834f6d5083184bbb96d390a70697bf744c7a089 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:46:44 +0000 Subject: [PATCH 214/306] * upstream/Makefile.am: new file. --- libguile-ltdl/upstream/Makefile.am | 61 ++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 libguile-ltdl/upstream/Makefile.am diff --git a/libguile-ltdl/upstream/Makefile.am b/libguile-ltdl/upstream/Makefile.am new file mode 100644 index 000000000..1a0a7e2be --- /dev/null +++ b/libguile-ltdl/upstream/Makefile.am @@ -0,0 +1,61 @@ +## Process this file with Automake to create Makefile.in +## +## Copyright (C) 2002 Free Software Foundation, Inc. +## +## This file is part of GUILE. +## +## GUILE is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as +## published by the Free Software Foundation; either version 2, or +## (at your option) any later version. +## +## GUILE is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public +## License along with GUILE; see the file COPYING. If not, write +## to the Free Software Foundation, Inc., 59 Temple Place, Suite +## 330, Boston, MA 02111-1307 USA + +AUTOMAKE_OPTIONS = gnu + +## Prevent automake from adding extra -I options +DEFS = @DEFS@ +## Check for headers in $(srcdir)/.., so that #include +## will find MUMBLE.h in this dir when we're +## building. +INCLUDES = -I.. -I$(srcdir)/.. + +ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \ + --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/' + +EXTRA_DIST := ltdl.h ltdl.c ltdl.h.diff ltdl.c.diff +BUILT_SOURCES := ltdl.h.diff ltdl.c.diff + +ltdl.h.diff: ltdl.h ../raw-ltdl.h + cp ../raw-ltdl.h raw-ltdl.guilemod.h.tmp + perl -pi \ + -e 's/SCMLTXT/extern/go;' \ + -e 's/SCMLTSTATIC //go;' \ + -e 's/ SCM_UNUSED//go;' \ + raw-ltdl.guilemod.h.tmp + mv raw-ltdl.guilemod.h.tmp raw-ltdl.guilemod.h + diff -ru upstream/ltdl.h raw-ltdl.guilemod.h > upstream/ltdl.h.diff; \ + test "$$?" -eq 1 + +ltdl.c.diff: ltdl.c ../raw-ltdl.c + cp ../raw-ltdl.c raw-ltdl.guilemod.c.tmp + perl -pi \ + -e 's/SCMLTXT/extern/go;' \ + -e 's/SCMLTSTATIC //go;' \ + -e 's/ SCM_UNUSED//go;' \ + raw-ltdl.guilemod.c.tmp + mv raw-ltdl.guilemod.c.tmp raw-ltdl.guilemod.c + diff -ru upstream/ltdl.c raw-ltdl.guilemod.c > upstream/ltdl.c.diff; \ + test "$$?" -eq 1 + +CLEANFILES := \ + raw-ltdl.guilemod.h raw-ltdl.guilemod.c \ + raw-ltdl.guilemod.h.tmp raw-ltdl.guilemod.c.tmp From d15601668c9b89a13455bdbee00d10ededc2720d Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:46:51 +0000 Subject: [PATCH 215/306] * upstream/ltdl.c: upstream source. --- libguile-ltdl/upstream/ltdl.c | 3969 +++++++++++++++++++++++++++++++++ 1 file changed, 3969 insertions(+) create mode 100644 libguile-ltdl/upstream/ltdl.c diff --git a/libguile-ltdl/upstream/ltdl.c b/libguile-ltdl/upstream/ltdl.c new file mode 100644 index 000000000..19293f4d0 --- /dev/null +++ b/libguile-ltdl/upstream/ltdl.c @@ -0,0 +1,3969 @@ +/* ltdl.c -- system independent dlopen wrapper + Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. + Originally by Thomas Tanner + This file is part of GNU Libtool. + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +As a special exception to the GNU Lesser General Public License, +if you distribute this file as part of a program or library that +is built using GNU libtool, you may include it under the same +distribution terms that you use for the rest of that program. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +02111-1307 USA + +*/ + +#if HAVE_CONFIG_H +# include +#endif + +#if HAVE_UNISTD_H +# include +#endif + +#if HAVE_STDIO_H +# include +#endif + +#if HAVE_STDLIB_H +# include +#endif + +#if HAVE_STRING_H +# include +#else +# if HAVE_STRINGS_H +# include +# endif +#endif + +#if HAVE_CTYPE_H +# include +#endif + +#if HAVE_MALLOC_H +# include +#endif + +#if HAVE_MEMORY_H +# include +#endif + +#if HAVE_ERRNO_H +# include +#endif + +#if HAVE_DIRENT_H +# include +# define LT_D_NAMLEN(dirent) (strlen((dirent)->d_name)) +#else +# define dirent direct +# define LT_D_NAMLEN(dirent) ((dirent)->d_namlen) +# if HAVE_SYS_NDIR_H +# include +# endif +# if HAVE_SYS_DIR_H +# include +# endif +# if HAVE_NDIR_H +# include +# endif +#endif + +#if HAVE_ARGZ_H +# include +#endif + +#if HAVE_ASSERT_H +# include +#else +# define assert(arg) ((void) 0) +#endif + +#include "ltdl.h" + + + + +/* --- WINDOWS SUPPORT --- */ + + +#ifdef DLL_EXPORT +# define LT_GLOBAL_DATA __declspec(dllexport) +#else +# define LT_GLOBAL_DATA +#endif + +/* fopen() mode flags for reading a text file */ +#undef LT_READTEXT_MODE +#ifdef __WINDOWS__ +# define LT_READTEXT_MODE "rt" +#else +# define LT_READTEXT_MODE "r" +#endif + + + + +/* --- MANIFEST CONSTANTS --- */ + + +/* Standard libltdl search path environment variable name */ +#undef LTDL_SEARCHPATH_VAR +#define LTDL_SEARCHPATH_VAR "LTDL_LIBRARY_PATH" + +/* Standard libtool archive file extension. */ +#undef LTDL_ARCHIVE_EXT +#define LTDL_ARCHIVE_EXT ".la" + +/* max. filename length */ +#ifndef LT_FILENAME_MAX +# define LT_FILENAME_MAX 1024 +#endif + +/* This is the maximum symbol size that won't require malloc/free */ +#undef LT_SYMBOL_LENGTH +#define LT_SYMBOL_LENGTH 128 + +/* This accounts for the _LTX_ separator */ +#undef LT_SYMBOL_OVERHEAD +#define LT_SYMBOL_OVERHEAD 5 + + + + +/* --- MEMORY HANDLING --- */ + + +/* These are the functions used internally. In addition to making + use of the associated function pointers above, they also perform + error handling. */ +static char *lt_estrdup LT_PARAMS((const char *str)); +static lt_ptr lt_emalloc LT_PARAMS((size_t size)); +static lt_ptr lt_erealloc LT_PARAMS((lt_ptr addr, size_t size)); + +static lt_ptr rpl_realloc LT_PARAMS((lt_ptr ptr, size_t size)); + +/* These are the pointers that can be changed by the caller: */ +LT_GLOBAL_DATA lt_ptr (*lt_dlmalloc) LT_PARAMS((size_t size)) + = (lt_ptr (*) LT_PARAMS((size_t))) malloc; +LT_GLOBAL_DATA lt_ptr (*lt_dlrealloc) LT_PARAMS((lt_ptr ptr, size_t size)) + = (lt_ptr (*) LT_PARAMS((lt_ptr, size_t))) rpl_realloc; +LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) + = (void (*) LT_PARAMS((lt_ptr))) free; + +/* The following macros reduce the amount of typing needed to cast + assigned memory. */ +#define LT_DLMALLOC(tp, n) ((tp *) lt_dlmalloc ((n) * sizeof(tp))) +#define LT_DLREALLOC(tp, p, n) ((tp *) rpl_realloc ((p), (n) * sizeof(tp))) +#define LT_DLFREE(p) \ + LT_STMT_START { if (p) (p) = (lt_dlfree (p), (lt_ptr) 0); } LT_STMT_END + +#define LT_EMALLOC(tp, n) ((tp *) lt_emalloc ((n) * sizeof(tp))) +#define LT_EREALLOC(tp, p, n) ((tp *) lt_erealloc ((p), (n) * sizeof(tp))) + +#define LT_DLMEM_REASSIGN(p, q) LT_STMT_START { \ + if ((p) != (q)) { lt_dlfree (p); (p) = (q); (q) = 0; } \ + } LT_STMT_END + + +/* --- REPLACEMENT FUNCTIONS --- */ + + +#undef strdup +#define strdup rpl_strdup + +static char *strdup LT_PARAMS((const char *str)); + +char * +strdup(str) + const char *str; +{ + char *tmp = 0; + + if (str) + { + tmp = LT_DLMALLOC (char, 1+ strlen (str)); + if (tmp) + { + strcpy(tmp, str); + } + } + + return tmp; +} + + +#if ! HAVE_STRCMP + +#undef strcmp +#define strcmp rpl_strcmp + +static int strcmp LT_PARAMS((const char *str1, const char *str2)); + +int +strcmp (str1, str2) + const char *str1; + const char *str2; +{ + if (str1 == str2) + return 0; + if (str1 == 0) + return -1; + if (str2 == 0) + return 1; + + for (;*str1 && *str2; ++str1, ++str2) + { + if (*str1 != *str2) + break; + } + + return (int)(*str1 - *str2); +} +#endif + + +#if ! HAVE_STRCHR + +# if HAVE_INDEX +# define strchr index +# else +# define strchr rpl_strchr + +static const char *strchr LT_PARAMS((const char *str, int ch)); + +const char* +strchr(str, ch) + const char *str; + int ch; +{ + const char *p; + + for (p = str; *p != (char)ch && *p != LT_EOS_CHAR; ++p) + /*NOWORK*/; + + return (*p == (char)ch) ? p : 0; +} + +# endif +#endif /* !HAVE_STRCHR */ + + +#if ! HAVE_STRRCHR + +# if HAVE_RINDEX +# define strrchr rindex +# else +# define strrchr rpl_strrchr + +static const char *strrchr LT_PARAMS((const char *str, int ch)); + +const char* +strrchr(str, ch) + const char *str; + int ch; +{ + const char *p, *q = 0; + + for (p = str; *p != LT_EOS_CHAR; ++p) + { + if (*p == (char) ch) + { + q = p; + } + } + + return q; +} + +# endif +#endif + +/* NOTE: Neither bcopy nor the memcpy implementation below can + reliably handle copying in overlapping areas of memory. Use + memmove (for which there is a fallback implmentation below) + if you need that behaviour. */ +#if ! HAVE_MEMCPY + +# if HAVE_BCOPY +# define memcpy(dest, src, size) bcopy (src, dest, size) +# else +# define memcpy rpl_memcpy + +static lt_ptr memcpy LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); + +lt_ptr +memcpy (dest, src, size) + lt_ptr dest; + const lt_ptr src; + size_t size; +{ + size_t i = 0; + + for (i = 0; i < size; ++i) + { + dest[i] = src[i]; + } + + return dest; +} + +# endif /* !HAVE_BCOPY */ +#endif /* !HAVE_MEMCPY */ + +#if ! HAVE_MEMMOVE +# define memmove rpl_memmove + +static lt_ptr memmove LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); + +lt_ptr +memmove (dest, src, size) + lt_ptr dest; + const lt_ptr src; + size_t size; +{ + size_t i; + + if (dest < src) + for (i = 0; i < size; ++i) + { + dest[i] = src[i]; + } + else if (dest > src) + for (i = size -1; i >= 0; --i) + { + dest[i] = src[i]; + } + + return dest; +} + +#endif /* !HAVE_MEMMOVE */ + + +/* According to Alexandre Oliva , + ``realloc is not entirely portable'' + In any case we want to use the allocator supplied by the user without + burdening them with an lt_dlrealloc function pointer to maintain. + Instead implement our own version (with known boundary conditions) + using lt_dlmalloc and lt_dlfree. */ + +#undef realloc +#define realloc rpl_realloc + +lt_ptr +realloc (ptr, size) + lt_ptr ptr; + size_t size; +{ + if (size <= 0) + { + /* For zero or less bytes, free the original memory */ + if (ptr != 0) + { + lt_dlfree (ptr); + } + + return (lt_ptr) 0; + } + else if (ptr == 0) + { + /* Allow reallocation of a NULL pointer. */ + return lt_dlmalloc (size); + } + else + { + /* Allocate a new block, copy and free the old block. */ + lt_ptr mem = lt_dlmalloc (size); + + if (mem) + { + memcpy (mem, ptr, size); + lt_dlfree (ptr); + } + + /* Note that the contents of PTR are not damaged if there is + insufficient memory to realloc. */ + return mem; + } +} + + +#if ! HAVE_ARGZ_APPEND +# define argz_append rpl_argz_append + +static error_t argz_append LT_PARAMS((char **pargz, size_t *pargz_len, + const char *buf, size_t buf_len)); + +error_t +argz_append (pargz, pargz_len, buf, buf_len) + char **pargz; + size_t *pargz_len; + const char *buf; + size_t buf_len; +{ + size_t argz_len; + char *argz; + + assert (pargz); + assert (pargz_len); + assert ((*pargz && *pargz_len) || (!*pargz && !*pargz_len)); + + /* If nothing needs to be appended, no more work is required. */ + if (buf_len == 0) + return 0; + + /* Ensure there is enough room to append BUF_LEN. */ + argz_len = *pargz_len + buf_len; + argz = LT_DLREALLOC (char, *pargz, argz_len); + if (!argz) + return ENOMEM; + + /* Copy characters from BUF after terminating '\0' in ARGZ. */ + memcpy (argz + *pargz_len, buf, buf_len); + + /* Assign new values. */ + *pargz = argz; + *pargz_len = argz_len; + + return 0; +} +#endif /* !HAVE_ARGZ_APPEND */ + + +#if ! HAVE_ARGZ_CREATE_SEP +# define argz_create_sep rpl_argz_create_sep + +static error_t argz_create_sep LT_PARAMS((const char *str, int delim, + char **pargz, size_t *pargz_len)); + +error_t +argz_create_sep (str, delim, pargz, pargz_len) + const char *str; + int delim; + char **pargz; + size_t *pargz_len; +{ + size_t argz_len; + char *argz = 0; + + assert (str); + assert (pargz); + assert (pargz_len); + + /* Make a copy of STR, but replacing each occurence of + DELIM with '\0'. */ + argz_len = 1+ LT_STRLEN (str); + if (argz_len) + { + const char *p; + char *q; + + argz = LT_DLMALLOC (char, argz_len); + if (!argz) + return ENOMEM; + + for (p = str, q = argz; *p != LT_EOS_CHAR; ++p) + { + if (*p == delim) + { + /* Ignore leading delimiters, and fold consecutive + delimiters in STR into a single '\0' in ARGZ. */ + if ((q > argz) && (q[-1] != LT_EOS_CHAR)) + *q++ = LT_EOS_CHAR; + else + --argz_len; + } + else + *q++ = *p; + } + /* Copy terminating LT_EOS_CHAR. */ + *q = *p; + } + + /* If ARGZ_LEN has shrunk to nothing, release ARGZ's memory. */ + if (!argz_len) + LT_DLFREE (argz); + + /* Assign new values. */ + *pargz = argz; + *pargz_len = argz_len; + + return 0; +} +#endif /* !HAVE_ARGZ_CREATE_SEP */ + + +#if ! HAVE_ARGZ_INSERT +# define argz_insert rpl_argz_insert + +static error_t argz_insert LT_PARAMS((char **pargz, size_t *pargz_len, + char *before, const char *entry)); + +error_t +argz_insert (pargz, pargz_len, before, entry) + char **pargz; + size_t *pargz_len; + char *before; + const char *entry; +{ + assert (pargz); + assert (pargz_len); + assert (entry && *entry); + + /* Either PARGZ/PARGZ_LEN is empty and BEFORE is NULL, + or BEFORE points into an address within the ARGZ vector. */ + assert ((!*pargz && !*pargz_len && !before) + || ((*pargz <= before) && (before < (*pargz + *pargz_len)))); + + /* No BEFORE address indicates ENTRY should be inserted after the + current last element. */ + if (!before) + return argz_append (pargz, pargz_len, entry, 1+ LT_STRLEN (entry)); + + /* This probably indicates a programmer error, but to preserve + semantics, scan back to the start of an entry if BEFORE points + into the middle of it. */ + while ((before >= *pargz) && (before[-1] != LT_EOS_CHAR)) + --before; + + { + size_t entry_len = 1+ LT_STRLEN (entry); + size_t argz_len = *pargz_len + entry_len; + size_t offset = before - *pargz; + char *argz = LT_DLREALLOC (char, *pargz, argz_len); + + if (!argz) + return ENOMEM; + + /* Make BEFORE point to the equivalent offset in ARGZ that it + used to have in *PARGZ incase realloc() moved the block. */ + before = argz + offset; + + /* Move the ARGZ entries starting at BEFORE up into the new + space at the end -- making room to copy ENTRY into the + resulting gap. */ + memmove (before + entry_len, before, *pargz_len - offset); + memcpy (before, entry, entry_len); + + /* Assign new values. */ + *pargz = argz; + *pargz_len = argz_len; + } + + return 0; +} +#endif /* !HAVE_ARGZ_INSERT */ + + +#if ! HAVE_ARGZ_NEXT +# define argz_next rpl_argz_next + +static char *argz_next LT_PARAMS((char *argz, size_t argz_len, + const char *entry)); + +char * +argz_next (argz, argz_len, entry) + char *argz; + size_t argz_len; + const char *entry; +{ + assert ((argz && argz_len) || (!argz && !argz_len)); + + if (entry) + { + /* Either ARGZ/ARGZ_LEN is empty, or ENTRY points into an address + within the ARGZ vector. */ + assert ((!argz && !argz_len) + || ((argz <= entry) && (entry < (argz + argz_len)))); + + /* Move to the char immediately after the terminating + '\0' of ENTRY. */ + entry = 1+ strchr (entry, LT_EOS_CHAR); + + /* Return either the new ENTRY, or else NULL if ARGZ is + exhausted. */ + return (entry >= argz + argz_len) ? 0 : (char *) entry; + } + else + { + /* This should probably be flagged as a programmer error, + since starting an argz_next loop with the iterator set + to ARGZ is safer. To preserve semantics, handle the NULL + case by returning the start of ARGZ (if any). */ + if (argz_len > 0) + return argz; + else + return 0; + } +} +#endif /* !HAVE_ARGZ_NEXT */ + + + +#if ! HAVE_ARGZ_STRINGIFY +# define argz_stringify rpl_argz_stringify + +static void argz_stringify LT_PARAMS((char *argz, size_t argz_len, + int sep)); + +void +argz_stringify (argz, argz_len, sep) + char *argz; + size_t argz_len; + int sep; +{ + assert ((argz && argz_len) || (!argz && !argz_len)); + + if (sep) + { + --argz_len; /* don't stringify the terminating EOS */ + while (--argz_len > 0) + { + if (argz[argz_len] == LT_EOS_CHAR) + argz[argz_len] = sep; + } + } +} +#endif /* !HAVE_ARGZ_STRINGIFY */ + + + + +/* --- TYPE DEFINITIONS -- */ + + +/* This type is used for the array of caller data sets in each handler. */ +typedef struct { + lt_dlcaller_id key; + lt_ptr data; +} lt_caller_data; + + + + +/* --- OPAQUE STRUCTURES DECLARED IN LTDL.H --- */ + + +/* Extract the diagnostic strings from the error table macro in the same + order as the enumerated indices in ltdl.h. */ + +static const char *lt_dlerror_strings[] = + { +#define LT_ERROR(name, diagnostic) (diagnostic), + lt_dlerror_table +#undef LT_ERROR + + 0 + }; + +/* This structure is used for the list of registered loaders. */ +struct lt_dlloader { + struct lt_dlloader *next; + const char *loader_name; /* identifying name for each loader */ + const char *sym_prefix; /* prefix for symbols */ + lt_module_open *module_open; + lt_module_close *module_close; + lt_find_sym *find_sym; + lt_dlloader_exit *dlloader_exit; + lt_user_data dlloader_data; +}; + +struct lt_dlhandle_struct { + struct lt_dlhandle_struct *next; + lt_dlloader *loader; /* dlopening interface */ + lt_dlinfo info; + int depcount; /* number of dependencies */ + lt_dlhandle *deplibs; /* dependencies */ + lt_module module; /* system module handle */ + lt_ptr system; /* system specific data */ + lt_caller_data *caller_data; /* per caller associated data */ + int flags; /* various boolean stats */ +}; + +/* Various boolean flags can be stored in the flags field of an + lt_dlhandle_struct... */ +#define LT_DLGET_FLAG(handle, flag) (((handle)->flags & (flag)) == (flag)) +#define LT_DLSET_FLAG(handle, flag) ((handle)->flags |= (flag)) + +#define LT_DLRESIDENT_FLAG (0x01 << 0) +/* ...add more flags here... */ + +#define LT_DLIS_RESIDENT(handle) LT_DLGET_FLAG(handle, LT_DLRESIDENT_FLAG) + + +#define LT_DLSTRERROR(name) lt_dlerror_strings[LT_CONC(LT_ERROR_,name)] + +static const char objdir[] = LTDL_OBJDIR; +static const char archive_ext[] = LTDL_ARCHIVE_EXT; +#ifdef LTDL_SHLIB_EXT +static const char shlib_ext[] = LTDL_SHLIB_EXT; +#endif +#ifdef LTDL_SYSSEARCHPATH +static const char sys_search_path[] = LTDL_SYSSEARCHPATH; +#endif + + + + +/* --- MUTEX LOCKING --- */ + + +/* Macros to make it easier to run the lock functions only if they have + been registered. The reason for the complicated lock macro is to + ensure that the stored error message from the last error is not + accidentally erased if the current function doesn't generate an + error of its own. */ +#define LT_DLMUTEX_LOCK() LT_STMT_START { \ + if (lt_dlmutex_lock_func) (*lt_dlmutex_lock_func)(); \ + } LT_STMT_END +#define LT_DLMUTEX_UNLOCK() LT_STMT_START { \ + if (lt_dlmutex_unlock_func) (*lt_dlmutex_unlock_func)();\ + } LT_STMT_END +#define LT_DLMUTEX_SETERROR(errormsg) LT_STMT_START { \ + if (lt_dlmutex_seterror_func) \ + (*lt_dlmutex_seterror_func) (errormsg); \ + else lt_dllast_error = (errormsg); } LT_STMT_END +#define LT_DLMUTEX_GETERROR(errormsg) LT_STMT_START { \ + if (lt_dlmutex_seterror_func) \ + (errormsg) = (*lt_dlmutex_geterror_func) (); \ + else (errormsg) = lt_dllast_error; } LT_STMT_END + +/* The mutex functions stored here are global, and are necessarily the + same for all threads that wish to share access to libltdl. */ +static lt_dlmutex_lock *lt_dlmutex_lock_func = 0; +static lt_dlmutex_unlock *lt_dlmutex_unlock_func = 0; +static lt_dlmutex_seterror *lt_dlmutex_seterror_func = 0; +static lt_dlmutex_geterror *lt_dlmutex_geterror_func = 0; +static const char *lt_dllast_error = 0; + + +/* Either set or reset the mutex functions. Either all the arguments must + be valid functions, or else all can be NULL to turn off locking entirely. + The registered functions should be manipulating a static global lock + from the lock() and unlock() callbacks, which needs to be reentrant. */ +int +lt_dlmutex_register (lock, unlock, seterror, geterror) + lt_dlmutex_lock *lock; + lt_dlmutex_unlock *unlock; + lt_dlmutex_seterror *seterror; + lt_dlmutex_geterror *geterror; +{ + lt_dlmutex_unlock *old_unlock = unlock; + int errors = 0; + + /* Lock using the old lock() callback, if any. */ + LT_DLMUTEX_LOCK (); + + if ((lock && unlock && seterror && geterror) + || !(lock || unlock || seterror || geterror)) + { + lt_dlmutex_lock_func = lock; + lt_dlmutex_unlock_func = unlock; + lt_dlmutex_geterror_func = geterror; + } + else + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_MUTEX_ARGS)); + ++errors; + } + + /* Use the old unlock() callback we saved earlier, if any. Otherwise + record any errors using internal storage. */ + if (old_unlock) + (*old_unlock) (); + + /* Return the number of errors encountered during the execution of + this function. */ + return errors; +} + + + + +/* --- ERROR HANDLING --- */ + + +static const char **user_error_strings = 0; +static int errorcount = LT_ERROR_MAX; + +int +lt_dladderror (diagnostic) + const char *diagnostic; +{ + int errindex = 0; + int result = -1; + const char **temp = (const char **) 0; + + assert (diagnostic); + + LT_DLMUTEX_LOCK (); + + errindex = errorcount - LT_ERROR_MAX; + temp = LT_EREALLOC (const char *, user_error_strings, 1 + errindex); + if (temp) + { + user_error_strings = temp; + user_error_strings[errindex] = diagnostic; + result = errorcount++; + } + + LT_DLMUTEX_UNLOCK (); + + return result; +} + +int +lt_dlseterror (errindex) + int errindex; +{ + int errors = 0; + + LT_DLMUTEX_LOCK (); + + if (errindex >= errorcount || errindex < 0) + { + /* Ack! Error setting the error message! */ + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_ERRORCODE)); + ++errors; + } + else if (errindex < LT_ERROR_MAX) + { + /* No error setting the error message! */ + LT_DLMUTEX_SETERROR (lt_dlerror_strings[errindex]); + } + else + { + /* No error setting the error message! */ + LT_DLMUTEX_SETERROR (user_error_strings[errindex - LT_ERROR_MAX]); + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +lt_ptr +lt_emalloc (size) + size_t size; +{ + lt_ptr mem = lt_dlmalloc (size); + if (size && !mem) + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + return mem; +} + +lt_ptr +lt_erealloc (addr, size) + lt_ptr addr; + size_t size; +{ + lt_ptr mem = realloc (addr, size); + if (size && !mem) + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + return mem; +} + +char * +lt_estrdup (str) + const char *str; +{ + char *dup = strdup (str); + if (LT_STRLEN (str) && !dup) + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + return dup; +} + + + + +/* --- DLOPEN() INTERFACE LOADER --- */ + + +/* The Cygwin dlopen implementation prints a spurious error message to + stderr if its call to LoadLibrary() fails for any reason. We can + mitigate this by not using the Cygwin implementation, and falling + back to our own LoadLibrary() wrapper. */ +#if HAVE_LIBDL && !defined(__CYGWIN__) + +/* dynamic linking with dlopen/dlsym */ + +#if HAVE_DLFCN_H +# include +#endif + +#if HAVE_SYS_DL_H +# include +#endif + +#ifdef RTLD_GLOBAL +# define LT_GLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_GLOBAL DL_GLOBAL +# endif +#endif /* !RTLD_GLOBAL */ +#ifndef LT_GLOBAL +# define LT_GLOBAL 0 +#endif /* !LT_GLOBAL */ + +/* We may have to define LT_LAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_LAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_LAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_LAZY_OR_NOW DL_LAZY +# endif +# endif /* !RTLD_LAZY */ +#endif +#ifndef LT_LAZY_OR_NOW +# ifdef RTLD_NOW +# define LT_LAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_LAZY_OR_NOW DL_NOW +# endif +# endif /* !RTLD_NOW */ +#endif +#ifndef LT_LAZY_OR_NOW +# define LT_LAZY_OR_NOW 0 +#endif /* !LT_LAZY_OR_NOW */ + +#if HAVE_DLERROR +# define DLERROR(arg) dlerror () +#else +# define DLERROR(arg) LT_DLSTRERROR (arg) +#endif + +static lt_module +sys_dl_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + lt_module module = dlopen (filename, LT_GLOBAL | LT_LAZY_OR_NOW); + + if (!module) + { + LT_DLMUTEX_SETERROR (DLERROR (CANNOT_OPEN)); + } + + return module; +} + +static int +sys_dl_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (dlclose (module) != 0) + { + LT_DLMUTEX_SETERROR (DLERROR (CANNOT_CLOSE)); + ++errors; + } + + return errors; +} + +static lt_ptr +sys_dl_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = dlsym (module, symbol); + + if (!address) + { + LT_DLMUTEX_SETERROR (DLERROR (SYMBOL_NOT_FOUND)); + } + + return address; +} + +static struct lt_user_dlloader sys_dl = + { +# ifdef NEED_USCORE + "_", +# else + 0, +# endif + sys_dl_open, sys_dl_close, sys_dl_sym, 0, 0 }; + + +#endif /* HAVE_LIBDL */ + + + +/* --- SHL_LOAD() INTERFACE LOADER --- */ + +#if HAVE_SHL_LOAD + +/* dynamic linking with shl_load (HP-UX) (comments from gmodule) */ + +#ifdef HAVE_DL_H +# include +#endif + +/* some flags are missing on some systems, so we provide + * harmless defaults. + * + * Mandatory: + * BIND_IMMEDIATE - Resolve symbol references when the library is loaded. + * BIND_DEFERRED - Delay code symbol resolution until actual reference. + * + * Optionally: + * BIND_FIRST - Place the library at the head of the symbol search + * order. + * BIND_NONFATAL - The default BIND_IMMEDIATE behavior is to treat all + * unsatisfied symbols as fatal. This flag allows + * binding of unsatisfied code symbols to be deferred + * until use. + * [Perl: For certain libraries, like DCE, deferred + * binding often causes run time problems. Adding + * BIND_NONFATAL to BIND_IMMEDIATE still allows + * unresolved references in situations like this.] + * BIND_NOSTART - Do not call the initializer for the shared library + * when the library is loaded, nor on a future call to + * shl_unload(). + * BIND_VERBOSE - Print verbose messages concerning possible + * unsatisfied symbols. + * + * hp9000s700/hp9000s800: + * BIND_RESTRICTED - Restrict symbols visible by the library to those + * present at library load time. + * DYNAMIC_PATH - Allow the loader to dynamically search for the + * library specified by the path argument. + */ + +#ifndef DYNAMIC_PATH +# define DYNAMIC_PATH 0 +#endif +#ifndef BIND_RESTRICTED +# define BIND_RESTRICTED 0 +#endif + +#define LT_BIND_FLAGS (BIND_IMMEDIATE | BIND_NONFATAL | DYNAMIC_PATH) + +static lt_module +sys_shl_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + static shl_t self = (shl_t) 0; + lt_module module = shl_load (filename, LT_BIND_FLAGS, 0L); + + /* Since searching for a symbol against a NULL module handle will also + look in everything else that was already loaded and exported with + the -E compiler flag, we always cache a handle saved before any + modules are loaded. */ + if (!self) + { + lt_ptr address; + shl_findsym (&self, "main", TYPE_UNDEFINED, &address); + } + + if (!filename) + { + module = self; + } + else + { + module = shl_load (filename, LT_BIND_FLAGS, 0L); + + if (!module) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); + } + } + + return module; +} + +static int +sys_shl_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (module && (shl_unload ((shl_t) (module)) != 0)) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); + ++errors; + } + + return errors; +} + +static lt_ptr +sys_shl_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = 0; + + /* sys_shl_open should never return a NULL module handle */ + if (module == (lt_module) 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + } + else if (!shl_findsym((shl_t*) &module, symbol, TYPE_UNDEFINED, &address)) + { + if (!address) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + } + } + + return address; +} + +static struct lt_user_dlloader sys_shl = { + 0, sys_shl_open, sys_shl_close, sys_shl_sym, 0, 0 +}; + +#endif /* HAVE_SHL_LOAD */ + + + + +/* --- LOADLIBRARY() INTERFACE LOADER --- */ + +#ifdef __WINDOWS__ + +/* dynamic linking for Win32 */ + +#include + +/* Forward declaration; required to implement handle search below. */ +static lt_dlhandle handles; + +static lt_module +sys_wll_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + lt_dlhandle cur; + lt_module module = 0; + const char *errormsg = 0; + char *searchname = 0; + char *ext; + char self_name_buf[MAX_PATH]; + + if (!filename) + { + /* Get the name of main module */ + *self_name_buf = 0; + GetModuleFileName (NULL, self_name_buf, sizeof (self_name_buf)); + filename = ext = self_name_buf; + } + else + { + ext = strrchr (filename, '.'); + } + + if (ext) + { + /* FILENAME already has an extension. */ + searchname = lt_estrdup (filename); + } + else + { + /* Append a `.' to stop Windows from adding an + implicit `.dll' extension. */ + searchname = LT_EMALLOC (char, 2+ LT_STRLEN (filename)); + if (searchname) + sprintf (searchname, "%s.", filename); + } + if (!searchname) + return 0; + +#if __CYGWIN__ + { + char wpath[MAX_PATH]; + cygwin_conv_to_full_win32_path(searchname, wpath); + module = LoadLibrary(wpath); + } +#else + module = LoadLibrary (searchname); +#endif + LT_DLFREE (searchname); + + /* libltdl expects this function to fail if it is unable + to physically load the library. Sadly, LoadLibrary + will search the loaded libraries for a match and return + one of them if the path search load fails. + + We check whether LoadLibrary is returning a handle to + an already loaded module, and simulate failure if we + find one. */ + LT_DLMUTEX_LOCK (); + cur = handles; + while (cur) + { + if (!cur->module) + { + cur = 0; + break; + } + + if (cur->module == module) + { + break; + } + + cur = cur->next; + } + LT_DLMUTEX_UNLOCK (); + + if (cur || !module) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); + module = 0; + } + + return module; +} + +static int +sys_wll_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (FreeLibrary(module) == 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); + ++errors; + } + + return errors; +} + +static lt_ptr +sys_wll_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = GetProcAddress (module, symbol); + + if (!address) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + } + + return address; +} + +static struct lt_user_dlloader sys_wll = { + 0, sys_wll_open, sys_wll_close, sys_wll_sym, 0, 0 +}; + +#endif /* __WINDOWS__ */ + + + + +/* --- LOAD_ADD_ON() INTERFACE LOADER --- */ + + +#ifdef __BEOS__ + +/* dynamic linking for BeOS */ + +#include + +static lt_module +sys_bedl_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + image_id image = 0; + + if (filename) + { + image = load_add_on (filename); + } + else + { + image_info info; + int32 cookie = 0; + if (get_next_image_info (0, &cookie, &info) == B_OK) + image = load_add_on (info.name); + } + + if (image <= 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); + image = 0; + } + + return (lt_module) image; +} + +static int +sys_bedl_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (unload_add_on ((image_id) module) != B_OK) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); + ++errors; + } + + return errors; +} + +static lt_ptr +sys_bedl_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = 0; + image_id image = (image_id) module; + + if (get_image_symbol (image, symbol, B_SYMBOL_TYPE_ANY, address) != B_OK) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + address = 0; + } + + return address; +} + +static struct lt_user_dlloader sys_bedl = { + 0, sys_bedl_open, sys_bedl_close, sys_bedl_sym, 0, 0 +}; + +#endif /* __BEOS__ */ + + + + +/* --- DLD_LINK() INTERFACE LOADER --- */ + + +#if HAVE_DLD + +/* dynamic linking with dld */ + +#if HAVE_DLD_H +#include +#endif + +static lt_module +sys_dld_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + lt_module module = strdup (filename); + + if (dld_link (filename) != 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); + LT_DLFREE (module); + module = 0; + } + + return module; +} + +static int +sys_dld_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (dld_unlink_by_file ((char*)(module), 1) != 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); + ++errors; + } + else + { + LT_DLFREE (module); + } + + return errors; +} + +static lt_ptr +sys_dld_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = dld_get_func (symbol); + + if (!address) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + } + + return address; +} + +static struct lt_user_dlloader sys_dld = { + 0, sys_dld_open, sys_dld_close, sys_dld_sym, 0, 0 +}; + +#endif /* HAVE_DLD */ + + + + +/* --- DLPREOPEN() INTERFACE LOADER --- */ + + +/* emulate dynamic linking using preloaded_symbols */ + +typedef struct lt_dlsymlists_t +{ + struct lt_dlsymlists_t *next; + const lt_dlsymlist *syms; +} lt_dlsymlists_t; + +static const lt_dlsymlist *default_preloaded_symbols = 0; +static lt_dlsymlists_t *preloaded_symbols = 0; + +static int +presym_init (loader_data) + lt_user_data loader_data; +{ + int errors = 0; + + LT_DLMUTEX_LOCK (); + + preloaded_symbols = 0; + if (default_preloaded_symbols) + { + errors = lt_dlpreload (default_preloaded_symbols); + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +static int +presym_free_symlists () +{ + lt_dlsymlists_t *lists; + + LT_DLMUTEX_LOCK (); + + lists = preloaded_symbols; + while (lists) + { + lt_dlsymlists_t *tmp = lists; + + lists = lists->next; + LT_DLFREE (tmp); + } + preloaded_symbols = 0; + + LT_DLMUTEX_UNLOCK (); + + return 0; +} + +static int +presym_exit (loader_data) + lt_user_data loader_data; +{ + presym_free_symlists (); + return 0; +} + +static int +presym_add_symlist (preloaded) + const lt_dlsymlist *preloaded; +{ + lt_dlsymlists_t *tmp; + lt_dlsymlists_t *lists; + int errors = 0; + + LT_DLMUTEX_LOCK (); + + lists = preloaded_symbols; + while (lists) + { + if (lists->syms == preloaded) + { + goto done; + } + lists = lists->next; + } + + tmp = LT_EMALLOC (lt_dlsymlists_t, 1); + if (tmp) + { + memset (tmp, 0, sizeof(lt_dlsymlists_t)); + tmp->syms = preloaded; + tmp->next = preloaded_symbols; + preloaded_symbols = tmp; + } + else + { + ++errors; + } + + done: + LT_DLMUTEX_UNLOCK (); + return errors; +} + +static lt_module +presym_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + lt_dlsymlists_t *lists; + lt_module module = (lt_module) 0; + + LT_DLMUTEX_LOCK (); + lists = preloaded_symbols; + + if (!lists) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_SYMBOLS)); + goto done; + } + + /* Can't use NULL as the reflective symbol header, as NULL is + used to mark the end of the entire symbol list. Self-dlpreopened + symbols follow this magic number, chosen to be an unlikely + clash with a real module name. */ + if (!filename) + { + filename = "@PROGRAM@"; + } + + while (lists) + { + const lt_dlsymlist *syms = lists->syms; + + while (syms->name) + { + if (!syms->address && strcmp(syms->name, filename) == 0) + { + module = (lt_module) syms; + goto done; + } + ++syms; + } + + lists = lists->next; + } + + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); + + done: + LT_DLMUTEX_UNLOCK (); + return module; +} + +static int +presym_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + /* Just to silence gcc -Wall */ + module = 0; + return 0; +} + +static lt_ptr +presym_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_dlsymlist *syms = (lt_dlsymlist*) module; + + ++syms; + while (syms->address) + { + if (strcmp(syms->name, symbol) == 0) + { + return syms->address; + } + + ++syms; + } + + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + + return 0; +} + +static struct lt_user_dlloader presym = { + 0, presym_open, presym_close, presym_sym, presym_exit, 0 +}; + + + + + +/* --- DYNAMIC MODULE LOADING --- */ + + +/* The type of a function used at each iteration of foreach_dirinpath(). */ +typedef int foreach_callback_func LT_PARAMS((char *filename, lt_ptr data1, + lt_ptr data2)); + +static int foreach_dirinpath LT_PARAMS((const char *search_path, + const char *base_name, + foreach_callback_func *func, + lt_ptr data1, lt_ptr data2)); + +static int find_file_callback LT_PARAMS((char *filename, lt_ptr data, + lt_ptr ignored)); +static int find_handle_callback LT_PARAMS((char *filename, lt_ptr data, + lt_ptr ignored)); +static int foreachfile_callback LT_PARAMS((char *filename, lt_ptr data1, + lt_ptr data2)); + + +static int canonicalize_path LT_PARAMS((const char *path, + char **pcanonical)); +static int argzize_path LT_PARAMS((const char *path, + char **pargz, + size_t *pargz_len)); +static FILE *find_file LT_PARAMS((const char *search_path, + const char *base_name, + char **pdir)); +static lt_dlhandle *find_handle LT_PARAMS((const char *search_path, + const char *base_name, + lt_dlhandle *handle)); +static int find_module LT_PARAMS((lt_dlhandle *handle, + const char *dir, + const char *libdir, + const char *dlname, + const char *old_name, + int installed)); +static int free_vars LT_PARAMS((char *dlname, char *oldname, + char *libdir, char *deplibs)); +static int load_deplibs LT_PARAMS((lt_dlhandle handle, + char *deplibs)); +static int trim LT_PARAMS((char **dest, + const char *str)); +static int try_dlopen LT_PARAMS((lt_dlhandle *handle, + const char *filename)); +static int tryall_dlopen LT_PARAMS((lt_dlhandle *handle, + const char *filename)); +static int unload_deplibs LT_PARAMS((lt_dlhandle handle)); +static int lt_argz_insert LT_PARAMS((char **pargz, + size_t *pargz_len, + char *before, + const char *entry)); +static int lt_argz_insertinorder LT_PARAMS((char **pargz, + size_t *pargz_len, + const char *entry)); +static int lt_dlpath_insertdir LT_PARAMS((char **ppath, + char *before, + const char *dir)); + +static char *user_search_path= 0; +static lt_dlloader *loaders = 0; +static lt_dlhandle handles = 0; +static int initialized = 0; + +/* Initialize libltdl. */ +int +lt_dlinit () +{ + int errors = 0; + + LT_DLMUTEX_LOCK (); + + /* Initialize only at first call. */ + if (++initialized == 1) + { + handles = 0; + user_search_path = 0; /* empty search path */ + +#if HAVE_LIBDL && !defined(__CYGWIN__) + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dl, "dlopen"); +#endif +#if HAVE_SHL_LOAD + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_shl, "dlopen"); +#endif +#ifdef __WINDOWS__ + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_wll, "dlopen"); +#endif +#ifdef __BEOS__ + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_bedl, "dlopen"); +#endif +#if HAVE_DLD + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dld, "dld"); +#endif + errors += lt_dlloader_add (lt_dlloader_next (0), &presym, "dlpreload"); + + if (presym_init (presym.dlloader_data)) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INIT_LOADER)); + ++errors; + } + else if (errors != 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (DLOPEN_NOT_SUPPORTED)); + ++errors; + } + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +int +lt_dlpreload (preloaded) + const lt_dlsymlist *preloaded; +{ + int errors = 0; + + if (preloaded) + { + errors = presym_add_symlist (preloaded); + } + else + { + presym_free_symlists(); + + LT_DLMUTEX_LOCK (); + if (default_preloaded_symbols) + { + errors = lt_dlpreload (default_preloaded_symbols); + } + LT_DLMUTEX_UNLOCK (); + } + + return errors; +} + +int +lt_dlpreload_default (preloaded) + const lt_dlsymlist *preloaded; +{ + LT_DLMUTEX_LOCK (); + default_preloaded_symbols = preloaded; + LT_DLMUTEX_UNLOCK (); + return 0; +} + +int +lt_dlexit () +{ + /* shut down libltdl */ + lt_dlloader *loader; + int errors = 0; + + LT_DLMUTEX_LOCK (); + loader = loaders; + + if (!initialized) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SHUTDOWN)); + ++errors; + goto done; + } + + /* shut down only at last call. */ + if (--initialized == 0) + { + int level; + + while (handles && LT_DLIS_RESIDENT (handles)) + { + handles = handles->next; + } + + /* close all modules */ + for (level = 1; handles; ++level) + { + lt_dlhandle cur = handles; + int saw_nonresident = 0; + + while (cur) + { + lt_dlhandle tmp = cur; + cur = cur->next; + if (!LT_DLIS_RESIDENT (tmp)) + saw_nonresident = 1; + if (!LT_DLIS_RESIDENT (tmp) && tmp->info.ref_count <= level) + { + if (lt_dlclose (tmp)) + { + ++errors; + } + } + } + /* done if only resident modules are left */ + if (!saw_nonresident) + break; + } + + /* close all loaders */ + while (loader) + { + lt_dlloader *next = loader->next; + lt_user_data data = loader->dlloader_data; + if (loader->dlloader_exit && loader->dlloader_exit (data)) + { + ++errors; + } + + LT_DLMEM_REASSIGN (loader, next); + } + loaders = 0; + } + + done: + LT_DLMUTEX_UNLOCK (); + return errors; +} + +static int +tryall_dlopen (handle, filename) + lt_dlhandle *handle; + const char *filename; +{ + lt_dlhandle cur; + lt_dlloader *loader; + const char *saved_error; + int errors = 0; + + LT_DLMUTEX_GETERROR (saved_error); + LT_DLMUTEX_LOCK (); + + cur = handles; + loader = loaders; + + /* check whether the module was already opened */ + while (cur) + { + /* try to dlopen the program itself? */ + if (!cur->info.filename && !filename) + { + break; + } + + if (cur->info.filename && filename + && strcmp (cur->info.filename, filename) == 0) + { + break; + } + + cur = cur->next; + } + + if (cur) + { + ++cur->info.ref_count; + *handle = cur; + goto done; + } + + cur = *handle; + if (filename) + { + cur->info.filename = lt_estrdup (filename); + if (!cur->info.filename) + { + ++errors; + goto done; + } + } + else + { + cur->info.filename = 0; + } + + while (loader) + { + lt_user_data data = loader->dlloader_data; + + cur->module = loader->module_open (data, filename); + + if (cur->module != 0) + { + break; + } + loader = loader->next; + } + + if (!loader) + { + LT_DLFREE (cur->info.filename); + ++errors; + goto done; + } + + cur->loader = loader; + LT_DLMUTEX_SETERROR (saved_error); + + done: + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +static int +tryall_dlopen_module (handle, prefix, dirname, dlname) + lt_dlhandle *handle; + const char *prefix; + const char *dirname; + const char *dlname; +{ + int error = 0; + char *filename = 0; + size_t filename_len = 0; + size_t dirname_len = LT_STRLEN (dirname); + + assert (handle); + assert (dirname); + assert (dlname); +#ifdef LT_DIRSEP_CHAR + /* Only canonicalized names (i.e. with DIRSEP chars already converted) + should make it into this function: */ + assert (strchr (dirname, LT_DIRSEP_CHAR) == 0); +#endif + + if (dirname[dirname_len -1] == '/') + --dirname_len; + filename_len = dirname_len + 1 + LT_STRLEN (dlname); + + /* Allocate memory, and combine DIRNAME and MODULENAME into it. + The PREFIX (if any) is handled below. */ + filename = LT_EMALLOC (char, dirname_len + 1 + filename_len + 1); + if (!filename) + return 1; + + sprintf (filename, "%.*s/%s", (int) dirname_len, dirname, dlname); + + /* Now that we have combined DIRNAME and MODULENAME, if there is + also a PREFIX to contend with, simply recurse with the arguments + shuffled. Otherwise, attempt to open FILENAME as a module. */ + if (prefix) + { + error += tryall_dlopen_module (handle, + (const char *) 0, prefix, filename); + } + else if (tryall_dlopen (handle, filename) != 0) + { + ++error; + } + + LT_DLFREE (filename); + return error; +} + +static int +find_module (handle, dir, libdir, dlname, old_name, installed) + lt_dlhandle *handle; + const char *dir; + const char *libdir; + const char *dlname; + const char *old_name; + int installed; +{ + /* Try to open the old library first; if it was dlpreopened, + we want the preopened version of it, even if a dlopenable + module is available. */ + if (old_name && tryall_dlopen (handle, old_name) == 0) + { + return 0; + } + + /* Try to open the dynamic library. */ + if (dlname) + { + /* try to open the installed module */ + if (installed && libdir) + { + if (tryall_dlopen_module (handle, + (const char *) 0, libdir, dlname) == 0) + return 0; + } + + /* try to open the not-installed module */ + if (!installed) + { + if (tryall_dlopen_module (handle, dir, objdir, dlname) == 0) + return 0; + } + + /* maybe it was moved to another directory */ + { + if (tryall_dlopen_module (handle, + (const char *) 0, dir, dlname) == 0) + return 0; + } + } + + return 1; +} + + +static int +canonicalize_path (path, pcanonical) + const char *path; + char **pcanonical; +{ + char *canonical = 0; + + assert (path && *path); + assert (pcanonical); + + canonical = LT_EMALLOC (char, 1+ LT_STRLEN (path)); + if (!canonical) + return 1; + + { + size_t dest = 0; + size_t src; + for (src = 0; path[src] != LT_EOS_CHAR; ++src) + { + /* Path separators are not copied to the beginning or end of + the destination, or if another separator would follow + immediately. */ + if (path[src] == LT_PATHSEP_CHAR) + { + if ((dest == 0) + || (path[1+ src] == LT_PATHSEP_CHAR) + || (path[1+ src] == LT_EOS_CHAR)) + continue; + } + + /* Anything other than a directory separator is copied verbatim. */ + if ((path[src] != '/') +#ifdef LT_DIRSEP_CHAR + && (path[src] != LT_DIRSEP_CHAR) +#endif + ) + { + canonical[dest++] = path[src]; + } + /* Directory separators are converted and copied only if they are + not at the end of a path -- i.e. before a path separator or + NULL terminator. */ + else if ((path[1+ src] != LT_PATHSEP_CHAR) + && (path[1+ src] != LT_EOS_CHAR) +#ifdef LT_DIRSEP_CHAR + && (path[1+ src] != LT_DIRSEP_CHAR) +#endif + && (path[1+ src] != '/')) + { + canonical[dest++] = '/'; + } + } + + /* Add an end-of-string marker at the end. */ + canonical[dest] = LT_EOS_CHAR; + } + + /* Assign new value. */ + *pcanonical = canonical; + + return 0; +} + +static int +argzize_path (path, pargz, pargz_len) + const char *path; + char **pargz; + size_t *pargz_len; +{ + error_t error; + + assert (path); + assert (pargz); + assert (pargz_len); + + if ((error = argz_create_sep (path, LT_PATHSEP_CHAR, pargz, pargz_len))) + { + switch (error) + { + case ENOMEM: + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + break; + default: + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN)); + break; + } + + return 1; + } + + return 0; +} + +/* Repeatedly call FUNC with each LT_PATHSEP_CHAR delimited element + of SEARCH_PATH and references to DATA1 and DATA2, until FUNC returns + non-zero or all elements are exhausted. If BASE_NAME is non-NULL, + it is appended to each SEARCH_PATH element before FUNC is called. */ +static int +foreach_dirinpath (search_path, base_name, func, data1, data2) + const char *search_path; + const char *base_name; + foreach_callback_func *func; + lt_ptr data1; + lt_ptr data2; +{ + int result = 0; + int filenamesize = 0; + int lenbase = LT_STRLEN (base_name); + size_t argz_len = 0; + char * argz = 0; + char * filename = 0; + char * canonical = 0; + + LT_DLMUTEX_LOCK (); + + if (!search_path || !*search_path) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); + goto cleanup; + } + + if (canonicalize_path (search_path, &canonical) != 0) + goto cleanup; + + if (argzize_path (canonical, &argz, &argz_len) != 0) + goto cleanup; + + { + char *dir_name = 0; + while ((dir_name = argz_next (argz, argz_len, dir_name))) + { + int lendir = LT_STRLEN (dir_name); + + if (lendir +1 +lenbase >= filenamesize) + { + LT_DLFREE (filename); + filenamesize = lendir +1 +lenbase +1; /* "/d" + '/' + "f" + '\0' */ + filename = LT_EMALLOC (char, filenamesize); + if (!filename) + goto cleanup; + } + + strncpy (filename, dir_name, lendir); + if (base_name && *base_name) + { + if (filename[lendir -1] != '/') + filename[lendir++] = '/'; + strcpy (filename +lendir, base_name); + } + + if ((result = (*func) (filename, data1, data2))) + { + break; + } + } + } + + cleanup: + LT_DLFREE (argz); + LT_DLFREE (canonical); + LT_DLFREE (filename); + + LT_DLMUTEX_UNLOCK (); + + return result; +} + +/* If FILEPATH can be opened, store the name of the directory component + in DATA1, and the opened FILE* structure address in DATA2. Otherwise + DATA1 is unchanged, but DATA2 is set to a pointer to NULL. */ +static int +find_file_callback (filename, data1, data2) + char *filename; + lt_ptr data1; + lt_ptr data2; +{ + char **pdir = (char **) data1; + FILE **pfile = (FILE **) data2; + int is_done = 0; + + assert (filename && *filename); + assert (pdir); + assert (pfile); + + if ((*pfile = fopen (filename, LT_READTEXT_MODE))) + { + char *dirend = strrchr (filename, '/'); + + if (dirend > filename) + *dirend = LT_EOS_CHAR; + + LT_DLFREE (*pdir); + *pdir = lt_estrdup (filename); + is_done = (*pdir == 0) ? -1 : 1; + } + + return is_done; +} + +static FILE * +find_file (search_path, base_name, pdir) + const char *search_path; + const char *base_name; + char **pdir; +{ + FILE *file = 0; + + foreach_dirinpath (search_path, base_name, find_file_callback, pdir, &file); + + return file; +} + +static int +find_handle_callback (filename, data, ignored) + char *filename; + lt_ptr data; + lt_ptr ignored; +{ + lt_dlhandle *handle = (lt_dlhandle *) data; + int found = access (filename, R_OK); + + /* Bail out if file cannot be read... */ + if (!found) + return 0; + + /* Try to dlopen the file, but do not continue searching in any + case. */ + if (tryall_dlopen (handle, filename) != 0) + *handle = 0; + + return 1; +} + +/* If HANDLE was found return it, otherwise return 0. If HANDLE was + found but could not be opened, *HANDLE will be set to 0. */ +static lt_dlhandle * +find_handle (search_path, base_name, handle) + const char *search_path; + const char *base_name; + lt_dlhandle *handle; +{ + if (!search_path) + return 0; + + if (!foreach_dirinpath (search_path, base_name, find_handle_callback, + handle, 0)) + return 0; + + return handle; +} + +static int +load_deplibs (handle, deplibs) + lt_dlhandle handle; + char *deplibs; +{ +#if LTDL_DLOPEN_DEPLIBS + char *p, *save_search_path = 0; + int depcount = 0; + int i; + char **names = 0; +#endif + int errors = 0; + + handle->depcount = 0; + +#if LTDL_DLOPEN_DEPLIBS + if (!deplibs) + { + return errors; + } + ++errors; + + LT_DLMUTEX_LOCK (); + if (user_search_path) + { + save_search_path = lt_estrdup (user_search_path); + if (!save_search_path) + goto cleanup; + } + + /* extract search paths and count deplibs */ + p = deplibs; + while (*p) + { + if (!isspace ((int) *p)) + { + char *end = p+1; + while (*end && !isspace((int) *end)) + { + ++end; + } + + if (strncmp(p, "-L", 2) == 0 || strncmp(p, "-R", 2) == 0) + { + char save = *end; + *end = 0; /* set a temporary string terminator */ + if (lt_dladdsearchdir(p+2)) + { + goto cleanup; + } + *end = save; + } + else + { + ++depcount; + } + + p = end; + } + else + { + ++p; + } + } + + /* restore the old search path */ + LT_DLFREE (user_search_path); + user_search_path = save_search_path; + + LT_DLMUTEX_UNLOCK (); + + if (!depcount) + { + errors = 0; + goto cleanup; + } + + names = LT_EMALLOC (char *, depcount * sizeof (char*)); + if (!names) + goto cleanup; + + /* now only extract the actual deplibs */ + depcount = 0; + p = deplibs; + while (*p) + { + if (isspace ((int) *p)) + { + ++p; + } + else + { + char *end = p+1; + while (*end && !isspace ((int) *end)) + { + ++end; + } + + if (strncmp(p, "-L", 2) != 0 && strncmp(p, "-R", 2) != 0) + { + char *name; + char save = *end; + *end = 0; /* set a temporary string terminator */ + if (strncmp(p, "-l", 2) == 0) + { + size_t name_len = 3+ /* "lib" */ LT_STRLEN (p + 2); + name = LT_EMALLOC (char, 1+ name_len); + if (name) + sprintf (name, "lib%s", p+2); + } + else + name = lt_estrdup(p); + + if (!name) + goto cleanup_names; + + names[depcount++] = name; + *end = save; + } + p = end; + } + } + + /* load the deplibs (in reverse order) + At this stage, don't worry if the deplibs do not load correctly, + they may already be statically linked into the loading application + for instance. There will be a more enlightening error message + later on if the loaded module cannot resolve all of its symbols. */ + if (depcount) + { + int j = 0; + + handle->deplibs = (lt_dlhandle*) LT_EMALLOC (lt_dlhandle *, depcount); + if (!handle->deplibs) + goto cleanup; + + for (i = 0; i < depcount; ++i) + { + handle->deplibs[j] = lt_dlopenext(names[depcount-1-i]); + if (handle->deplibs[j]) + { + ++j; + } + } + + handle->depcount = j; /* Number of successfully loaded deplibs */ + errors = 0; + } + + cleanup_names: + for (i = 0; i < depcount; ++i) + { + LT_DLFREE (names[i]); + } + + cleanup: + LT_DLFREE (names); +#endif + + return errors; +} + +static int +unload_deplibs (handle) + lt_dlhandle handle; +{ + int i; + int errors = 0; + + if (handle->depcount) + { + for (i = 0; i < handle->depcount; ++i) + { + if (!LT_DLIS_RESIDENT (handle->deplibs[i])) + { + errors += lt_dlclose (handle->deplibs[i]); + } + } + } + + return errors; +} + +static int +trim (dest, str) + char **dest; + const char *str; +{ + /* remove the leading and trailing "'" from str + and store the result in dest */ + const char *end = strrchr (str, '\''); + int len = LT_STRLEN (str); + char *tmp; + + LT_DLFREE (*dest); + + if (len > 3 && str[0] == '\'') + { + tmp = LT_EMALLOC (char, end - str); + if (!tmp) + return 1; + + strncpy(tmp, &str[1], (end - str) - 1); + tmp[len-3] = LT_EOS_CHAR; + *dest = tmp; + } + else + { + *dest = 0; + } + + return 0; +} + +static int +free_vars (dlname, oldname, libdir, deplibs) + char *dlname; + char *oldname; + char *libdir; + char *deplibs; +{ + LT_DLFREE (dlname); + LT_DLFREE (oldname); + LT_DLFREE (libdir); + LT_DLFREE (deplibs); + + return 0; +} + +int +try_dlopen (phandle, filename) + lt_dlhandle *phandle; + const char *filename; +{ + const char * ext = 0; + const char * saved_error = 0; + char * canonical = 0; + char * base_name = 0; + char * dir = 0; + char * name = 0; + int errors = 0; + lt_dlhandle newhandle; + + assert (phandle); + assert (*phandle == 0); + + LT_DLMUTEX_GETERROR (saved_error); + + /* dlopen self? */ + if (!filename) + { + *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); + if (*phandle == 0) + return 1; + + memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); + newhandle = *phandle; + + /* lt_dlclose()ing yourself is very bad! Disallow it. */ + LT_DLSET_FLAG (*phandle, LT_DLRESIDENT_FLAG); + + if (tryall_dlopen (&newhandle, 0) != 0) + { + LT_DLFREE (*phandle); + return 1; + } + + goto register_handle; + } + + assert (filename && *filename); + + /* Doing this immediately allows internal functions to safely + assume only canonicalized paths are passed. */ + if (canonicalize_path (filename, &canonical) != 0) + { + ++errors; + goto cleanup; + } + + /* If the canonical module name is a path (relative or absolute) + then split it into a directory part and a name part. */ + base_name = strrchr (canonical, '/'); + if (base_name) + { + size_t dirlen = (1+ base_name) - canonical; + + dir = LT_EMALLOC (char, 1+ dirlen); + if (!dir) + { + ++errors; + goto cleanup; + } + + strncpy (dir, canonical, dirlen); + dir[dirlen] = LT_EOS_CHAR; + + ++base_name; + } + else + LT_DLMEM_REASSIGN (base_name, canonical); + + assert (base_name && *base_name); + + /* Check whether we are opening a libtool module (.la extension). */ + ext = strrchr (base_name, '.'); + if (ext && strcmp (ext, archive_ext) == 0) + { + /* this seems to be a libtool module */ + FILE * file = 0; + char * dlname = 0; + char * old_name = 0; + char * libdir = 0; + char * deplibs = 0; + char * line = 0; + size_t line_len; + int i; + + /* if we can't find the installed flag, it is probably an + installed libtool archive, produced with an old version + of libtool */ + int installed = 1; + + /* extract the module name from the file name */ + name = LT_EMALLOC (char, ext - base_name + 1); + if (!name) + { + ++errors; + goto cleanup; + } + + /* canonicalize the module name */ + for (i = 0; i < ext - base_name; ++i) + { + if (isalnum ((int)(base_name[i]))) + { + name[i] = base_name[i]; + } + else + { + name[i] = '_'; + } + } + name[ext - base_name] = LT_EOS_CHAR; + + /* Now try to open the .la file. If there is no directory name + component, try to find it first in user_search_path and then other + prescribed paths. Otherwise (or in any case if the module was not + yet found) try opening just the module name as passed. */ + if (!dir) + { + const char *search_path; + + LT_DLMUTEX_LOCK (); + search_path = user_search_path; + if (search_path) + file = find_file (user_search_path, base_name, &dir); + LT_DLMUTEX_UNLOCK (); + + if (!file) + { + search_path = getenv (LTDL_SEARCHPATH_VAR); + if (search_path) + file = find_file (search_path, base_name, &dir); + } + +#ifdef LTDL_SHLIBPATH_VAR + if (!file) + { + search_path = getenv (LTDL_SHLIBPATH_VAR); + if (search_path) + file = find_file (search_path, base_name, &dir); + } +#endif +#ifdef LTDL_SYSSEARCHPATH + if (!file && sys_search_path) + { + file = find_file (sys_search_path, base_name, &dir); + } +#endif + } + if (!file) + { + file = fopen (filename, LT_READTEXT_MODE); + } + + /* If we didn't find the file by now, it really isn't there. Set + the status flag, and bail out. */ + if (!file) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); + ++errors; + goto cleanup; + } + + line_len = LT_FILENAME_MAX; + line = LT_EMALLOC (char, line_len); + if (!line) + { + fclose (file); + ++errors; + goto cleanup; + } + + /* read the .la file */ + while (!feof (file)) + { + if (!fgets (line, line_len, file)) + { + break; + } + + /* Handle the case where we occasionally need to read a line + that is longer than the initial buffer size. */ + while (line[LT_STRLEN(line) -1] != '\n') + { + line = LT_DLREALLOC (char, line, line_len *2); + if (!fgets (&line[line_len -1], line_len +1, file)) + { + break; + } + line_len *= 2; + } + + if (line[0] == '\n' || line[0] == '#') + { + continue; + } + +#undef STR_DLNAME +#define STR_DLNAME "dlname=" + if (strncmp (line, STR_DLNAME, sizeof (STR_DLNAME) - 1) == 0) + { + errors += trim (&dlname, &line[sizeof (STR_DLNAME) - 1]); + } + +#undef STR_OLD_LIBRARY +#define STR_OLD_LIBRARY "old_library=" + else if (strncmp (line, STR_OLD_LIBRARY, + sizeof (STR_OLD_LIBRARY) - 1) == 0) + { + errors += trim (&old_name, &line[sizeof (STR_OLD_LIBRARY) - 1]); + } +#undef STR_LIBDIR +#define STR_LIBDIR "libdir=" + else if (strncmp (line, STR_LIBDIR, sizeof (STR_LIBDIR) - 1) == 0) + { + errors += trim (&libdir, &line[sizeof(STR_LIBDIR) - 1]); + } + +#undef STR_DL_DEPLIBS +#define STR_DL_DEPLIBS "dependency_libs=" + else if (strncmp (line, STR_DL_DEPLIBS, + sizeof (STR_DL_DEPLIBS) - 1) == 0) + { + errors += trim (&deplibs, &line[sizeof (STR_DL_DEPLIBS) - 1]); + } + else if (strcmp (line, "installed=yes\n") == 0) + { + installed = 1; + } + else if (strcmp (line, "installed=no\n") == 0) + { + installed = 0; + } + +#undef STR_LIBRARY_NAMES +#define STR_LIBRARY_NAMES "library_names=" + else if (! dlname && strncmp (line, STR_LIBRARY_NAMES, + sizeof (STR_LIBRARY_NAMES) - 1) == 0) + { + char *last_libname; + errors += trim (&dlname, &line[sizeof (STR_LIBRARY_NAMES) - 1]); + if (!errors + && dlname + && (last_libname = strrchr (dlname, ' ')) != 0) + { + last_libname = lt_estrdup (last_libname + 1); + if (!last_libname) + { + ++errors; + goto cleanup; + } + LT_DLMEM_REASSIGN (dlname, last_libname); + } + } + + if (errors) + break; + } + + fclose (file); + LT_DLFREE (line); + + /* allocate the handle */ + *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); + if (*phandle == 0) + ++errors; + + if (errors) + { + free_vars (dlname, old_name, libdir, deplibs); + LT_DLFREE (*phandle); + goto cleanup; + } + + assert (*phandle); + + memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); + if (load_deplibs (*phandle, deplibs) == 0) + { + newhandle = *phandle; + /* find_module may replace newhandle */ + if (find_module (&newhandle, dir, libdir, dlname, old_name, installed)) + { + unload_deplibs (*phandle); + ++errors; + } + } + else + { + ++errors; + } + + free_vars (dlname, old_name, libdir, deplibs); + if (errors) + { + LT_DLFREE (*phandle); + goto cleanup; + } + + if (*phandle != newhandle) + { + unload_deplibs (*phandle); + } + } + else + { + /* not a libtool module */ + *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); + if (*phandle == 0) + { + ++errors; + goto cleanup; + } + + memset (*phandle, 0, sizeof (struct lt_dlhandle_struct)); + newhandle = *phandle; + + /* If the module has no directory name component, try to find it + first in user_search_path and then other prescribed paths. + Otherwise (or in any case if the module was not yet found) try + opening just the module name as passed. */ + if ((dir || (!find_handle (user_search_path, base_name, &newhandle) + && !find_handle (getenv (LTDL_SEARCHPATH_VAR), base_name, + &newhandle) +#ifdef LTDL_SHLIBPATH_VAR + && !find_handle (getenv (LTDL_SHLIBPATH_VAR), base_name, + &newhandle) +#endif +#ifdef LTDL_SYSSEARCHPATH + && !find_handle (sys_search_path, base_name, &newhandle) +#endif + ))) + { + tryall_dlopen (&newhandle, filename); + } + + if (!newhandle) + { + LT_DLFREE (*phandle); + ++errors; + goto cleanup; + } + } + + register_handle: + LT_DLMEM_REASSIGN (*phandle, newhandle); + + if ((*phandle)->info.ref_count == 0) + { + (*phandle)->info.ref_count = 1; + LT_DLMEM_REASSIGN ((*phandle)->info.name, name); + + LT_DLMUTEX_LOCK (); + (*phandle)->next = handles; + handles = *phandle; + LT_DLMUTEX_UNLOCK (); + } + + LT_DLMUTEX_SETERROR (saved_error); + + cleanup: + LT_DLFREE (dir); + LT_DLFREE (name); + LT_DLFREE (canonical); + + return errors; +} + +lt_dlhandle +lt_dlopen (filename) + const char *filename; +{ + lt_dlhandle handle = 0; + + /* Just incase we missed a code path in try_dlopen() that reports + an error, but forgets to reset handle... */ + if (try_dlopen (&handle, filename) != 0) + return 0; + + return handle; +} + +/* If the last error messge store was `FILE_NOT_FOUND', then return + non-zero. */ +int +file_not_found () +{ + const char *error = 0; + + LT_DLMUTEX_GETERROR (error); + if (error == LT_DLSTRERROR (FILE_NOT_FOUND)) + return 1; + + return 0; +} + +/* If FILENAME has an ARCHIVE_EXT or SHLIB_EXT extension, try to + open the FILENAME as passed. Otherwise try appending ARCHIVE_EXT, + and if a file is still not found try again with SHLIB_EXT appended + instead. */ +lt_dlhandle +lt_dlopenext (filename) + const char *filename; +{ + lt_dlhandle handle = 0; + char * tmp = 0; + char * ext = 0; + int len; + int errors = 0; + int file_found = 1; /* until proven otherwise */ + + if (!filename) + { + return lt_dlopen (filename); + } + + assert (filename); + + len = LT_STRLEN (filename); + ext = strrchr (filename, '.'); + + /* If FILENAME already bears a suitable extension, there is no need + to try appending additional extensions. */ + if (ext && ((strcmp (ext, archive_ext) == 0) +#ifdef LTDL_SHLIB_EXT + || (strcmp (ext, shlib_ext) == 0) +#endif + )) + { + return lt_dlopen (filename); + } + + /* First try appending ARCHIVE_EXT. */ + tmp = LT_EMALLOC (char, len + LT_STRLEN (archive_ext) + 1); + if (!tmp) + return 0; + + strcpy (tmp, filename); + strcat (tmp, archive_ext); + errors = try_dlopen (&handle, tmp); + + /* If we found FILENAME, stop searching -- whether we were able to + load the file as a module or not. If the file exists but loading + failed, it is better to return an error message here than to + report FILE_NOT_FOUND when the alternatives (foo.so etc) are not + in the module search path. */ + if (handle || ((errors > 0) && file_not_found ())) + { + LT_DLFREE (tmp); + return handle; + } + +#ifdef LTDL_SHLIB_EXT + /* Try appending SHLIB_EXT. */ + if (LT_STRLEN (shlib_ext) > LT_STRLEN (archive_ext)) + { + LT_DLFREE (tmp); + tmp = LT_EMALLOC (char, len + LT_STRLEN (shlib_ext) + 1); + if (!tmp) + return 0; + + strcpy (tmp, filename); + } + else + { + tmp[len] = LT_EOS_CHAR; + } + + strcat(tmp, shlib_ext); + errors = try_dlopen (&handle, tmp); + + /* As before, if the file was found but loading failed, return now + with the current error message. */ + if (handle || ((errors > 0) && file_not_found ())) + { + LT_DLFREE (tmp); + return handle; + } +#endif + + /* Still here? Then we really did fail to locate any of the file + names we tried. */ + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); + LT_DLFREE (tmp); + return 0; +} + + +int +lt_argz_insert (pargz, pargz_len, before, entry) + char **pargz; + size_t *pargz_len; + char *before; + const char *entry; +{ + error_t error; + + if ((error = argz_insert (pargz, pargz_len, before, entry))) + { + switch (error) + { + case ENOMEM: + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + break; + default: + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN)); + break; + } + return 1; + } + + return 0; +} + +int +lt_argz_insertinorder (pargz, pargz_len, entry) + char **pargz; + size_t *pargz_len; + const char *entry; +{ + char *before = 0; + + assert (pargz); + assert (pargz_len); + assert (entry && *entry); + + if (*pargz) + while ((before = argz_next (*pargz, *pargz_len, before))) + { + int cmp = strcmp (entry, before); + + if (cmp < 0) break; + if (cmp == 0) return 0; /* No duplicates! */ + } + + return lt_argz_insert (pargz, pargz_len, before, entry); +} + +int +lt_argz_insertdir (pargz, pargz_len, dirnam, dp) + char **pargz; + size_t *pargz_len; + const char *dirnam; + struct dirent *dp; +{ + char *buf = 0; + size_t buf_len = 0; + char *end = 0; + size_t end_offset = 0; + size_t dir_len = 0; + int errors = 0; + + assert (pargz); + assert (pargz_len); + assert (dp); + + dir_len = LT_STRLEN (dirnam); + end = dp->d_name + LT_D_NAMLEN(dp); + + /* Ignore version numbers. */ + { + char *p; + for (p = end; p -1 > dp->d_name; --p) + if (strchr (".0123456789", p[-1]) == 0) + break; + + if (*p == '.') + end = p; + } + + /* Ignore filename extension. */ + { + char *p; + for (p = end -1; p > dp->d_name; --p) + if (*p == '.') + { + end = p; + break; + } + } + + /* Prepend the directory name. */ + end_offset = end - dp->d_name; + buf_len = dir_len + 1+ end_offset; + buf = LT_EMALLOC (char, 1+ buf_len); + if (!buf) + return ++errors; + + assert (buf); + + strcpy (buf, dirnam); + strcat (buf, "/"); + strncat (buf, dp->d_name, end_offset); + buf[buf_len] = LT_EOS_CHAR; + + /* Try to insert (in order) into ARGZ/ARGZ_LEN. */ + if (lt_argz_insertinorder (pargz, pargz_len, buf) != 0) + ++errors; + + LT_DLFREE (buf); + + return errors; +} + +int +list_files_by_dir (dirnam, pargz, pargz_len) + const char *dirnam; + char **pargz; + size_t *pargz_len; +{ + DIR *dirp = 0; + int errors = 0; + + assert (dirnam && *dirnam); + assert (pargz); + assert (pargz_len); + assert (dirnam[LT_STRLEN(dirnam) -1] != '/'); + + dirp = opendir (dirnam); + if (dirp) + { + struct dirent *dp = 0; + + while ((dp = readdir (dirp))) + if (dp->d_name[0] != '.') + if (lt_argz_insertdir (pargz, pargz_len, dirnam, dp)) + { + ++errors; + break; + } + + closedir (dirp); + } + else + ++errors; + + return errors; +} + + +/* If there are any files in DIRNAME, call the function passed in + DATA1 (with the name of each file and DATA2 as arguments). */ +static int +foreachfile_callback (dirname, data1, data2) + char *dirname; + lt_ptr data1; + lt_ptr data2; +{ + int (*func) LT_PARAMS((const char *filename, lt_ptr data)) + = (int (*) LT_PARAMS((const char *filename, lt_ptr data))) data1; + + int is_done = 0; + char *argz = 0; + size_t argz_len = 0; + + if (list_files_by_dir (dirname, &argz, &argz_len) != 0) + goto cleanup; + if (!argz) + goto cleanup; + + { + char *filename = 0; + while ((filename = argz_next (argz, argz_len, filename))) + if ((is_done = (*func) (filename, data2))) + break; + } + + cleanup: + LT_DLFREE (argz); + + return is_done; +} + + +/* Call FUNC for each unique extensionless file in SEARCH_PATH, along + with DATA. The filenames passed to FUNC would be suitable for + passing to lt_dlopenext. The extensions are stripped so that + individual modules do not generate several entries (e.g. libfoo.la, + libfoo.so, libfoo.so.1, libfoo.so.1.0.0). If SEARCH_PATH is NULL, + then the same directories that lt_dlopen would search are examined. */ +int +lt_dlforeachfile (search_path, func, data) + const char *search_path; + int (*func) LT_PARAMS ((const char *filename, lt_ptr data)); + lt_ptr data; +{ + int is_done = 0; + + if (search_path) + { + /* If a specific path was passed, search only the directories + listed in it. */ + is_done = foreach_dirinpath (search_path, 0, + foreachfile_callback, func, data); + } + else + { + /* Otherwise search the default paths. */ + is_done = foreach_dirinpath (user_search_path, 0, + foreachfile_callback, func, data); + if (!is_done) + { + is_done = foreach_dirinpath (getenv("LTDL_LIBRARY_PATH"), 0, + foreachfile_callback, func, data); + } + +#ifdef LTDL_SHLIBPATH_VAR + if (!is_done) + { + is_done = foreach_dirinpath (getenv(LTDL_SHLIBPATH_VAR), 0, + foreachfile_callback, func, data); + } +#endif +#ifdef LTDL_SYSSEARCHPATH + if (!is_done) + { + is_done = foreach_dirinpath (getenv(LTDL_SYSSEARCHPATH), 0, + foreachfile_callback, func, data); + } +#endif + } + + return is_done; +} + +int +lt_dlclose (handle) + lt_dlhandle handle; +{ + lt_dlhandle cur, last; + int errors = 0; + + LT_DLMUTEX_LOCK (); + + /* check whether the handle is valid */ + last = cur = handles; + while (cur && handle != cur) + { + last = cur; + cur = cur->next; + } + + if (!cur) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + ++errors; + goto done; + } + + handle->info.ref_count--; + + /* Note that even with resident modules, we must track the ref_count + correctly incase the user decides to reset the residency flag + later (even though the API makes no provision for that at the + moment). */ + if (handle->info.ref_count <= 0 && !LT_DLIS_RESIDENT (handle)) + { + lt_user_data data = handle->loader->dlloader_data; + + if (handle != handles) + { + last->next = handle->next; + } + else + { + handles = handle->next; + } + + errors += handle->loader->module_close (data, handle->module); + errors += unload_deplibs(handle); + + LT_DLFREE (handle->info.filename); + LT_DLFREE (handle->info.name); + LT_DLFREE (handle); + + goto done; + } + + if (LT_DLIS_RESIDENT (handle)) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CLOSE_RESIDENT_MODULE)); + ++errors; + } + + done: + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +lt_ptr +lt_dlsym (handle, symbol) + lt_dlhandle handle; + const char *symbol; +{ + int lensym; + char lsym[LT_SYMBOL_LENGTH]; + char *sym; + lt_ptr address; + lt_user_data data; + + if (!handle) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + return 0; + } + + if (!symbol) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + return 0; + } + + lensym = LT_STRLEN (symbol) + LT_STRLEN (handle->loader->sym_prefix) + + LT_STRLEN (handle->info.name); + + if (lensym + LT_SYMBOL_OVERHEAD < LT_SYMBOL_LENGTH) + { + sym = lsym; + } + else + { + sym = LT_EMALLOC (char, lensym + LT_SYMBOL_OVERHEAD + 1); + if (!sym) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (BUFFER_OVERFLOW)); + return 0; + } + } + + data = handle->loader->dlloader_data; + if (handle->info.name) + { + const char *saved_error; + + LT_DLMUTEX_GETERROR (saved_error); + + /* this is a libtool module */ + if (handle->loader->sym_prefix) + { + strcpy(sym, handle->loader->sym_prefix); + strcat(sym, handle->info.name); + } + else + { + strcpy(sym, handle->info.name); + } + + strcat(sym, "_LTX_"); + strcat(sym, symbol); + + /* try "modulename_LTX_symbol" */ + address = handle->loader->find_sym (data, handle->module, sym); + if (address) + { + if (sym != lsym) + { + LT_DLFREE (sym); + } + return address; + } + LT_DLMUTEX_SETERROR (saved_error); + } + + /* otherwise try "symbol" */ + if (handle->loader->sym_prefix) + { + strcpy(sym, handle->loader->sym_prefix); + strcat(sym, symbol); + } + else + { + strcpy(sym, symbol); + } + + address = handle->loader->find_sym (data, handle->module, sym); + if (sym != lsym) + { + LT_DLFREE (sym); + } + + return address; +} + +const char * +lt_dlerror () +{ + const char *error; + + LT_DLMUTEX_GETERROR (error); + LT_DLMUTEX_SETERROR (0); + + return error ? error : LT_DLSTRERROR (UNKNOWN); +} + +int +lt_dlpath_insertdir (ppath, before, dir) + char **ppath; + char *before; + const char *dir; +{ + int errors = 0; + char *canonical = 0; + char *argz = 0; + size_t argz_len = 0; + + assert (ppath); + assert (dir && *dir); + + if (canonicalize_path (dir, &canonical) != 0) + { + ++errors; + goto cleanup; + } + + assert (canonical && *canonical); + + /* If *PPATH is empty, set it to DIR. */ + if (*ppath == 0) + { + assert (!before); /* BEFORE cannot be set without PPATH. */ + assert (dir); /* Without DIR, don't call this function! */ + + *ppath = lt_estrdup (dir); + if (*ppath == 0) + ++errors; + + return errors; + } + + assert (ppath && *ppath); + + if (argzize_path (*ppath, &argz, &argz_len) != 0) + { + ++errors; + goto cleanup; + } + + /* Convert BEFORE into an equivalent offset into ARGZ. This only works + if *PPATH is already canonicalized, and hence does not change length + with respect to ARGZ. We canonicalize each entry as it is added to + the search path, and don't call this function with (uncanonicalized) + user paths, so this is a fair assumption. */ + if (before) + { + assert (*ppath <= before); + assert (before - *ppath <= strlen (*ppath)); + + before = before - *ppath + argz; + } + + if (lt_argz_insert (&argz, &argz_len, before, dir) != 0) + { + ++errors; + goto cleanup; + } + + argz_stringify (argz, argz_len, LT_PATHSEP_CHAR); + LT_DLMEM_REASSIGN (*ppath, argz); + + cleanup: + LT_DLFREE (canonical); + LT_DLFREE (argz); + + return errors; +} + +int +lt_dladdsearchdir (search_dir) + const char *search_dir; +{ + int errors = 0; + + if (search_dir && *search_dir) + { + LT_DLMUTEX_LOCK (); + if (lt_dlpath_insertdir (&user_search_path, 0, search_dir) != 0) + ++errors; + LT_DLMUTEX_UNLOCK (); + } + + return errors; +} + +int +lt_dlinsertsearchdir (before, search_dir) + const char *before; + const char *search_dir; +{ + int errors = 0; + + if (before) + { + LT_DLMUTEX_LOCK (); + if ((before < user_search_path) + || (before >= user_search_path + LT_STRLEN (user_search_path))) + { + LT_DLMUTEX_UNLOCK (); + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_POSITION)); + return 1; + } + LT_DLMUTEX_UNLOCK (); + } + + if (search_dir && *search_dir) + { + LT_DLMUTEX_LOCK (); + if (lt_dlpath_insertdir (&user_search_path, + (char *) before, search_dir) != 0) + { + ++errors; + } + LT_DLMUTEX_UNLOCK (); + } + + return errors; +} + +int +lt_dlsetsearchpath (search_path) + const char *search_path; +{ + int errors = 0; + + LT_DLMUTEX_LOCK (); + LT_DLFREE (user_search_path); + LT_DLMUTEX_UNLOCK (); + + if (!search_path || !LT_STRLEN (search_path)) + { + return errors; + } + + LT_DLMUTEX_LOCK (); + if (canonicalize_path (search_path, &user_search_path) != 0) + ++errors; + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +const char * +lt_dlgetsearchpath () +{ + const char *saved_path; + + LT_DLMUTEX_LOCK (); + saved_path = user_search_path; + LT_DLMUTEX_UNLOCK (); + + return saved_path; +} + +int +lt_dlmakeresident (handle) + lt_dlhandle handle; +{ + int errors = 0; + + if (!handle) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + ++errors; + } + else + { + LT_DLSET_FLAG (handle, LT_DLRESIDENT_FLAG); + } + + return errors; +} + +int +lt_dlisresident (handle) + lt_dlhandle handle; +{ + if (!handle) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + return -1; + } + + return LT_DLIS_RESIDENT (handle); +} + + + + +/* --- MODULE INFORMATION --- */ + +const lt_dlinfo * +lt_dlgetinfo (handle) + lt_dlhandle handle; +{ + if (!handle) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + return 0; + } + + return &(handle->info); +} + +lt_dlhandle +lt_dlhandle_next (place) + lt_dlhandle place; +{ + return place ? place->next : handles; +} + +int +lt_dlforeach (func, data) + int (*func) LT_PARAMS((lt_dlhandle handle, lt_ptr data)); + lt_ptr data; +{ + int errors = 0; + lt_dlhandle cur; + + LT_DLMUTEX_LOCK (); + + cur = handles; + while (cur) + { + lt_dlhandle tmp = cur; + + cur = cur->next; + if ((*func) (tmp, data)) + { + ++errors; + break; + } + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +lt_dlcaller_id +lt_dlcaller_register () +{ + static lt_dlcaller_id last_caller_id = 0; + int result; + + LT_DLMUTEX_LOCK (); + result = ++last_caller_id; + LT_DLMUTEX_UNLOCK (); + + return result; +} + +lt_ptr +lt_dlcaller_set_data (key, handle, data) + lt_dlcaller_id key; + lt_dlhandle handle; + lt_ptr data; +{ + int n_elements = 0; + lt_ptr stale = (lt_ptr) 0; + int i; + + /* This needs to be locked so that the caller data can be updated + simultaneously by different threads. */ + LT_DLMUTEX_LOCK (); + + if (handle->caller_data) + while (handle->caller_data[n_elements].key) + ++n_elements; + + for (i = 0; i < n_elements; ++i) + { + if (handle->caller_data[i].key == key) + { + stale = handle->caller_data[i].data; + break; + } + } + + /* Ensure that there is enough room in this handle's caller_data + array to accept a new element (and an empty end marker). */ + if (i == n_elements) + { + lt_caller_data *temp + = LT_DLREALLOC (lt_caller_data, handle->caller_data, 2+ n_elements); + + if (!temp) + { + stale = 0; + goto done; + } + + handle->caller_data = temp; + + /* We only need this if we needed to allocate a new caller_data. */ + handle->caller_data[i].key = key; + handle->caller_data[1+ i].key = 0; + } + + handle->caller_data[i].data = data; + + done: + LT_DLMUTEX_UNLOCK (); + + return stale; +} + +lt_ptr +lt_dlcaller_get_data (key, handle) + lt_dlcaller_id key; + lt_dlhandle handle; +{ + lt_ptr result = (lt_ptr) 0; + + /* This needs to be locked so that the caller data isn't updated by + another thread part way through this function. */ + LT_DLMUTEX_LOCK (); + + /* Locate the index of the element with a matching KEY. */ + { + int i; + for (i = 0; handle->caller_data[i].key; ++i) + { + if (handle->caller_data[i].key == key) + { + result = handle->caller_data[i].data; + break; + } + } + } + + LT_DLMUTEX_UNLOCK (); + + return result; +} + + + +/* --- USER MODULE LOADER API --- */ + + +int +lt_dlloader_add (place, dlloader, loader_name) + lt_dlloader *place; + const struct lt_user_dlloader *dlloader; + const char *loader_name; +{ + int errors = 0; + lt_dlloader *node = 0, *ptr = 0; + + if ((dlloader == 0) /* diagnose null parameters */ + || (dlloader->module_open == 0) + || (dlloader->module_close == 0) + || (dlloader->find_sym == 0)) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + return 1; + } + + /* Create a new dlloader node with copies of the user callbacks. */ + node = LT_EMALLOC (lt_dlloader, 1); + if (!node) + return 1; + + node->next = 0; + node->loader_name = loader_name; + node->sym_prefix = dlloader->sym_prefix; + node->dlloader_exit = dlloader->dlloader_exit; + node->module_open = dlloader->module_open; + node->module_close = dlloader->module_close; + node->find_sym = dlloader->find_sym; + node->dlloader_data = dlloader->dlloader_data; + + LT_DLMUTEX_LOCK (); + if (!loaders) + { + /* If there are no loaders, NODE becomes the list! */ + loaders = node; + } + else if (!place) + { + /* If PLACE is not set, add NODE to the end of the + LOADERS list. */ + for (ptr = loaders; ptr->next; ptr = ptr->next) + { + /*NOWORK*/; + } + + ptr->next = node; + } + else if (loaders == place) + { + /* If PLACE is the first loader, NODE goes first. */ + node->next = place; + loaders = node; + } + else + { + /* Find the node immediately preceding PLACE. */ + for (ptr = loaders; ptr->next != place; ptr = ptr->next) + { + /*NOWORK*/; + } + + if (ptr->next != place) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + ++errors; + } + else + { + /* Insert NODE between PTR and PLACE. */ + node->next = place; + ptr->next = node; + } + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +int +lt_dlloader_remove (loader_name) + const char *loader_name; +{ + lt_dlloader *place = lt_dlloader_find (loader_name); + lt_dlhandle handle; + int errors = 0; + + if (!place) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + return 1; + } + + LT_DLMUTEX_LOCK (); + + /* Fail if there are any open modules which use this loader. */ + for (handle = handles; handle; handle = handle->next) + { + if (handle->loader == place) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (REMOVE_LOADER)); + ++errors; + goto done; + } + } + + if (place == loaders) + { + /* PLACE is the first loader in the list. */ + loaders = loaders->next; + } + else + { + /* Find the loader before the one being removed. */ + lt_dlloader *prev; + for (prev = loaders; prev->next; prev = prev->next) + { + if (!strcmp (prev->next->loader_name, loader_name)) + { + break; + } + } + + place = prev->next; + prev->next = prev->next->next; + } + + if (place->dlloader_exit) + { + errors = place->dlloader_exit (place->dlloader_data); + } + + LT_DLFREE (place); + + done: + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +lt_dlloader * +lt_dlloader_next (place) + lt_dlloader *place; +{ + lt_dlloader *next; + + LT_DLMUTEX_LOCK (); + next = place ? place->next : loaders; + LT_DLMUTEX_UNLOCK (); + + return next; +} + +const char * +lt_dlloader_name (place) + lt_dlloader *place; +{ + const char *name = 0; + + if (place) + { + LT_DLMUTEX_LOCK (); + name = place ? place->loader_name : 0; + LT_DLMUTEX_UNLOCK (); + } + else + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + } + + return name; +} + +lt_user_data * +lt_dlloader_data (place) + lt_dlloader *place; +{ + lt_user_data *data = 0; + + if (place) + { + LT_DLMUTEX_LOCK (); + data = place ? &(place->dlloader_data) : 0; + LT_DLMUTEX_UNLOCK (); + } + else + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + } + + return data; +} + +lt_dlloader * +lt_dlloader_find (loader_name) + const char *loader_name; +{ + lt_dlloader *place = 0; + + LT_DLMUTEX_LOCK (); + for (place = loaders; place; place = place->next) + { + if (strcmp (place->loader_name, loader_name) == 0) + { + break; + } + } + LT_DLMUTEX_UNLOCK (); + + return place; +} From b6b42411cf4d6266ccabd95fea5aafd774afc249 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:46:57 +0000 Subject: [PATCH 216/306] * upstream/ltdl.h: upstream source. --- libguile-ltdl/upstream/ltdl.h | 361 ++++++++++++++++++++++++++++++++++ 1 file changed, 361 insertions(+) create mode 100644 libguile-ltdl/upstream/ltdl.h diff --git a/libguile-ltdl/upstream/ltdl.h b/libguile-ltdl/upstream/ltdl.h new file mode 100644 index 000000000..2bbfa302c --- /dev/null +++ b/libguile-ltdl/upstream/ltdl.h @@ -0,0 +1,361 @@ +/* ltdl.h -- generic dlopen functions + Copyright (C) 1998-2000 Free Software Foundation, Inc. + Originally by Thomas Tanner + This file is part of GNU Libtool. + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +As a special exception to the GNU Lesser General Public License, +if you distribute this file as part of a program or library that +is built using GNU libtool, you may include it under the same +distribution terms that you use for the rest of that program. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free +Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +02111-1307 USA +*/ + +/* Only include this header file once. */ +#ifndef LTDL_H +#define LTDL_H 1 + +#include /* for size_t declaration */ + + +/* --- MACROS FOR PORTABILITY --- */ + + +/* Saves on those hard to debug '\0' typos.... */ +#define LT_EOS_CHAR '\0' + +/* LTDL_BEGIN_C_DECLS should be used at the beginning of your declarations, + so that C++ compilers don't mangle their names. Use LTDL_END_C_DECLS at + the end of C declarations. */ +#ifdef __cplusplus +# define LT_BEGIN_C_DECLS extern "C" { +# define LT_END_C_DECLS } +#else +# define LT_BEGIN_C_DECLS /* empty */ +# define LT_END_C_DECLS /* empty */ +#endif + +LT_BEGIN_C_DECLS + + +/* LT_PARAMS is a macro used to wrap function prototypes, so that compilers + that don't understand ANSI C prototypes still work, and ANSI C + compilers can issue warnings about type mismatches. */ +#if defined (__STDC__) || defined (_AIX) || (defined (__mips) && defined (_SYSTYPE_SVR4)) || defined(WIN32) || defined(__cplusplus) +# define LT_PARAMS(protos) protos +# define lt_ptr void* +#else +# define LT_PARAMS(protos) () +# define lt_ptr char* +#endif + +/* LT_STMT_START/END are used to create macros which expand to a + a single compound statement in a portable way. */ +#if defined (__GNUC__) && !defined (__STRICT_ANSI__) && !defined (__cplusplus) +# define LT_STMT_START (void)( +# define LT_STMT_END ) +#else +# if (defined (sun) || defined (__sun__)) +# define LT_STMT_START if (1) +# define LT_STMT_END else (void)0 +# else +# define LT_STMT_START do +# define LT_STMT_END while (0) +# endif +#endif + +/* LT_CONC creates a new concatenated symbol for the compiler + in a portable way. */ +#if defined(__STDC__) || defined(__cplusplus) +# define LT_CONC(s,t) s##t +#else +# define LT_CONC(s,t) s/**/t +#endif + +/* LT_STRLEN can be used safely on NULL pointers. */ +#define LT_STRLEN(s) (((s) && (s)[0]) ? strlen (s) : 0) + + + +/* --- WINDOWS SUPPORT --- */ + + +/* Canonicalise Windows and Cygwin recognition macros. */ +#ifdef __CYGWIN32__ +# ifndef __CYGWIN__ +# define __CYGWIN__ __CYGWIN32__ +# endif +#endif +#if defined(_WIN32) || defined(WIN32) +# ifndef __WINDOWS__ +# ifdef _WIN32 +# define __WINDOWS__ _WIN32 +# else +# ifdef WIN32 +# define __WINDOWS__ WIN32 +# endif +# endif +# endif +#endif + +#ifdef __WINDOWS__ +# ifndef __CYGWIN__ +/* LT_DIRSEP_CHAR is accepted *in addition* to '/' as a directory + separator when it is set. */ +# define LT_DIRSEP_CHAR '\\' +# define LT_PATHSEP_CHAR ';' +# endif +#endif +#ifndef LT_PATHSEP_CHAR +# define LT_PATHSEP_CHAR ':' +#endif + +/* DLL building support on win32 hosts; mostly to workaround their + ridiculous implementation of data symbol exporting. */ +#ifndef LT_SCOPE +# ifdef __WINDOWS__ +# ifdef DLL_EXPORT /* defined by libtool (if required) */ +# define LT_SCOPE __declspec(dllexport) +# endif +# ifdef LIBLTDL_DLL_IMPORT /* define if linking with this dll */ +# define LT_SCOPE extern __declspec(dllimport) +# endif +# endif +# ifndef LT_SCOPE /* static linking or !__WINDOWS__ */ +# define LT_SCOPE extern +# endif +#endif + + + + +/* --- DYNAMIC MODULE LOADING API --- */ + + +typedef struct lt_dlhandle_struct *lt_dlhandle; /* A loaded module. */ + +/* Initialisation and finalisation functions for libltdl. */ +extern int lt_dlinit LT_PARAMS((void)); +extern int lt_dlexit LT_PARAMS((void)); + +/* Module search path manipulation. */ +extern int lt_dladdsearchdir LT_PARAMS((const char *search_dir)); +extern int lt_dlinsertsearchdir LT_PARAMS((const char *before, + const char *search_dir)); +extern int lt_dlsetsearchpath LT_PARAMS((const char *search_path)); +extern const char *lt_dlgetsearchpath LT_PARAMS((void)); +extern int lt_dlforeachfile LT_PARAMS(( + const char *search_path, + int (*func) (const char *filename, lt_ptr data), + lt_ptr data)); + +/* Portable libltdl versions of the system dlopen() API. */ +extern lt_dlhandle lt_dlopen LT_PARAMS((const char *filename)); +extern lt_dlhandle lt_dlopenext LT_PARAMS((const char *filename)); +extern lt_ptr lt_dlsym LT_PARAMS((lt_dlhandle handle, + const char *name)); +extern const char *lt_dlerror LT_PARAMS((void)); +extern int lt_dlclose LT_PARAMS((lt_dlhandle handle)); + +/* Module residency management. */ +extern int lt_dlmakeresident LT_PARAMS((lt_dlhandle handle)); +extern int lt_dlisresident LT_PARAMS((lt_dlhandle handle)); + + + + +/* --- MUTEX LOCKING --- */ + + +typedef void lt_dlmutex_lock LT_PARAMS((void)); +typedef void lt_dlmutex_unlock LT_PARAMS((void)); +typedef void lt_dlmutex_seterror LT_PARAMS((const char *errmsg)); +typedef const char *lt_dlmutex_geterror LT_PARAMS((void)); + +extern int lt_dlmutex_register LT_PARAMS((lt_dlmutex_lock *lock, + lt_dlmutex_unlock *unlock, + lt_dlmutex_seterror *seterror, + lt_dlmutex_geterror *geterror)); + + + + +/* --- MEMORY HANDLING --- */ + + +/* By default, the realloc function pointer is set to our internal + realloc implementation which iself uses lt_dlmalloc and lt_dlfree. + libltdl relies on a featureful realloc, but if you are sure yours + has the right semantics then you can assign it directly. Generally, + it is safe to assign just a malloc() and a free() function. */ +LT_SCOPE lt_ptr (*lt_dlmalloc) LT_PARAMS((size_t size)); +LT_SCOPE lt_ptr (*lt_dlrealloc) LT_PARAMS((lt_ptr ptr, size_t size)); +LT_SCOPE void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)); + + + + +/* --- PRELOADED MODULE SUPPORT --- */ + + +/* A preopened symbol. Arrays of this type comprise the exported + symbols for a dlpreopened module. */ +typedef struct { + const char *name; + lt_ptr address; +} lt_dlsymlist; + +extern int lt_dlpreload LT_PARAMS((const lt_dlsymlist *preloaded)); +extern int lt_dlpreload_default + LT_PARAMS((const lt_dlsymlist *preloaded)); + +#define LTDL_SET_PRELOADED_SYMBOLS() LT_STMT_START{ \ + extern const lt_dlsymlist lt_preloaded_symbols[]; \ + lt_dlpreload_default(lt_preloaded_symbols); \ + }LT_STMT_END + + + + +/* --- MODULE INFORMATION --- */ + + +/* Read only information pertaining to a loaded module. */ +typedef struct { + char *filename; /* file name */ + char *name; /* module name */ + int ref_count; /* number of times lt_dlopened minus + number of times lt_dlclosed. */ +} lt_dlinfo; + +extern const lt_dlinfo *lt_dlgetinfo LT_PARAMS((lt_dlhandle handle)); +extern lt_dlhandle lt_dlhandle_next LT_PARAMS((lt_dlhandle place)); +extern int lt_dlforeach LT_PARAMS(( + int (*func) (lt_dlhandle handle, lt_ptr data), + lt_ptr data)); + +/* Associating user data with loaded modules. */ +typedef unsigned lt_dlcaller_id; + +extern lt_dlcaller_id lt_dlcaller_register LT_PARAMS((void)); +extern lt_ptr lt_dlcaller_set_data LT_PARAMS((lt_dlcaller_id key, + lt_dlhandle handle, + lt_ptr data)); +extern lt_ptr lt_dlcaller_get_data LT_PARAMS((lt_dlcaller_id key, + lt_dlhandle handle)); + + + +/* --- USER MODULE LOADER API --- */ + + +typedef struct lt_dlloader lt_dlloader; +typedef lt_ptr lt_user_data; +typedef lt_ptr lt_module; + +/* Function pointer types for creating user defined module loaders. */ +typedef lt_module lt_module_open LT_PARAMS((lt_user_data loader_data, + const char *filename)); +typedef int lt_module_close LT_PARAMS((lt_user_data loader_data, + lt_module handle)); +typedef lt_ptr lt_find_sym LT_PARAMS((lt_user_data loader_data, + lt_module handle, + const char *symbol)); +typedef int lt_dlloader_exit LT_PARAMS((lt_user_data loader_data)); + +struct lt_user_dlloader { + const char *sym_prefix; + lt_module_open *module_open; + lt_module_close *module_close; + lt_find_sym *find_sym; + lt_dlloader_exit *dlloader_exit; + lt_user_data dlloader_data; +}; + +extern lt_dlloader *lt_dlloader_next LT_PARAMS((lt_dlloader *place)); +extern lt_dlloader *lt_dlloader_find LT_PARAMS(( + const char *loader_name)); +extern const char *lt_dlloader_name LT_PARAMS((lt_dlloader *place)); +extern lt_user_data *lt_dlloader_data LT_PARAMS((lt_dlloader *place)); +extern int lt_dlloader_add LT_PARAMS((lt_dlloader *place, + const struct lt_user_dlloader *dlloader, + const char *loader_name)); +extern int lt_dlloader_remove LT_PARAMS(( + const char *loader_name)); + + + +/* --- ERROR MESSAGE HANDLING --- */ + + +/* Defining error strings alongside their symbolic names in a macro in + this way allows us to expand the macro in different contexts with + confidence that the enumeration of symbolic names will map correctly + onto the table of error strings. */ +#define lt_dlerror_table \ + LT_ERROR(UNKNOWN, "unknown error") \ + LT_ERROR(DLOPEN_NOT_SUPPORTED, "dlopen support not available") \ + LT_ERROR(INVALID_LOADER, "invalid loader") \ + LT_ERROR(INIT_LOADER, "loader initialization failed") \ + LT_ERROR(REMOVE_LOADER, "loader removal failed") \ + LT_ERROR(FILE_NOT_FOUND, "file not found") \ + LT_ERROR(DEPLIB_NOT_FOUND, "dependency library not found") \ + LT_ERROR(NO_SYMBOLS, "no symbols defined") \ + LT_ERROR(CANNOT_OPEN, "can't open the module") \ + LT_ERROR(CANNOT_CLOSE, "can't close the module") \ + LT_ERROR(SYMBOL_NOT_FOUND, "symbol not found") \ + LT_ERROR(NO_MEMORY, "not enough memory") \ + LT_ERROR(INVALID_HANDLE, "invalid module handle") \ + LT_ERROR(BUFFER_OVERFLOW, "internal buffer overflow") \ + LT_ERROR(INVALID_ERRORCODE, "invalid errorcode") \ + LT_ERROR(SHUTDOWN, "library already shutdown") \ + LT_ERROR(CLOSE_RESIDENT_MODULE, "can't close resident module") \ + LT_ERROR(INVALID_MUTEX_ARGS, "invalid mutex handler registration") \ + LT_ERROR(INVALID_POSITION, "invalid search path insert position") + +/* Enumerate the symbolic error names. */ +enum { +#define LT_ERROR(name, diagnostic) LT_CONC(LT_ERROR_, name), + lt_dlerror_table +#undef LT_ERROR + + LT_ERROR_MAX +}; + +/* These functions are only useful from inside custom module loaders. */ +extern int lt_dladderror LT_PARAMS((const char *diagnostic)); +extern int lt_dlseterror LT_PARAMS((int errorcode)); + + + + +/* --- SOURCE COMPATIBILITY WITH OLD LIBLTDL --- */ + + +#ifdef LT_NON_POSIX_NAMESPACE +# define lt_ptr_t lt_ptr +# define lt_module_t lt_module +# define lt_module_open_t lt_module_open +# define lt_module_close_t lt_module_close +# define lt_find_sym_t lt_find_sym +# define lt_dlloader_exit_t lt_dlloader_exit +# define lt_dlloader_t lt_dlloader +# define lt_dlloader_data_t lt_user_data +#endif + +LT_END_C_DECLS + +#endif /* !LTDL_H */ From f4b028e3d80147df7bbf3450858144dcfb03dcbc Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:51:06 +0000 Subject: [PATCH 217/306] * COPYING.LIB: moved from ../libltdl. --- libguile-ltdl/COPYING.LIB | 515 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 515 insertions(+) create mode 100644 libguile-ltdl/COPYING.LIB diff --git a/libguile-ltdl/COPYING.LIB b/libguile-ltdl/COPYING.LIB new file mode 100644 index 000000000..c4792dd27 --- /dev/null +++ b/libguile-ltdl/COPYING.LIB @@ -0,0 +1,515 @@ + + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations +below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. +^L + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it +becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. +^L + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control +compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. +^L + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. +^L + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. +^L + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. +^L + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply, and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License +may add an explicit geographical distribution limitation excluding those +countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. +^L + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS +^L + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms +of the ordinary General Public License). + + To apply these terms, attach the following notices to the library. +It is safest to attach them to the start of each source file to most +effectively convey the exclusion of warranty; and each file should +have at least the "copyright" line and a pointer to where the full +notice is found. + + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +Also add information on how to contact you by electronic and paper +mail. + +You should also get your employer (if you work as a programmer) or +your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James +Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + From 250aecfecfddfd3dc6dd7b6c6e654f0aaeb71348 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:51:12 +0000 Subject: [PATCH 218/306] * ChangeLog: moved from ../libltdl. --- libguile-ltdl/ChangeLog | 54 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 libguile-ltdl/ChangeLog diff --git a/libguile-ltdl/ChangeLog b/libguile-ltdl/ChangeLog new file mode 100644 index 000000000..137ecd2b4 --- /dev/null +++ b/libguile-ltdl/ChangeLog @@ -0,0 +1,54 @@ +2002-10-04 Rob Browning + + * raw-ltdl.h: guile's modified version of the upstream ltdl.h. + + * raw-ltdl.c: guile's modified version of the upstream ltdl.c. + + * guile-ltdl.h: main header file for guile's internal + libguile-ltdl. + + * guile-ltdl.c: main source file for libguile-ltdl -- #includes + raw-ltdl.c and raw-ldtl.h directly. See README. + + * COPYING.LIB: moved from ../libltdl. + + * ChangeLog: moved from ../libltdl. + + * README: moved from ../libltdl. + + * Makefile.am: build new libguile-ltdl. + + * upstream/Makefile.am: new file. + + * upstream/ltdl.c: upstream source. + + * upstream/ltdl.h: upstream source. + + * raw-ltdl.c: Remove custom realloc. (#define rpl_realloc + realloc). You can't define realloc like this unless you also + define malloc. This is a quick hack for now; we may want + something cleaner later. + (memcpy): coerce ptrs to (char *) before copying characters + through them -- I can't recall for sure, but I believe this was + causing an overrun error at times. + (realloc): commented out -- as mentioned above, you can't define + your own malloc unless you know enough about the malloc in use to + be able to tell how big the src ptr is. The disabled code + incorrectly used the *destination* ptr to decide how much to copy. + This sometimes results in out-of-bound accesses which cause + segfaults. + (tryall_dlopen_module): check to be sure (dirname_len > 0) before + testing first character against '/'. + (try_dlopen): check for feof(file) in read loop -- otherwise + infloop? + (scm_lt_dlopenext): remove unused variable file_found. + (LT_EOS_CHAR): moved here from guile-ltdl.h. + +2002-10-04 Marius Vollmer + + * raw-ltdl.c: Renamed all exported functions and variables to have a + "scm_lt_" prefix. + (try_dlopen): Set newhandle to null when try_all_dlopen failed. + (scm_lt_dlopenext): Reverse test of "file_not_found()". + Previously, we would stop searching when the file wasn't found + yet, while we should continue in that case. From 46229a272f1608a8da49927841126196988487fd Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:51:19 +0000 Subject: [PATCH 219/306] * Makefile.am: build new libguile-ltdl. * upstream/Makefile.am: new file. --- libguile-ltdl/Makefile.am | 44 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 libguile-ltdl/Makefile.am diff --git a/libguile-ltdl/Makefile.am b/libguile-ltdl/Makefile.am new file mode 100644 index 000000000..6bb4aa20d --- /dev/null +++ b/libguile-ltdl/Makefile.am @@ -0,0 +1,44 @@ +## Process this file with Automake to create Makefile.in +## +## Copyright (C) 2002 Free Software Foundation, Inc. +## +## This file is part of GUILE. +## +## GUILE is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as +## published by the Free Software Foundation; either version 2, or +## (at your option) any later version. +## +## GUILE is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public +## License along with GUILE; see the file COPYING. If not, write +## to the Free Software Foundation, Inc., 59 Temple Place, Suite +## 330, Boston, MA 02111-1307 USA + +SUBDIRS = upstream + +AUTOMAKE_OPTIONS = gnu + +## Prevent automake from adding extra -I options +DEFS = @DEFS@ +## Check for headers in $(srcdir)/.., so that #include +## will find MUMBLE.h in this dir when we're +## building. +INCLUDES = -I.. -I$(srcdir)/.. + +ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \ + --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/' + +# We don't install this header since no one should be using the lib directly. +EXTRA_HEADERS = guile-ltdl.h raw-ltdl.h +EXTRA_DIST = raw-ltdl.c + +lib_LTLIBRARIES = libguile-ltdl.la +libguile_ltdl_la_SOURCES = guile-ltdl.c +#libguile_ltdl_la_DEPENDENCIES = +libguile_ltdl_la_LIBADD = ${LIBADD_DL} +libguile_ltdl_la_LDFLAGS = -version-info 1:0:0 -export-dynamic -no-undefined From f64d164b1ba6f3ede866662da26b30a08809ad98 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:51:24 +0000 Subject: [PATCH 220/306] * guile-ltdl.c: main source file for libguile-ltdl -- #includes raw-ltdl.c and raw-ldtl.h directly. See README. * README: moved from ../libltdl. --- libguile-ltdl/README | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 libguile-ltdl/README diff --git a/libguile-ltdl/README b/libguile-ltdl/README new file mode 100644 index 000000000..e69de29bb From c29fbdf231fbf0175d905357c501197de844fee5 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:51:30 +0000 Subject: [PATCH 221/306] * guile-ltdl.c: main source file for libguile-ltdl -- #includes raw-ltdl.c and raw-ldtl.h directly. See README. --- libguile-ltdl/guile-ltdl.c | 80 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100644 libguile-ltdl/guile-ltdl.c diff --git a/libguile-ltdl/guile-ltdl.c b/libguile-ltdl/guile-ltdl.c new file mode 100644 index 000000000..709aea452 --- /dev/null +++ b/libguile-ltdl/guile-ltdl.c @@ -0,0 +1,80 @@ +/* ltdl.c -- system independent dlopen wrapper + Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. + Originally by Thomas Tanner + This file is part of GNU Libtool. + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +As a special exception to the GNU Lesser General Public License, +if you distribute this file as part of a program or library that +is built using GNU libtool, you may include it under the same +distribution terms that you use for the rest of that program. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +02111-1307 USA + +*/ + +#include "guile-ltdl.h" + +#define lt_dlhandle_struct scm_i_lt_dlhandle_struct + +#define LT_SCOPE static +#define SCMLTXT static +#define SCMLTSTATIC static + +#ifdef __GNUC__ +#define SCM_UNUSED __attribute__ ((unused)) +#else +#define SCM_UNUSED +#endif + +#include "raw-ltdl.h" +#include "raw-ltdl.c" + +void +scm_lt_dlset_preloaded_symbols (void) +{ + extern const lt_dlsymlist lt_preloaded_symbols[]; + lt_dlpreload_default(lt_preloaded_symbols); +} + +int +scm_lt_dlinit (void) +{ + return lt_dlinit (); +} + +scm_lt_dlhandle +scm_lt_dlopenext (const char *filename) +{ + return lt_dlopenext (filename); +} + +scm_lt_ptr +scm_lt_dlsym (scm_lt_dlhandle handle, const char *name) +{ + return lt_dlsym (handle, name); +} + +const char * +scm_lt_dlerror (void) +{ + return lt_dlerror (); +} + +int +scm_lt_dlclose (scm_lt_dlhandle handle) +{ + return lt_dlclose (handle); +} From ac7cc4628dde65aad9a119d261411a91ea5443be Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:51:36 +0000 Subject: [PATCH 222/306] * guile-ltdl.h: main header file for guile's internal libguile-ltdl. * raw-ltdl.c: Remove custom realloc. (#define rpl_realloc realloc). You can't define realloc like this unless you also define malloc. This is a quick hack for now; we may want something cleaner later. (memcpy): coerce ptrs to (char *) before copying characters through them -- I can't recall for sure, but I believe this was causing an overrun error at times. (realloc): commented out -- as mentioned above, you can't define your own malloc unless you know enough about the malloc in use to be able to tell how big the src ptr is. The disabled code incorrectly used the *destination* ptr to decide how much to copy. This sometimes results in out-of-bound accesses which cause segfaults. (tryall_dlopen_module): check to be sure (dirname_len > 0) before testing first character against '/'. (try_dlopen): check for feof(file) in read loop -- otherwise infloop? (scm_lt_dlopenext): remove unused variable file_found. (LT_EOS_CHAR): moved here from guile-ltdl.h. --- libguile-ltdl/guile-ltdl.h | 39 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 libguile-ltdl/guile-ltdl.h diff --git a/libguile-ltdl/guile-ltdl.h b/libguile-ltdl/guile-ltdl.h new file mode 100644 index 000000000..65b820f5a --- /dev/null +++ b/libguile-ltdl/guile-ltdl.h @@ -0,0 +1,39 @@ +/* guile-ltdl.h -- dlopen function actually used by guile + Copyright (C) 1998-2000, 2002 Free Software Foundation, Inc. + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +As a special exception to the GNU Lesser General Public License, +if you distribute this file as part of a program or library that +is built using GNU libtool, you may include it under the same +distribution terms that you use for the rest of that program. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free +Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +02111-1307 USA +*/ + +/* Only include this header file once. */ +#ifndef SCM_LTDL_H +#define SCM_LTDL_H 1 + +typedef struct scm_i_lt_dlhandle_struct *scm_lt_dlhandle; +typedef void * scm_lt_ptr; + +void scm_lt_dlset_preloaded_symbols (void); +int scm_lt_dlinit (void); +scm_lt_dlhandle scm_lt_dlopenext (const char *filename); +scm_lt_ptr scm_lt_dlsym (scm_lt_dlhandle handle, const char *name); +const char *scm_lt_dlerror (void); +int scm_lt_dlclose (scm_lt_dlhandle handle); + +#endif /* !SCM_LTDL_H */ From 344d7170d7fce0f77188e8b0addedb80794a01f4 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:51:55 +0000 Subject: [PATCH 223/306] * raw-ltdl.c: guile's modified version of the upstream ltdl.c. * raw-ltdl.c: Remove custom realloc. (#define rpl_realloc realloc). You can't define realloc like this unless you also define malloc. This is a quick hack for now; we may want something cleaner later. (memcpy): coerce ptrs to (char *) before copying characters through them -- I can't recall for sure, but I believe this was causing an overrun error at times. (realloc): commented out -- as mentioned above, you can't define your own malloc unless you know enough about the malloc in use to be able to tell how big the src ptr is. The disabled code incorrectly used the *destination* ptr to decide how much to copy. This sometimes results in out-of-bound accesses which cause segfaults. (tryall_dlopen_module): check to be sure (dirname_len > 0) before testing first character against '/'. (try_dlopen): check for feof(file) in read loop -- otherwise infloop? (scm_lt_dlopenext): remove unused variable file_found. (LT_EOS_CHAR): moved here from guile-ltdl.h. --- libguile-ltdl/raw-ltdl.c | 3978 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 3978 insertions(+) create mode 100644 libguile-ltdl/raw-ltdl.c diff --git a/libguile-ltdl/raw-ltdl.c b/libguile-ltdl/raw-ltdl.c new file mode 100644 index 000000000..6341758a1 --- /dev/null +++ b/libguile-ltdl/raw-ltdl.c @@ -0,0 +1,3978 @@ +/* ltdl.c -- system independent dlopen wrapper + Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. + Originally by Thomas Tanner + This file is part of GNU Libtool. + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +As a special exception to the GNU Lesser General Public License, +if you distribute this file as part of a program or library that +is built using GNU libtool, you may include it under the same +distribution terms that you use for the rest of that program. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +02111-1307 USA + +*/ + +#if HAVE_CONFIG_H +# include +#endif + +#if HAVE_UNISTD_H +# include +#endif + +#if HAVE_STDIO_H +# include +#endif + +#if HAVE_STDLIB_H +# include +#endif + +#if HAVE_STRING_H +# include +#else +# if HAVE_STRINGS_H +# include +# endif +#endif + +#if HAVE_CTYPE_H +# include +#endif + +#if HAVE_MALLOC_H +# include +#endif + +#if HAVE_MEMORY_H +# include +#endif + +#if HAVE_ERRNO_H +# include +#endif + +#if HAVE_DIRENT_H +# include +# define LT_D_NAMLEN(dirent) (strlen((dirent)->d_name)) +#else +# define dirent direct +# define LT_D_NAMLEN(dirent) ((dirent)->d_namlen) +# if HAVE_SYS_NDIR_H +# include +# endif +# if HAVE_SYS_DIR_H +# include +# endif +# if HAVE_NDIR_H +# include +# endif +#endif + +#if HAVE_ARGZ_H +# include +#endif + +#if HAVE_ASSERT_H +# include +#else +# define assert(arg) ((void) 0) +#endif + +#include "raw-ltdl.h" + +/* Saves on those hard to debug '\0' typos.... */ +#define LT_EOS_CHAR '\0' + + +/* --- WINDOWS SUPPORT --- */ + + +#ifdef DLL_EXPORT +# define LT_GLOBAL_DATA __declspec(dllexport) +#else +# define LT_GLOBAL_DATA +#endif + +/* fopen() mode flags for reading a text file */ +#undef LT_READTEXT_MODE +#ifdef __WINDOWS__ +# define LT_READTEXT_MODE "rt" +#else +# define LT_READTEXT_MODE "r" +#endif + + + + +/* --- MANIFEST CONSTANTS --- */ + + +/* Standard libltdl search path environment variable name */ +#undef LTDL_SEARCHPATH_VAR +#define LTDL_SEARCHPATH_VAR "LTDL_LIBRARY_PATH" + +/* Standard libtool archive file extension. */ +#undef LTDL_ARCHIVE_EXT +#define LTDL_ARCHIVE_EXT ".la" + +/* max. filename length */ +#ifndef LT_FILENAME_MAX +# define LT_FILENAME_MAX 1024 +#endif + +/* This is the maximum symbol size that won't require malloc/free */ +#undef LT_SYMBOL_LENGTH +#define LT_SYMBOL_LENGTH 128 + +/* This accounts for the _LTX_ separator */ +#undef LT_SYMBOL_OVERHEAD +#define LT_SYMBOL_OVERHEAD 5 + + + + +/* --- MEMORY HANDLING --- */ + + +/* These are the functions used internally. In addition to making + use of the associated function pointers above, they also perform + error handling. */ +static char *lt_estrdup LT_PARAMS((const char *str)); +static lt_ptr lt_emalloc LT_PARAMS((size_t size)); +static lt_ptr lt_erealloc LT_PARAMS((lt_ptr addr, size_t size)); + +#define rpl_realloc realloc + +/* These are the pointers that can be changed by the caller: */ +SCMLTSTATIC LT_GLOBAL_DATA lt_ptr (*lt_dlmalloc) LT_PARAMS((size_t size)) + = (lt_ptr (*) LT_PARAMS((size_t))) malloc; +SCMLTSTATIC LT_GLOBAL_DATA lt_ptr (*lt_dlrealloc) LT_PARAMS((lt_ptr ptr, size_t size)) + = (lt_ptr (*) LT_PARAMS((lt_ptr, size_t))) rpl_realloc; +SCMLTSTATIC LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) + = (void (*) LT_PARAMS((lt_ptr))) free; + +/* The following macros reduce the amount of typing needed to cast + assigned memory. */ +#define LT_DLMALLOC(tp, n) ((tp *) lt_dlmalloc ((n) * sizeof(tp))) +#define LT_DLREALLOC(tp, p, n) ((tp *) rpl_realloc ((p), (n) * sizeof(tp))) +#define LT_DLFREE(p) \ + LT_STMT_START { if (p) (p) = (lt_dlfree (p), (lt_ptr) 0); } LT_STMT_END + +#define LT_EMALLOC(tp, n) ((tp *) lt_emalloc ((n) * sizeof(tp))) +#define LT_EREALLOC(tp, p, n) ((tp *) lt_erealloc ((p), (n) * sizeof(tp))) + +#define LT_DLMEM_REASSIGN(p, q) LT_STMT_START { \ + if ((p) != (q)) { lt_dlfree (p); (p) = (q); (q) = 0; } \ + } LT_STMT_END + + +/* --- REPLACEMENT FUNCTIONS --- */ + + +#undef strdup +#define strdup rpl_strdup + +static char *strdup LT_PARAMS((const char *str)); + +char * +strdup(str) + const char *str; +{ + char *tmp = 0; + + if (str) + { + tmp = LT_DLMALLOC (char, 1+ strlen (str)); + if (tmp) + { + strcpy(tmp, str); + } + } + + return tmp; +} + + +#if ! HAVE_STRCMP + +#undef strcmp +#define strcmp rpl_strcmp + +static int strcmp LT_PARAMS((const char *str1, const char *str2)); + +int +strcmp (str1, str2) + const char *str1; + const char *str2; +{ + if (str1 == str2) + return 0; + if (str1 == 0) + return -1; + if (str2 == 0) + return 1; + + for (;*str1 && *str2; ++str1, ++str2) + { + if (*str1 != *str2) + break; + } + + return (int)(*str1 - *str2); +} +#endif + + +#if ! HAVE_STRCHR + +# if HAVE_INDEX +# define strchr index +# else +# define strchr rpl_strchr + +static const char *strchr LT_PARAMS((const char *str, int ch)); + +const char* +strchr(str, ch) + const char *str; + int ch; +{ + const char *p; + + for (p = str; *p != (char)ch && *p != LT_EOS_CHAR; ++p) + /*NOWORK*/; + + return (*p == (char)ch) ? p : 0; +} + +# endif +#endif /* !HAVE_STRCHR */ + + +#if ! HAVE_STRRCHR + +# if HAVE_RINDEX +# define strrchr rindex +# else +# define strrchr rpl_strrchr + +static const char *strrchr LT_PARAMS((const char *str, int ch)); + +const char* +strrchr(str, ch) + const char *str; + int ch; +{ + const char *p, *q = 0; + + for (p = str; *p != LT_EOS_CHAR; ++p) + { + if (*p == (char) ch) + { + q = p; + } + } + + return q; +} + +# endif +#endif + +/* NOTE: Neither bcopy nor the memcpy implementation below can + reliably handle copying in overlapping areas of memory. Use + memmove (for which there is a fallback implmentation below) + if you need that behaviour. */ +#if ! HAVE_MEMCPY + +# if HAVE_BCOPY +# define memcpy(dest, src, size) bcopy (src, dest, size) +# else +# define memcpy rpl_memcpy + +static lt_ptr memcpy LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); + +lt_ptr +memcpy (dest, src, size) + lt_ptr dest; + const lt_ptr src; + size_t size; +{ + size_t i = 0; + + for (i = 0; i < size; ++i) + { + ((char *) dest)[i] = ((char *) src)[i]; + } + + return dest; +} + +# endif /* !HAVE_BCOPY */ +#endif /* !HAVE_MEMCPY */ + +#if ! HAVE_MEMMOVE +# define memmove rpl_memmove + +static lt_ptr memmove LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); + +lt_ptr +memmove (dest, src, size) + lt_ptr dest; + const lt_ptr src; + size_t size; +{ + size_t i; + + if (dest < src) + for (i = 0; i < size; ++i) + { + dest[i] = src[i]; + } + else if (dest > src) + for (i = size -1; i >= 0; --i) + { + dest[i] = src[i]; + } + + return dest; +} + +#endif /* !HAVE_MEMMOVE */ + + +/* According to Alexandre Oliva , + ``realloc is not entirely portable'' + In any case we want to use the allocator supplied by the user without + burdening them with an lt_dlrealloc function pointer to maintain. + Instead implement our own version (with known boundary conditions) + using lt_dlmalloc and lt_dlfree. */ + + +#if 0 + + /* You can't (re)define realloc unless you also (re)define malloc. + Right now, this code uses the size of the *destination* to decide + how much to copy. That's not right, but you can't know the size + of the source unless you know enough about, or wrote malloc. So + this code is disabled... */ + +lt_ptr +realloc (ptr, size) + lt_ptr ptr; + size_t size; +{ + if (size <= 0) + { + /* For zero or less bytes, free the original memory */ + if (ptr != 0) + { + lt_dlfree (ptr); + } + + return (lt_ptr) 0; + } + else if (ptr == 0) + { + /* Allow reallocation of a NULL pointer. */ + return lt_dlmalloc (size); + } + else + { + /* Allocate a new block, copy and free the old block. */ + lt_ptr mem = lt_dlmalloc (size); + + if (mem) + { + memcpy (mem, ptr, size); + lt_dlfree (ptr); + } + + /* Note that the contents of PTR are not damaged if there is + insufficient memory to realloc. */ + return mem; + } +} + +#endif + + +#if ! HAVE_ARGZ_APPEND +# define argz_append rpl_argz_append + +static error_t argz_append LT_PARAMS((char **pargz, size_t *pargz_len, + const char *buf, size_t buf_len)); + +error_t +argz_append (pargz, pargz_len, buf, buf_len) + char **pargz; + size_t *pargz_len; + const char *buf; + size_t buf_len; +{ + size_t argz_len; + char *argz; + + assert (pargz); + assert (pargz_len); + assert ((*pargz && *pargz_len) || (!*pargz && !*pargz_len)); + + /* If nothing needs to be appended, no more work is required. */ + if (buf_len == 0) + return 0; + + /* Ensure there is enough room to append BUF_LEN. */ + argz_len = *pargz_len + buf_len; + argz = LT_DLREALLOC (char, *pargz, argz_len); + if (!argz) + return ENOMEM; + + /* Copy characters from BUF after terminating '\0' in ARGZ. */ + memcpy (argz + *pargz_len, buf, buf_len); + + /* Assign new values. */ + *pargz = argz; + *pargz_len = argz_len; + + return 0; +} +#endif /* !HAVE_ARGZ_APPEND */ + + +#if ! HAVE_ARGZ_CREATE_SEP +# define argz_create_sep rpl_argz_create_sep + +static error_t argz_create_sep LT_PARAMS((const char *str, int delim, + char **pargz, size_t *pargz_len)); + +error_t +argz_create_sep (str, delim, pargz, pargz_len) + const char *str; + int delim; + char **pargz; + size_t *pargz_len; +{ + size_t argz_len; + char *argz = 0; + + assert (str); + assert (pargz); + assert (pargz_len); + + /* Make a copy of STR, but replacing each occurence of + DELIM with '\0'. */ + argz_len = 1+ LT_STRLEN (str); + if (argz_len) + { + const char *p; + char *q; + + argz = LT_DLMALLOC (char, argz_len); + if (!argz) + return ENOMEM; + + for (p = str, q = argz; *p != LT_EOS_CHAR; ++p) + { + if (*p == delim) + { + /* Ignore leading delimiters, and fold consecutive + delimiters in STR into a single '\0' in ARGZ. */ + if ((q > argz) && (q[-1] != LT_EOS_CHAR)) + *q++ = LT_EOS_CHAR; + else + --argz_len; + } + else + *q++ = *p; + } + /* Copy terminating LT_EOS_CHAR. */ + *q = *p; + } + + /* If ARGZ_LEN has shrunk to nothing, release ARGZ's memory. */ + if (!argz_len) + LT_DLFREE (argz); + + /* Assign new values. */ + *pargz = argz; + *pargz_len = argz_len; + + return 0; +} +#endif /* !HAVE_ARGZ_CREATE_SEP */ + + +#if ! HAVE_ARGZ_INSERT +# define argz_insert rpl_argz_insert + +static error_t argz_insert LT_PARAMS((char **pargz, size_t *pargz_len, + char *before, const char *entry)); + +error_t +argz_insert (pargz, pargz_len, before, entry) + char **pargz; + size_t *pargz_len; + char *before; + const char *entry; +{ + assert (pargz); + assert (pargz_len); + assert (entry && *entry); + + /* Either PARGZ/PARGZ_LEN is empty and BEFORE is NULL, + or BEFORE points into an address within the ARGZ vector. */ + assert ((!*pargz && !*pargz_len && !before) + || ((*pargz <= before) && (before < (*pargz + *pargz_len)))); + + /* No BEFORE address indicates ENTRY should be inserted after the + current last element. */ + if (!before) + return argz_append (pargz, pargz_len, entry, 1+ LT_STRLEN (entry)); + + /* This probably indicates a programmer error, but to preserve + semantics, scan back to the start of an entry if BEFORE points + into the middle of it. */ + while ((before >= *pargz) && (before[-1] != LT_EOS_CHAR)) + --before; + + { + size_t entry_len = 1+ LT_STRLEN (entry); + size_t argz_len = *pargz_len + entry_len; + size_t offset = before - *pargz; + char *argz = LT_DLREALLOC (char, *pargz, argz_len); + + if (!argz) + return ENOMEM; + + /* Make BEFORE point to the equivalent offset in ARGZ that it + used to have in *PARGZ incase realloc() moved the block. */ + before = argz + offset; + + /* Move the ARGZ entries starting at BEFORE up into the new + space at the end -- making room to copy ENTRY into the + resulting gap. */ + memmove (before + entry_len, before, *pargz_len - offset); + memcpy (before, entry, entry_len); + + /* Assign new values. */ + *pargz = argz; + *pargz_len = argz_len; + } + + return 0; +} +#endif /* !HAVE_ARGZ_INSERT */ + + +#if ! HAVE_ARGZ_NEXT +# define argz_next rpl_argz_next + +static char *argz_next LT_PARAMS((char *argz, size_t argz_len, + const char *entry)); + +char * +argz_next (argz, argz_len, entry) + char *argz; + size_t argz_len; + const char *entry; +{ + assert ((argz && argz_len) || (!argz && !argz_len)); + + if (entry) + { + /* Either ARGZ/ARGZ_LEN is empty, or ENTRY points into an address + within the ARGZ vector. */ + assert ((!argz && !argz_len) + || ((argz <= entry) && (entry < (argz + argz_len)))); + + /* Move to the char immediately after the terminating + '\0' of ENTRY. */ + entry = 1+ strchr (entry, LT_EOS_CHAR); + + /* Return either the new ENTRY, or else NULL if ARGZ is + exhausted. */ + return (entry >= argz + argz_len) ? 0 : (char *) entry; + } + else + { + /* This should probably be flagged as a programmer error, + since starting an argz_next loop with the iterator set + to ARGZ is safer. To preserve semantics, handle the NULL + case by returning the start of ARGZ (if any). */ + if (argz_len > 0) + return argz; + else + return 0; + } +} +#endif /* !HAVE_ARGZ_NEXT */ + + + +#if ! HAVE_ARGZ_STRINGIFY +# define argz_stringify rpl_argz_stringify + +static void argz_stringify LT_PARAMS((char *argz, size_t argz_len, + int sep)); + +void +argz_stringify (argz, argz_len, sep) + char *argz; + size_t argz_len; + int sep; +{ + assert ((argz && argz_len) || (!argz && !argz_len)); + + if (sep) + { + --argz_len; /* don't stringify the terminating EOS */ + while (--argz_len > 0) + { + if (argz[argz_len] == LT_EOS_CHAR) + argz[argz_len] = sep; + } + } +} +#endif /* !HAVE_ARGZ_STRINGIFY */ + + + + +/* --- TYPE DEFINITIONS -- */ + + +/* This type is used for the array of caller data sets in each handler. */ +typedef struct { + lt_dlcaller_id key; + lt_ptr data; +} lt_caller_data; + + + + +/* --- OPAQUE STRUCTURES DECLARED IN LTDL.H --- */ + + +/* Extract the diagnostic strings from the error table macro in the same + order as the enumerated indices in ltdl.h. */ + +static const char *lt_dlerror_strings[] = + { +#define LT_ERROR(name, diagnostic) (diagnostic), + lt_dlerror_table +#undef LT_ERROR + + 0 + }; + +/* This structure is used for the list of registered loaders. */ +struct lt_dlloader { + struct lt_dlloader *next; + const char *loader_name; /* identifying name for each loader */ + const char *sym_prefix; /* prefix for symbols */ + lt_module_open *module_open; + lt_module_close *module_close; + lt_find_sym *find_sym; + lt_dlloader_exit *dlloader_exit; + lt_user_data dlloader_data; +}; + +struct lt_dlhandle_struct { + struct lt_dlhandle_struct *next; + lt_dlloader *loader; /* dlopening interface */ + lt_dlinfo info; + int depcount; /* number of dependencies */ + lt_dlhandle *deplibs; /* dependencies */ + lt_module module; /* system module handle */ + lt_ptr system; /* system specific data */ + lt_caller_data *caller_data; /* per caller associated data */ + int flags; /* various boolean stats */ +}; + +/* Various boolean flags can be stored in the flags field of an + lt_dlhandle_struct... */ +#define LT_DLGET_FLAG(handle, flag) (((handle)->flags & (flag)) == (flag)) +#define LT_DLSET_FLAG(handle, flag) ((handle)->flags |= (flag)) + +#define LT_DLRESIDENT_FLAG (0x01 << 0) +/* ...add more flags here... */ + +#define LT_DLIS_RESIDENT(handle) LT_DLGET_FLAG(handle, LT_DLRESIDENT_FLAG) + + +#define LT_DLSTRERROR(name) lt_dlerror_strings[LT_CONC(LT_ERROR_,name)] + +static const char objdir[] = LTDL_OBJDIR; +static const char archive_ext[] = LTDL_ARCHIVE_EXT; +#ifdef LTDL_SHLIB_EXT +static const char shlib_ext[] = LTDL_SHLIB_EXT; +#endif +#ifdef LTDL_SYSSEARCHPATH +static const char sys_search_path[] = LTDL_SYSSEARCHPATH; +#endif + + + + +/* --- MUTEX LOCKING --- */ + + +/* Macros to make it easier to run the lock functions only if they have + been registered. The reason for the complicated lock macro is to + ensure that the stored error message from the last error is not + accidentally erased if the current function doesn't generate an + error of its own. */ +#define LT_DLMUTEX_LOCK() LT_STMT_START { \ + if (lt_dlmutex_lock_func) (*lt_dlmutex_lock_func)(); \ + } LT_STMT_END +#define LT_DLMUTEX_UNLOCK() LT_STMT_START { \ + if (lt_dlmutex_unlock_func) (*lt_dlmutex_unlock_func)();\ + } LT_STMT_END +#define LT_DLMUTEX_SETERROR(errormsg) LT_STMT_START { \ + if (lt_dlmutex_seterror_func) \ + (*lt_dlmutex_seterror_func) (errormsg); \ + else lt_dllast_error = (errormsg); } LT_STMT_END +#define LT_DLMUTEX_GETERROR(errormsg) LT_STMT_START { \ + if (lt_dlmutex_seterror_func) \ + (errormsg) = (*lt_dlmutex_geterror_func) (); \ + else (errormsg) = lt_dllast_error; } LT_STMT_END + +/* The mutex functions stored here are global, and are necessarily the + same for all threads that wish to share access to libltdl. */ +static lt_dlmutex_lock *lt_dlmutex_lock_func = 0; +static lt_dlmutex_unlock *lt_dlmutex_unlock_func = 0; +static lt_dlmutex_seterror *lt_dlmutex_seterror_func = 0; +static lt_dlmutex_geterror *lt_dlmutex_geterror_func = 0; +static const char *lt_dllast_error = 0; + + +/* Either set or reset the mutex functions. Either all the arguments must + be valid functions, or else all can be NULL to turn off locking entirely. + The registered functions should be manipulating a static global lock + from the lock() and unlock() callbacks, which needs to be reentrant. */ +int +lt_dlmutex_register (lock, unlock, seterror, geterror) + lt_dlmutex_lock *lock; + lt_dlmutex_unlock *unlock; + lt_dlmutex_seterror *seterror; + lt_dlmutex_geterror *geterror; +{ + lt_dlmutex_unlock *old_unlock = unlock; + int errors = 0; + + /* Lock using the old lock() callback, if any. */ + LT_DLMUTEX_LOCK (); + + if ((lock && unlock && seterror && geterror) + || !(lock || unlock || seterror || geterror)) + { + lt_dlmutex_lock_func = lock; + lt_dlmutex_unlock_func = unlock; + lt_dlmutex_geterror_func = geterror; + } + else + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_MUTEX_ARGS)); + ++errors; + } + + /* Use the old unlock() callback we saved earlier, if any. Otherwise + record any errors using internal storage. */ + if (old_unlock) + (*old_unlock) (); + + /* Return the number of errors encountered during the execution of + this function. */ + return errors; +} + + + + +/* --- ERROR HANDLING --- */ + +static const char **user_error_strings = 0; +static int errorcount = LT_ERROR_MAX; + +int +lt_dladderror (diagnostic) + const char *diagnostic; +{ + int errindex = 0; + int result = -1; + const char **temp = (const char **) 0; + + assert (diagnostic); + + LT_DLMUTEX_LOCK (); + + errindex = errorcount - LT_ERROR_MAX; + temp = LT_EREALLOC (const char *, user_error_strings, 1 + errindex); + if (temp) + { + user_error_strings = temp; + user_error_strings[errindex] = diagnostic; + result = errorcount++; + } + + LT_DLMUTEX_UNLOCK (); + + return result; +} + +int +lt_dlseterror (errindex) + int errindex; +{ + int errors = 0; + + LT_DLMUTEX_LOCK (); + + if (errindex >= errorcount || errindex < 0) + { + /* Ack! Error setting the error message! */ + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_ERRORCODE)); + ++errors; + } + else if (errindex < LT_ERROR_MAX) + { + /* No error setting the error message! */ + LT_DLMUTEX_SETERROR (lt_dlerror_strings[errindex]); + } + else + { + /* No error setting the error message! */ + LT_DLMUTEX_SETERROR (user_error_strings[errindex - LT_ERROR_MAX]); + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +lt_ptr +lt_emalloc (size) + size_t size; +{ + lt_ptr mem = lt_dlmalloc (size); + if (size && !mem) + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + return mem; +} + +lt_ptr +lt_erealloc (addr, size) + lt_ptr addr; + size_t size; +{ + lt_ptr mem = realloc (addr, size); + if (size && !mem) + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + return mem; +} + +char * +lt_estrdup (str) + const char *str; +{ + char *dup = strdup (str); + if (LT_STRLEN (str) && !dup) + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + return dup; +} + + + + +/* --- DLOPEN() INTERFACE LOADER --- */ + + +/* The Cygwin dlopen implementation prints a spurious error message to + stderr if its call to LoadLibrary() fails for any reason. We can + mitigate this by not using the Cygwin implementation, and falling + back to our own LoadLibrary() wrapper. */ +#if HAVE_LIBDL && !defined(__CYGWIN__) + +/* dynamic linking with dlopen/dlsym */ + +#if HAVE_DLFCN_H +# include +#endif + +#if HAVE_SYS_DL_H +# include +#endif + +#ifdef RTLD_GLOBAL +# define LT_GLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_GLOBAL DL_GLOBAL +# endif +#endif /* !RTLD_GLOBAL */ +#ifndef LT_GLOBAL +# define LT_GLOBAL 0 +#endif /* !LT_GLOBAL */ + +/* We may have to define LT_LAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_LAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_LAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_LAZY_OR_NOW DL_LAZY +# endif +# endif /* !RTLD_LAZY */ +#endif +#ifndef LT_LAZY_OR_NOW +# ifdef RTLD_NOW +# define LT_LAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_LAZY_OR_NOW DL_NOW +# endif +# endif /* !RTLD_NOW */ +#endif +#ifndef LT_LAZY_OR_NOW +# define LT_LAZY_OR_NOW 0 +#endif /* !LT_LAZY_OR_NOW */ + +#if HAVE_DLERROR +# define DLERROR(arg) dlerror () +#else +# define DLERROR(arg) LT_DLSTRERROR (arg) +#endif + +static lt_module +sys_dl_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + lt_module module = dlopen (filename, LT_GLOBAL | LT_LAZY_OR_NOW); + + if (!module) + { + LT_DLMUTEX_SETERROR (DLERROR (CANNOT_OPEN)); + } + + return module; +} + +static int +sys_dl_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (dlclose (module) != 0) + { + LT_DLMUTEX_SETERROR (DLERROR (CANNOT_CLOSE)); + ++errors; + } + + return errors; +} + +static lt_ptr +sys_dl_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = dlsym (module, symbol); + + if (!address) + { + LT_DLMUTEX_SETERROR (DLERROR (SYMBOL_NOT_FOUND)); + } + + return address; +} + +static struct lt_user_dlloader sys_dl = + { +# ifdef NEED_USCORE + "_", +# else + 0, +# endif + sys_dl_open, sys_dl_close, sys_dl_sym, 0, 0 }; + + +#endif /* HAVE_LIBDL */ + + + +/* --- SHL_LOAD() INTERFACE LOADER --- */ + +#if HAVE_SHL_LOAD + +/* dynamic linking with shl_load (HP-UX) (comments from gmodule) */ + +#ifdef HAVE_DL_H +# include +#endif + +/* some flags are missing on some systems, so we provide + * harmless defaults. + * + * Mandatory: + * BIND_IMMEDIATE - Resolve symbol references when the library is loaded. + * BIND_DEFERRED - Delay code symbol resolution until actual reference. + * + * Optionally: + * BIND_FIRST - Place the library at the head of the symbol search + * order. + * BIND_NONFATAL - The default BIND_IMMEDIATE behavior is to treat all + * unsatisfied symbols as fatal. This flag allows + * binding of unsatisfied code symbols to be deferred + * until use. + * [Perl: For certain libraries, like DCE, deferred + * binding often causes run time problems. Adding + * BIND_NONFATAL to BIND_IMMEDIATE still allows + * unresolved references in situations like this.] + * BIND_NOSTART - Do not call the initializer for the shared library + * when the library is loaded, nor on a future call to + * shl_unload(). + * BIND_VERBOSE - Print verbose messages concerning possible + * unsatisfied symbols. + * + * hp9000s700/hp9000s800: + * BIND_RESTRICTED - Restrict symbols visible by the library to those + * present at library load time. + * DYNAMIC_PATH - Allow the loader to dynamically search for the + * library specified by the path argument. + */ + +#ifndef DYNAMIC_PATH +# define DYNAMIC_PATH 0 +#endif +#ifndef BIND_RESTRICTED +# define BIND_RESTRICTED 0 +#endif + +#define LT_BIND_FLAGS (BIND_IMMEDIATE | BIND_NONFATAL | DYNAMIC_PATH) + +static lt_module +sys_shl_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + static shl_t self = (shl_t) 0; + lt_module module = shl_load (filename, LT_BIND_FLAGS, 0L); + + /* Since searching for a symbol against a NULL module handle will also + look in everything else that was already loaded and exported with + the -E compiler flag, we always cache a handle saved before any + modules are loaded. */ + if (!self) + { + lt_ptr address; + shl_findsym (&self, "main", TYPE_UNDEFINED, &address); + } + + if (!filename) + { + module = self; + } + else + { + module = shl_load (filename, LT_BIND_FLAGS, 0L); + + if (!module) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); + } + } + + return module; +} + +static int +sys_shl_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (module && (shl_unload ((shl_t) (module)) != 0)) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); + ++errors; + } + + return errors; +} + +static lt_ptr +sys_shl_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = 0; + + /* sys_shl_open should never return a NULL module handle */ + if (module == (lt_module) 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + } + else if (!shl_findsym((shl_t*) &module, symbol, TYPE_UNDEFINED, &address)) + { + if (!address) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + } + } + + return address; +} + +static struct lt_user_dlloader sys_shl = { + 0, sys_shl_open, sys_shl_close, sys_shl_sym, 0, 0 +}; + +#endif /* HAVE_SHL_LOAD */ + + + + +/* --- LOADLIBRARY() INTERFACE LOADER --- */ + +#ifdef __WINDOWS__ + +/* dynamic linking for Win32 */ + +#include + +/* Forward declaration; required to implement handle search below. */ +static lt_dlhandle handles; + +static lt_module +sys_wll_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + lt_dlhandle cur; + lt_module module = 0; + const char *errormsg = 0; + char *searchname = 0; + char *ext; + char self_name_buf[MAX_PATH]; + + if (!filename) + { + /* Get the name of main module */ + *self_name_buf = 0; + GetModuleFileName (NULL, self_name_buf, sizeof (self_name_buf)); + filename = ext = self_name_buf; + } + else + { + ext = strrchr (filename, '.'); + } + + if (ext) + { + /* FILENAME already has an extension. */ + searchname = lt_estrdup (filename); + } + else + { + /* Append a `.' to stop Windows from adding an + implicit `.dll' extension. */ + searchname = LT_EMALLOC (char, 2+ LT_STRLEN (filename)); + if (searchname) + sprintf (searchname, "%s.", filename); + } + if (!searchname) + return 0; + +#if __CYGWIN__ + { + char wpath[MAX_PATH]; + cygwin_conv_to_full_win32_path(searchname, wpath); + module = LoadLibrary(wpath); + } +#else + module = LoadLibrary (searchname); +#endif + LT_DLFREE (searchname); + + /* libltdl expects this function to fail if it is unable + to physically load the library. Sadly, LoadLibrary + will search the loaded libraries for a match and return + one of them if the path search load fails. + + We check whether LoadLibrary is returning a handle to + an already loaded module, and simulate failure if we + find one. */ + LT_DLMUTEX_LOCK (); + cur = handles; + while (cur) + { + if (!cur->module) + { + cur = 0; + break; + } + + if (cur->module == module) + { + break; + } + + cur = cur->next; + } + LT_DLMUTEX_UNLOCK (); + + if (cur || !module) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); + module = 0; + } + + return module; +} + +static int +sys_wll_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (FreeLibrary(module) == 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); + ++errors; + } + + return errors; +} + +static lt_ptr +sys_wll_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = GetProcAddress (module, symbol); + + if (!address) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + } + + return address; +} + +static struct lt_user_dlloader sys_wll = { + 0, sys_wll_open, sys_wll_close, sys_wll_sym, 0, 0 +}; + +#endif /* __WINDOWS__ */ + + + + +/* --- LOAD_ADD_ON() INTERFACE LOADER --- */ + + +#ifdef __BEOS__ + +/* dynamic linking for BeOS */ + +#include + +static lt_module +sys_bedl_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + image_id image = 0; + + if (filename) + { + image = load_add_on (filename); + } + else + { + image_info info; + int32 cookie = 0; + if (get_next_image_info (0, &cookie, &info) == B_OK) + image = load_add_on (info.name); + } + + if (image <= 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); + image = 0; + } + + return (lt_module) image; +} + +static int +sys_bedl_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (unload_add_on ((image_id) module) != B_OK) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); + ++errors; + } + + return errors; +} + +static lt_ptr +sys_bedl_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = 0; + image_id image = (image_id) module; + + if (get_image_symbol (image, symbol, B_SYMBOL_TYPE_ANY, address) != B_OK) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + address = 0; + } + + return address; +} + +static struct lt_user_dlloader sys_bedl = { + 0, sys_bedl_open, sys_bedl_close, sys_bedl_sym, 0, 0 +}; + +#endif /* __BEOS__ */ + + + + +/* --- DLD_LINK() INTERFACE LOADER --- */ + + +#if HAVE_DLD + +/* dynamic linking with dld */ + +#if HAVE_DLD_H +#include +#endif + +static lt_module +sys_dld_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + lt_module module = strdup (filename); + + if (dld_link (filename) != 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); + LT_DLFREE (module); + module = 0; + } + + return module; +} + +static int +sys_dld_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + int errors = 0; + + if (dld_unlink_by_file ((char*)(module), 1) != 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); + ++errors; + } + else + { + LT_DLFREE (module); + } + + return errors; +} + +static lt_ptr +sys_dld_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_ptr address = dld_get_func (symbol); + + if (!address) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + } + + return address; +} + +static struct lt_user_dlloader sys_dld = { + 0, sys_dld_open, sys_dld_close, sys_dld_sym, 0, 0 +}; + +#endif /* HAVE_DLD */ + + + + +/* --- DLPREOPEN() INTERFACE LOADER --- */ + + +/* emulate dynamic linking using preloaded_symbols */ + +typedef struct lt_dlsymlists_t +{ + struct lt_dlsymlists_t *next; + const lt_dlsymlist *syms; +} lt_dlsymlists_t; + +static const lt_dlsymlist *default_preloaded_symbols = 0; +static lt_dlsymlists_t *preloaded_symbols = 0; + +static int +presym_init (loader_data) + lt_user_data loader_data; +{ + int errors = 0; + + LT_DLMUTEX_LOCK (); + + preloaded_symbols = 0; + if (default_preloaded_symbols) + { + errors = lt_dlpreload (default_preloaded_symbols); + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +static int +presym_free_symlists () +{ + lt_dlsymlists_t *lists; + + LT_DLMUTEX_LOCK (); + + lists = preloaded_symbols; + while (lists) + { + lt_dlsymlists_t *tmp = lists; + + lists = lists->next; + LT_DLFREE (tmp); + } + preloaded_symbols = 0; + + LT_DLMUTEX_UNLOCK (); + + return 0; +} + +static int +presym_exit (loader_data) + lt_user_data loader_data; +{ + presym_free_symlists (); + return 0; +} + +static int +presym_add_symlist (preloaded) + const lt_dlsymlist *preloaded; +{ + lt_dlsymlists_t *tmp; + lt_dlsymlists_t *lists; + int errors = 0; + + LT_DLMUTEX_LOCK (); + + lists = preloaded_symbols; + while (lists) + { + if (lists->syms == preloaded) + { + goto done; + } + lists = lists->next; + } + + tmp = LT_EMALLOC (lt_dlsymlists_t, 1); + if (tmp) + { + memset (tmp, 0, sizeof(lt_dlsymlists_t)); + tmp->syms = preloaded; + tmp->next = preloaded_symbols; + preloaded_symbols = tmp; + } + else + { + ++errors; + } + + done: + LT_DLMUTEX_UNLOCK (); + return errors; +} + +static lt_module +presym_open (loader_data, filename) + lt_user_data loader_data; + const char *filename; +{ + lt_dlsymlists_t *lists; + lt_module module = (lt_module) 0; + + LT_DLMUTEX_LOCK (); + lists = preloaded_symbols; + + if (!lists) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_SYMBOLS)); + goto done; + } + + /* Can't use NULL as the reflective symbol header, as NULL is + used to mark the end of the entire symbol list. Self-dlpreopened + symbols follow this magic number, chosen to be an unlikely + clash with a real module name. */ + if (!filename) + { + filename = "@PROGRAM@"; + } + + while (lists) + { + const lt_dlsymlist *syms = lists->syms; + + while (syms->name) + { + if (!syms->address && strcmp(syms->name, filename) == 0) + { + module = (lt_module) syms; + goto done; + } + ++syms; + } + + lists = lists->next; + } + + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); + + done: + LT_DLMUTEX_UNLOCK (); + return module; +} + +static int +presym_close (loader_data, module) + lt_user_data loader_data; + lt_module module; +{ + /* Just to silence gcc -Wall */ + module = 0; + return 0; +} + +static lt_ptr +presym_sym (loader_data, module, symbol) + lt_user_data loader_data; + lt_module module; + const char *symbol; +{ + lt_dlsymlist *syms = (lt_dlsymlist*) module; + + ++syms; + while (syms->address) + { + if (strcmp(syms->name, symbol) == 0) + { + return syms->address; + } + + ++syms; + } + + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + + return 0; +} + +static struct lt_user_dlloader presym = { + 0, presym_open, presym_close, presym_sym, presym_exit, 0 +}; + + + + + +/* --- DYNAMIC MODULE LOADING --- */ + + +/* The type of a function used at each iteration of foreach_dirinpath(). */ +typedef int foreach_callback_func LT_PARAMS((char *filename, lt_ptr data1, + lt_ptr data2)); + +static int foreach_dirinpath LT_PARAMS((const char *search_path, + const char *base_name, + foreach_callback_func *func, + lt_ptr data1, lt_ptr data2)); + +static int find_file_callback LT_PARAMS((char *filename, lt_ptr data, + lt_ptr ignored)); +static int find_handle_callback LT_PARAMS((char *filename, lt_ptr data, + lt_ptr ignored)); +static int foreachfile_callback LT_PARAMS((char *filename, lt_ptr data1, + lt_ptr data2)); + + +static int canonicalize_path LT_PARAMS((const char *path, + char **pcanonical)); +static int argzize_path LT_PARAMS((const char *path, + char **pargz, + size_t *pargz_len)); +static FILE *find_file LT_PARAMS((const char *search_path, + const char *base_name, + char **pdir)); +static lt_dlhandle *find_handle LT_PARAMS((const char *search_path, + const char *base_name, + lt_dlhandle *handle)); +static int find_module LT_PARAMS((lt_dlhandle *handle, + const char *dir, + const char *libdir, + const char *dlname, + const char *old_name, + int installed)); +static int free_vars LT_PARAMS((char *dlname, char *oldname, + char *libdir, char *deplibs)); +static int load_deplibs LT_PARAMS((lt_dlhandle handle, + char *deplibs)); +static int trim LT_PARAMS((char **dest, + const char *str)); +static int try_dlopen LT_PARAMS((lt_dlhandle *handle, + const char *filename)); +static int tryall_dlopen LT_PARAMS((lt_dlhandle *handle, + const char *filename)); +static int unload_deplibs LT_PARAMS((lt_dlhandle handle)); +static int lt_argz_insert LT_PARAMS((char **pargz, + size_t *pargz_len, + char *before, + const char *entry)); +static int lt_argz_insertinorder LT_PARAMS((char **pargz, + size_t *pargz_len, + const char *entry)); +static int lt_dlpath_insertdir LT_PARAMS((char **ppath, + char *before, + const char *dir)); + +static char *user_search_path= 0; +static lt_dlloader *loaders = 0; +static lt_dlhandle handles = 0; +static int initialized = 0; + +/* Initialize libltdl. */ +int +lt_dlinit () +{ + int errors = 0; + + LT_DLMUTEX_LOCK (); + + /* Initialize only at first call. */ + if (++initialized == 1) + { + handles = 0; + user_search_path = 0; /* empty search path */ + +#if HAVE_LIBDL && !defined(__CYGWIN__) + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dl, "dlopen"); +#endif +#if HAVE_SHL_LOAD + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_shl, "dlopen"); +#endif +#ifdef __WINDOWS__ + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_wll, "dlopen"); +#endif +#ifdef __BEOS__ + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_bedl, "dlopen"); +#endif +#if HAVE_DLD + errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dld, "dld"); +#endif + errors += lt_dlloader_add (lt_dlloader_next (0), &presym, "dlpreload"); + + if (presym_init (presym.dlloader_data)) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INIT_LOADER)); + ++errors; + } + else if (errors != 0) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (DLOPEN_NOT_SUPPORTED)); + ++errors; + } + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +int +lt_dlpreload (preloaded) + const lt_dlsymlist *preloaded; +{ + int errors = 0; + + if (preloaded) + { + errors = presym_add_symlist (preloaded); + } + else + { + presym_free_symlists(); + + LT_DLMUTEX_LOCK (); + if (default_preloaded_symbols) + { + errors = lt_dlpreload (default_preloaded_symbols); + } + LT_DLMUTEX_UNLOCK (); + } + + return errors; +} + +int +lt_dlpreload_default (preloaded) + const lt_dlsymlist *preloaded; +{ + LT_DLMUTEX_LOCK (); + default_preloaded_symbols = preloaded; + LT_DLMUTEX_UNLOCK (); + return 0; +} + +int +lt_dlexit () +{ + /* shut down libltdl */ + lt_dlloader *loader; + int errors = 0; + + LT_DLMUTEX_LOCK (); + loader = loaders; + + if (!initialized) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SHUTDOWN)); + ++errors; + goto done; + } + + /* shut down only at last call. */ + if (--initialized == 0) + { + int level; + + while (handles && LT_DLIS_RESIDENT (handles)) + { + handles = handles->next; + } + + /* close all modules */ + for (level = 1; handles; ++level) + { + lt_dlhandle cur = handles; + int saw_nonresident = 0; + + while (cur) + { + lt_dlhandle tmp = cur; + cur = cur->next; + if (!LT_DLIS_RESIDENT (tmp)) + saw_nonresident = 1; + if (!LT_DLIS_RESIDENT (tmp) && tmp->info.ref_count <= level) + { + if (lt_dlclose (tmp)) + { + ++errors; + } + } + } + /* done if only resident modules are left */ + if (!saw_nonresident) + break; + } + + /* close all loaders */ + while (loader) + { + lt_dlloader *next = loader->next; + lt_user_data data = loader->dlloader_data; + if (loader->dlloader_exit && loader->dlloader_exit (data)) + { + ++errors; + } + + LT_DLMEM_REASSIGN (loader, next); + } + loaders = 0; + } + + done: + LT_DLMUTEX_UNLOCK (); + return errors; +} + +static int +tryall_dlopen (handle, filename) + lt_dlhandle *handle; + const char *filename; +{ + lt_dlhandle cur; + lt_dlloader *loader; + const char *saved_error; + int errors = 0; + + LT_DLMUTEX_GETERROR (saved_error); + LT_DLMUTEX_LOCK (); + + cur = handles; + loader = loaders; + + /* check whether the module was already opened */ + while (cur) + { + /* try to dlopen the program itself? */ + if (!cur->info.filename && !filename) + { + break; + } + + if (cur->info.filename && filename + && strcmp (cur->info.filename, filename) == 0) + { + break; + } + + cur = cur->next; + } + + if (cur) + { + ++cur->info.ref_count; + *handle = cur; + goto done; + } + + cur = *handle; + if (filename) + { + cur->info.filename = lt_estrdup (filename); + if (!cur->info.filename) + { + ++errors; + goto done; + } + } + else + { + cur->info.filename = 0; + } + + while (loader) + { + lt_user_data data = loader->dlloader_data; + + cur->module = loader->module_open (data, filename); + + if (cur->module != 0) + { + break; + } + loader = loader->next; + } + + if (!loader) + { + LT_DLFREE (cur->info.filename); + ++errors; + goto done; + } + + cur->loader = loader; + LT_DLMUTEX_SETERROR (saved_error); + + done: + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +static int +tryall_dlopen_module (handle, prefix, dirname, dlname) + lt_dlhandle *handle; + const char *prefix; + const char *dirname; + const char *dlname; +{ + int error = 0; + char *filename = 0; + size_t filename_len = 0; + size_t dirname_len = LT_STRLEN (dirname); + + assert (handle); + assert (dirname); + assert (dlname); +#ifdef LT_DIRSEP_CHAR + /* Only canonicalized names (i.e. with DIRSEP chars already converted) + should make it into this function: */ + assert (strchr (dirname, LT_DIRSEP_CHAR) == 0); +#endif + + if (dirname_len > 0) + if (dirname[dirname_len -1] == '/') + --dirname_len; + filename_len = dirname_len + 1 + LT_STRLEN (dlname); + + /* Allocate memory, and combine DIRNAME and MODULENAME into it. + The PREFIX (if any) is handled below. */ + filename = LT_EMALLOC (char, dirname_len + 1 + filename_len + 1); + if (!filename) + return 1; + + sprintf (filename, "%.*s/%s", (int) dirname_len, dirname, dlname); + + /* Now that we have combined DIRNAME and MODULENAME, if there is + also a PREFIX to contend with, simply recurse with the arguments + shuffled. Otherwise, attempt to open FILENAME as a module. */ + if (prefix) + { + error += tryall_dlopen_module (handle, + (const char *) 0, prefix, filename); + } + else if (tryall_dlopen (handle, filename) != 0) + { + ++error; + } + + LT_DLFREE (filename); + return error; +} + +static int +find_module (handle, dir, libdir, dlname, old_name, installed) + lt_dlhandle *handle; + const char *dir; + const char *libdir; + const char *dlname; + const char *old_name; + int installed; +{ + /* Try to open the old library first; if it was dlpreopened, + we want the preopened version of it, even if a dlopenable + module is available. */ + if (old_name && tryall_dlopen (handle, old_name) == 0) + { + return 0; + } + + /* Try to open the dynamic library. */ + if (dlname) + { + /* try to open the installed module */ + if (installed && libdir) + { + if (tryall_dlopen_module (handle, + (const char *) 0, libdir, dlname) == 0) + return 0; + } + + /* try to open the not-installed module */ + if (!installed) + { + if (tryall_dlopen_module (handle, dir, objdir, dlname) == 0) + return 0; + } + + /* maybe it was moved to another directory */ + { + if (tryall_dlopen_module (handle, + (const char *) 0, dir, dlname) == 0) + return 0; + } + } + + return 1; +} + + +static int +canonicalize_path (path, pcanonical) + const char *path; + char **pcanonical; +{ + char *canonical = 0; + + assert (path && *path); + assert (pcanonical); + + canonical = LT_EMALLOC (char, 1+ LT_STRLEN (path)); + if (!canonical) + return 1; + + { + size_t dest = 0; + size_t src; + for (src = 0; path[src] != LT_EOS_CHAR; ++src) + { + /* Path separators are not copied to the beginning or end of + the destination, or if another separator would follow + immediately. */ + if (path[src] == LT_PATHSEP_CHAR) + { + if ((dest == 0) + || (path[1+ src] == LT_PATHSEP_CHAR) + || (path[1+ src] == LT_EOS_CHAR)) + continue; + } + + /* Anything other than a directory separator is copied verbatim. */ + if ((path[src] != '/') +#ifdef LT_DIRSEP_CHAR + && (path[src] != LT_DIRSEP_CHAR) +#endif + ) + { + canonical[dest++] = path[src]; + } + /* Directory separators are converted and copied only if they are + not at the end of a path -- i.e. before a path separator or + NULL terminator. */ + else if ((path[1+ src] != LT_PATHSEP_CHAR) + && (path[1+ src] != LT_EOS_CHAR) +#ifdef LT_DIRSEP_CHAR + && (path[1+ src] != LT_DIRSEP_CHAR) +#endif + && (path[1+ src] != '/')) + { + canonical[dest++] = '/'; + } + } + + /* Add an end-of-string marker at the end. */ + canonical[dest] = LT_EOS_CHAR; + } + + /* Assign new value. */ + *pcanonical = canonical; + + return 0; +} + +static int +argzize_path (path, pargz, pargz_len) + const char *path; + char **pargz; + size_t *pargz_len; +{ + error_t error; + + assert (path); + assert (pargz); + assert (pargz_len); + + if ((error = argz_create_sep (path, LT_PATHSEP_CHAR, pargz, pargz_len))) + { + switch (error) + { + case ENOMEM: + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + break; + default: + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN)); + break; + } + + return 1; + } + + return 0; +} + +/* Repeatedly call FUNC with each LT_PATHSEP_CHAR delimited element + of SEARCH_PATH and references to DATA1 and DATA2, until FUNC returns + non-zero or all elements are exhausted. If BASE_NAME is non-NULL, + it is appended to each SEARCH_PATH element before FUNC is called. */ +static int +foreach_dirinpath (search_path, base_name, func, data1, data2) + const char *search_path; + const char *base_name; + foreach_callback_func *func; + lt_ptr data1; + lt_ptr data2; +{ + int result = 0; + int filenamesize = 0; + int lenbase = LT_STRLEN (base_name); + size_t argz_len = 0; + char * argz = 0; + char * filename = 0; + char * canonical = 0; + + LT_DLMUTEX_LOCK (); + + if (!search_path || !*search_path) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); + goto cleanup; + } + + if (canonicalize_path (search_path, &canonical) != 0) + goto cleanup; + + if (argzize_path (canonical, &argz, &argz_len) != 0) + goto cleanup; + + { + char *dir_name = 0; + while ((dir_name = argz_next (argz, argz_len, dir_name))) + { + int lendir = LT_STRLEN (dir_name); + + if (lendir +1 +lenbase >= filenamesize) + { + LT_DLFREE (filename); + filenamesize = lendir +1 +lenbase +1; /* "/d" + '/' + "f" + '\0' */ + filename = LT_EMALLOC (char, filenamesize); + if (!filename) + goto cleanup; + } + + strncpy (filename, dir_name, lendir); + if (base_name && *base_name) + { + if (filename[lendir -1] != '/') + filename[lendir++] = '/'; + strcpy (filename +lendir, base_name); + } + + if ((result = (*func) (filename, data1, data2))) + { + break; + } + } + } + + cleanup: + LT_DLFREE (argz); + LT_DLFREE (canonical); + LT_DLFREE (filename); + + LT_DLMUTEX_UNLOCK (); + + return result; +} + +/* If FILEPATH can be opened, store the name of the directory component + in DATA1, and the opened FILE* structure address in DATA2. Otherwise + DATA1 is unchanged, but DATA2 is set to a pointer to NULL. */ +static int +find_file_callback (filename, data1, data2) + char *filename; + lt_ptr data1; + lt_ptr data2; +{ + char **pdir = (char **) data1; + FILE **pfile = (FILE **) data2; + int is_done = 0; + + assert (filename && *filename); + assert (pdir); + assert (pfile); + + if ((*pfile = fopen (filename, LT_READTEXT_MODE))) + { + char *dirend = strrchr (filename, '/'); + + if (dirend > filename) + *dirend = LT_EOS_CHAR; + + LT_DLFREE (*pdir); + *pdir = lt_estrdup (filename); + is_done = (*pdir == 0) ? -1 : 1; + } + + return is_done; +} + +static FILE * +find_file (search_path, base_name, pdir) + const char *search_path; + const char *base_name; + char **pdir; +{ + FILE *file = 0; + + foreach_dirinpath (search_path, base_name, find_file_callback, pdir, &file); + + return file; +} + +static int +find_handle_callback (filename, data, ignored) + char *filename; + lt_ptr data; + lt_ptr ignored; +{ + lt_dlhandle *handle = (lt_dlhandle *) data; + int found = !access (filename, F_OK); + + /* Bail out if file cannot be read... */ + if (!found) + return 0; + + /* Try to dlopen the file, but do not continue searching in any + case. */ + if (tryall_dlopen (handle, filename) != 0) + *handle = 0; + + return 1; +} + +/* If HANDLE was found return it, otherwise return 0. If HANDLE was + found but could not be opened, *HANDLE will be set to 0. */ +static lt_dlhandle * +find_handle (search_path, base_name, handle) + const char *search_path; + const char *base_name; + lt_dlhandle *handle; +{ + if (!search_path) + return 0; + + if (!foreach_dirinpath (search_path, base_name, find_handle_callback, + handle, 0)) + return 0; + + return handle; +} + +static int +load_deplibs (handle, deplibs) + lt_dlhandle handle; + char *deplibs; +{ +#if LTDL_DLOPEN_DEPLIBS + char *p, *save_search_path = 0; + int depcount = 0; + int i; + char **names = 0; +#endif + int errors = 0; + + handle->depcount = 0; + +#if LTDL_DLOPEN_DEPLIBS + if (!deplibs) + { + return errors; + } + ++errors; + + LT_DLMUTEX_LOCK (); + if (user_search_path) + { + save_search_path = lt_estrdup (user_search_path); + if (!save_search_path) + goto cleanup; + } + + /* extract search paths and count deplibs */ + p = deplibs; + while (*p) + { + if (!isspace ((int) *p)) + { + char *end = p+1; + while (*end && !isspace((int) *end)) + { + ++end; + } + + if (strncmp(p, "-L", 2) == 0 || strncmp(p, "-R", 2) == 0) + { + char save = *end; + *end = 0; /* set a temporary string terminator */ + if (lt_dladdsearchdir(p+2)) + { + goto cleanup; + } + *end = save; + } + else + { + ++depcount; + } + + p = end; + } + else + { + ++p; + } + } + + /* restore the old search path */ + LT_DLFREE (user_search_path); + user_search_path = save_search_path; + + LT_DLMUTEX_UNLOCK (); + + if (!depcount) + { + errors = 0; + goto cleanup; + } + + names = LT_EMALLOC (char *, depcount * sizeof (char*)); + if (!names) + goto cleanup; + + /* now only extract the actual deplibs */ + depcount = 0; + p = deplibs; + while (*p) + { + if (isspace ((int) *p)) + { + ++p; + } + else + { + char *end = p+1; + while (*end && !isspace ((int) *end)) + { + ++end; + } + + if (strncmp(p, "-L", 2) != 0 && strncmp(p, "-R", 2) != 0) + { + char *name; + char save = *end; + *end = 0; /* set a temporary string terminator */ + if (strncmp(p, "-l", 2) == 0) + { + size_t name_len = 3+ /* "lib" */ LT_STRLEN (p + 2); + name = LT_EMALLOC (char, 1+ name_len); + if (name) + sprintf (name, "lib%s", p+2); + } + else + name = lt_estrdup(p); + + if (!name) + goto cleanup_names; + + names[depcount++] = name; + *end = save; + } + p = end; + } + } + + /* load the deplibs (in reverse order) + At this stage, don't worry if the deplibs do not load correctly, + they may already be statically linked into the loading application + for instance. There will be a more enlightening error message + later on if the loaded module cannot resolve all of its symbols. */ + if (depcount) + { + int j = 0; + + handle->deplibs = (lt_dlhandle*) LT_EMALLOC (lt_dlhandle *, depcount); + if (!handle->deplibs) + goto cleanup; + + for (i = 0; i < depcount; ++i) + { + handle->deplibs[j] = lt_dlopenext(names[depcount-1-i]); + if (handle->deplibs[j]) + { + ++j; + } + } + + handle->depcount = j; /* Number of successfully loaded deplibs */ + errors = 0; + } + + cleanup_names: + for (i = 0; i < depcount; ++i) + { + LT_DLFREE (names[i]); + } + + cleanup: + LT_DLFREE (names); +#endif + + return errors; +} + +static int +unload_deplibs (handle) + lt_dlhandle handle; +{ + int i; + int errors = 0; + + if (handle->depcount) + { + for (i = 0; i < handle->depcount; ++i) + { + if (!LT_DLIS_RESIDENT (handle->deplibs[i])) + { + errors += lt_dlclose (handle->deplibs[i]); + } + } + } + + return errors; +} + +static int +trim (dest, str) + char **dest; + const char *str; +{ + /* remove the leading and trailing "'" from str + and store the result in dest */ + const char *end = strrchr (str, '\''); + int len = LT_STRLEN (str); + char *tmp; + + LT_DLFREE (*dest); + + if (len > 3 && str[0] == '\'') + { + tmp = LT_EMALLOC (char, end - str); + if (!tmp) + return 1; + + strncpy(tmp, &str[1], (end - str) - 1); + tmp[len-3] = LT_EOS_CHAR; + *dest = tmp; + } + else + { + *dest = 0; + } + + return 0; +} + +static int +free_vars (dlname, oldname, libdir, deplibs) + char *dlname; + char *oldname; + char *libdir; + char *deplibs; +{ + LT_DLFREE (dlname); + LT_DLFREE (oldname); + LT_DLFREE (libdir); + LT_DLFREE (deplibs); + + return 0; +} + +int +try_dlopen (phandle, filename) + lt_dlhandle *phandle; + const char *filename; +{ + const char * ext = 0; + const char * saved_error = 0; + char * canonical = 0; + char * base_name = 0; + char * dir = 0; + char * name = 0; + int errors = 0; + lt_dlhandle newhandle; + + assert (phandle); + assert (*phandle == 0); + + LT_DLMUTEX_GETERROR (saved_error); + + /* dlopen self? */ + if (!filename) + { + *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); + if (*phandle == 0) + return 1; + + memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); + newhandle = *phandle; + + /* lt_dlclose()ing yourself is very bad! Disallow it. */ + LT_DLSET_FLAG (*phandle, LT_DLRESIDENT_FLAG); + + if (tryall_dlopen (&newhandle, 0) != 0) + { + LT_DLFREE (*phandle); + return 1; + } + + goto register_handle; + } + + assert (filename && *filename); + + /* Doing this immediately allows internal functions to safely + assume only canonicalized paths are passed. */ + if (canonicalize_path (filename, &canonical) != 0) + { + ++errors; + goto cleanup; + } + + /* If the canonical module name is a path (relative or absolute) + then split it into a directory part and a name part. */ + base_name = strrchr (canonical, '/'); + if (base_name) + { + size_t dirlen = (1+ base_name) - canonical; + + dir = LT_EMALLOC (char, 1+ dirlen); + if (!dir) + { + ++errors; + goto cleanup; + } + + strncpy (dir, canonical, dirlen); + dir[dirlen] = LT_EOS_CHAR; + + ++base_name; + } + else + LT_DLMEM_REASSIGN (base_name, canonical); + + assert (base_name && *base_name); + + /* Check whether we are opening a libtool module (.la extension). */ + ext = strrchr (base_name, '.'); + if (ext && strcmp (ext, archive_ext) == 0) + { + /* this seems to be a libtool module */ + FILE * file = 0; + char * dlname = 0; + char * old_name = 0; + char * libdir = 0; + char * deplibs = 0; + char * line = 0; + size_t line_len; + int i; + + /* if we can't find the installed flag, it is probably an + installed libtool archive, produced with an old version + of libtool */ + int installed = 1; + + /* extract the module name from the file name */ + name = LT_EMALLOC (char, ext - base_name + 1); + if (!name) + { + ++errors; + goto cleanup; + } + + /* canonicalize the module name */ + for (i = 0; i < ext - base_name; ++i) + { + if (isalnum ((int)(base_name[i]))) + { + name[i] = base_name[i]; + } + else + { + name[i] = '_'; + } + } + name[ext - base_name] = LT_EOS_CHAR; + + /* Now try to open the .la file. If there is no directory name + component, try to find it first in user_search_path and then other + prescribed paths. Otherwise (or in any case if the module was not + yet found) try opening just the module name as passed. */ + if (!dir) + { + const char *search_path; + + LT_DLMUTEX_LOCK (); + search_path = user_search_path; + if (search_path) + file = find_file (user_search_path, base_name, &dir); + LT_DLMUTEX_UNLOCK (); + + if (!file) + { + search_path = getenv (LTDL_SEARCHPATH_VAR); + if (search_path) + file = find_file (search_path, base_name, &dir); + } + +#ifdef LTDL_SHLIBPATH_VAR + if (!file) + { + search_path = getenv (LTDL_SHLIBPATH_VAR); + if (search_path) + file = find_file (search_path, base_name, &dir); + } +#endif +#ifdef LTDL_SYSSEARCHPATH + if (!file && sys_search_path) + { + file = find_file (sys_search_path, base_name, &dir); + } +#endif + } + if (!file) + { + file = fopen (filename, LT_READTEXT_MODE); + } + + /* If we didn't find the file by now, it really isn't there. Set + the status flag, and bail out. */ + if (!file) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); + ++errors; + goto cleanup; + } + + line_len = LT_FILENAME_MAX; + line = LT_EMALLOC (char, line_len); + if (!line) + { + fclose (file); + ++errors; + goto cleanup; + } + + /* read the .la file */ + while (!feof (file)) + { + if (!fgets (line, line_len, file)) + { + break; + } + + /* Handle the case where we occasionally need to read a line + that is longer than the initial buffer size. */ + while ((line[LT_STRLEN(line) -1] != '\n') && (!feof (file))) + { + line = LT_DLREALLOC (char, line, line_len *2); + if (!fgets (&line[line_len -1], line_len +1, file)) + { + break; + } + line_len *= 2; + } + + if (line[0] == '\n' || line[0] == '#') + { + continue; + } + +#undef STR_DLNAME +#define STR_DLNAME "dlname=" + if (strncmp (line, STR_DLNAME, sizeof (STR_DLNAME) - 1) == 0) + { + errors += trim (&dlname, &line[sizeof (STR_DLNAME) - 1]); + } + +#undef STR_OLD_LIBRARY +#define STR_OLD_LIBRARY "old_library=" + else if (strncmp (line, STR_OLD_LIBRARY, + sizeof (STR_OLD_LIBRARY) - 1) == 0) + { + errors += trim (&old_name, &line[sizeof (STR_OLD_LIBRARY) - 1]); + } +#undef STR_LIBDIR +#define STR_LIBDIR "libdir=" + else if (strncmp (line, STR_LIBDIR, sizeof (STR_LIBDIR) - 1) == 0) + { + errors += trim (&libdir, &line[sizeof(STR_LIBDIR) - 1]); + } + +#undef STR_DL_DEPLIBS +#define STR_DL_DEPLIBS "dependency_libs=" + else if (strncmp (line, STR_DL_DEPLIBS, + sizeof (STR_DL_DEPLIBS) - 1) == 0) + { + errors += trim (&deplibs, &line[sizeof (STR_DL_DEPLIBS) - 1]); + } + else if (strcmp (line, "installed=yes\n") == 0) + { + installed = 1; + } + else if (strcmp (line, "installed=no\n") == 0) + { + installed = 0; + } + +#undef STR_LIBRARY_NAMES +#define STR_LIBRARY_NAMES "library_names=" + else if (! dlname && strncmp (line, STR_LIBRARY_NAMES, + sizeof (STR_LIBRARY_NAMES) - 1) == 0) + { + char *last_libname; + errors += trim (&dlname, &line[sizeof (STR_LIBRARY_NAMES) - 1]); + if (!errors + && dlname + && (last_libname = strrchr (dlname, ' ')) != 0) + { + last_libname = lt_estrdup (last_libname + 1); + if (!last_libname) + { + ++errors; + goto cleanup; + } + LT_DLMEM_REASSIGN (dlname, last_libname); + } + } + + if (errors) + break; + } + + fclose (file); + LT_DLFREE (line); + + /* allocate the handle */ + *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); + if (*phandle == 0) + ++errors; + + if (errors) + { + free_vars (dlname, old_name, libdir, deplibs); + LT_DLFREE (*phandle); + goto cleanup; + } + + assert (*phandle); + + memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); + if (load_deplibs (*phandle, deplibs) == 0) + { + newhandle = *phandle; + /* find_module may replace newhandle */ + if (find_module (&newhandle, dir, libdir, dlname, old_name, installed)) + { + unload_deplibs (*phandle); + ++errors; + } + } + else + { + ++errors; + } + + free_vars (dlname, old_name, libdir, deplibs); + if (errors) + { + LT_DLFREE (*phandle); + goto cleanup; + } + + if (*phandle != newhandle) + { + unload_deplibs (*phandle); + } + } + else + { + /* not a libtool module */ + *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); + if (*phandle == 0) + { + ++errors; + goto cleanup; + } + + memset (*phandle, 0, sizeof (struct lt_dlhandle_struct)); + newhandle = *phandle; + + /* If the module has no directory name component, try to find it + first in user_search_path and then other prescribed paths. + Otherwise (or in any case if the module was not yet found) try + opening just the module name as passed. */ + if ((dir || (!find_handle (user_search_path, base_name, &newhandle) + && !find_handle (getenv (LTDL_SEARCHPATH_VAR), base_name, + &newhandle) +#ifdef LTDL_SHLIBPATH_VAR + && !find_handle (getenv (LTDL_SHLIBPATH_VAR), base_name, + &newhandle) +#endif +#ifdef LTDL_SYSSEARCHPATH + && !find_handle (sys_search_path, base_name, &newhandle) +#endif + ))) + { + if (tryall_dlopen (&newhandle, filename) != 0) + newhandle = 0; + } + + if (!newhandle) + { + LT_DLFREE (*phandle); + ++errors; + goto cleanup; + } + } + + register_handle: + LT_DLMEM_REASSIGN (*phandle, newhandle); + + if ((*phandle)->info.ref_count == 0) + { + (*phandle)->info.ref_count = 1; + LT_DLMEM_REASSIGN ((*phandle)->info.name, name); + + LT_DLMUTEX_LOCK (); + (*phandle)->next = handles; + handles = *phandle; + LT_DLMUTEX_UNLOCK (); + } + + LT_DLMUTEX_SETERROR (saved_error); + + cleanup: + LT_DLFREE (dir); + LT_DLFREE (name); + LT_DLFREE (canonical); + + return errors; +} + +lt_dlhandle +lt_dlopen (filename) + const char *filename; +{ + lt_dlhandle handle = 0; + + /* Just incase we missed a code path in try_dlopen() that reports + an error, but forgets to reset handle... */ + if (try_dlopen (&handle, filename) != 0) + return 0; + + return handle; +} + +/* If the last error messge store was `FILE_NOT_FOUND', then return + non-zero. */ +static int +file_not_found () +{ + const char *error = 0; + + LT_DLMUTEX_GETERROR (error); + if (error == LT_DLSTRERROR (FILE_NOT_FOUND)) + return 1; + + return 0; +} + +/* If FILENAME has an ARCHIVE_EXT or SHLIB_EXT extension, try to + open the FILENAME as passed. Otherwise try appending ARCHIVE_EXT, + and if a file is still not found try again with SHLIB_EXT appended + instead. */ +lt_dlhandle +lt_dlopenext (filename) + const char *filename; +{ + lt_dlhandle handle = 0; + char * tmp = 0; + char * ext = 0; + int len; + int errors = 0; + + if (!filename) + { + return lt_dlopen (filename); + } + + assert (filename); + + len = LT_STRLEN (filename); + ext = strrchr (filename, '.'); + + /* If FILENAME already bears a suitable extension, there is no need + to try appending additional extensions. */ + if (ext && ((strcmp (ext, archive_ext) == 0) +#ifdef LTDL_SHLIB_EXT + || (strcmp (ext, shlib_ext) == 0) +#endif + )) + { + return lt_dlopen (filename); + } + + /* First try appending ARCHIVE_EXT. */ + tmp = LT_EMALLOC (char, len + LT_STRLEN (archive_ext) + 1); + if (!tmp) + return 0; + + strcpy (tmp, filename); + strcat (tmp, archive_ext); + errors = try_dlopen (&handle, tmp); + + /* If we found FILENAME, stop searching -- whether we were able to + load the file as a module or not. If the file exists but loading + failed, it is better to return an error message here than to + report FILE_NOT_FOUND when the alternatives (foo.so etc) are not + in the module search path. */ + if (handle || ((errors > 0) && !file_not_found ())) + { + LT_DLFREE (tmp); + return handle; + } + +#ifdef LTDL_SHLIB_EXT + /* Try appending SHLIB_EXT. */ + if (LT_STRLEN (shlib_ext) > LT_STRLEN (archive_ext)) + { + LT_DLFREE (tmp); + tmp = LT_EMALLOC (char, len + LT_STRLEN (shlib_ext) + 1); + if (!tmp) + return 0; + + strcpy (tmp, filename); + } + else + { + tmp[len] = LT_EOS_CHAR; + } + + strcat(tmp, shlib_ext); + errors = try_dlopen (&handle, tmp); + + /* As before, if the file was found but loading failed, return now + with the current error message. */ + if (handle || ((errors > 0) && !file_not_found ())) + { + LT_DLFREE (tmp); + return handle; + } +#endif + + /* Still here? Then we really did fail to locate any of the file + names we tried. */ + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); + LT_DLFREE (tmp); + return 0; +} + + +int +lt_argz_insert (pargz, pargz_len, before, entry) + char **pargz; + size_t *pargz_len; + char *before; + const char *entry; +{ + error_t error; + + if ((error = argz_insert (pargz, pargz_len, before, entry))) + { + switch (error) + { + case ENOMEM: + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); + break; + default: + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN)); + break; + } + return 1; + } + + return 0; +} + +int +lt_argz_insertinorder (pargz, pargz_len, entry) + char **pargz; + size_t *pargz_len; + const char *entry; +{ + char *before = 0; + + assert (pargz); + assert (pargz_len); + assert (entry && *entry); + + if (*pargz) + while ((before = argz_next (*pargz, *pargz_len, before))) + { + int cmp = strcmp (entry, before); + + if (cmp < 0) break; + if (cmp == 0) return 0; /* No duplicates! */ + } + + return lt_argz_insert (pargz, pargz_len, before, entry); +} + +static int +lt_argz_insertdir (pargz, pargz_len, dirnam, dp) + char **pargz; + size_t *pargz_len; + const char *dirnam; + struct dirent *dp; +{ + char *buf = 0; + size_t buf_len = 0; + char *end = 0; + size_t end_offset = 0; + size_t dir_len = 0; + int errors = 0; + + assert (pargz); + assert (pargz_len); + assert (dp); + + dir_len = LT_STRLEN (dirnam); + end = dp->d_name + LT_D_NAMLEN(dp); + + /* Ignore version numbers. */ + { + char *p; + for (p = end; p -1 > dp->d_name; --p) + if (strchr (".0123456789", p[-1]) == 0) + break; + + if (*p == '.') + end = p; + } + + /* Ignore filename extension. */ + { + char *p; + for (p = end -1; p > dp->d_name; --p) + if (*p == '.') + { + end = p; + break; + } + } + + /* Prepend the directory name. */ + end_offset = end - dp->d_name; + buf_len = dir_len + 1+ end_offset; + buf = LT_EMALLOC (char, 1+ buf_len); + if (!buf) + return ++errors; + + assert (buf); + + strcpy (buf, dirnam); + strcat (buf, "/"); + strncat (buf, dp->d_name, end_offset); + buf[buf_len] = LT_EOS_CHAR; + + /* Try to insert (in order) into ARGZ/ARGZ_LEN. */ + if (lt_argz_insertinorder (pargz, pargz_len, buf) != 0) + ++errors; + + LT_DLFREE (buf); + + return errors; +} + +static int +list_files_by_dir (dirnam, pargz, pargz_len) + const char *dirnam; + char **pargz; + size_t *pargz_len; +{ + DIR *dirp = 0; + int errors = 0; + + assert (dirnam && *dirnam); + assert (pargz); + assert (pargz_len); + assert (dirnam[LT_STRLEN(dirnam) -1] != '/'); + + dirp = opendir (dirnam); + if (dirp) + { + struct dirent *dp = 0; + + while ((dp = readdir (dirp))) + if (dp->d_name[0] != '.') + if (lt_argz_insertdir (pargz, pargz_len, dirnam, dp)) + { + ++errors; + break; + } + + closedir (dirp); + } + else + ++errors; + + return errors; +} + + +/* If there are any files in DIRNAME, call the function passed in + DATA1 (with the name of each file and DATA2 as arguments). */ +static int +foreachfile_callback (dirname, data1, data2) + char *dirname; + lt_ptr data1; + lt_ptr data2; +{ + int (*func) LT_PARAMS((const char *filename, lt_ptr data)) + = (int (*) LT_PARAMS((const char *filename, lt_ptr data))) data1; + + int is_done = 0; + char *argz = 0; + size_t argz_len = 0; + + if (list_files_by_dir (dirname, &argz, &argz_len) != 0) + goto cleanup; + if (!argz) + goto cleanup; + + { + char *filename = 0; + while ((filename = argz_next (argz, argz_len, filename))) + if ((is_done = (*func) (filename, data2))) + break; + } + + cleanup: + LT_DLFREE (argz); + + return is_done; +} + + +/* Call FUNC for each unique extensionless file in SEARCH_PATH, along + with DATA. The filenames passed to FUNC would be suitable for + passing to lt_dlopenext. The extensions are stripped so that + individual modules do not generate several entries (e.g. libfoo.la, + libfoo.so, libfoo.so.1, libfoo.so.1.0.0). If SEARCH_PATH is NULL, + then the same directories that lt_dlopen would search are examined. */ +int +lt_dlforeachfile (search_path, func, data) + const char *search_path; + int (*func) LT_PARAMS ((const char *filename, lt_ptr data)); + lt_ptr data; +{ + int is_done = 0; + + if (search_path) + { + /* If a specific path was passed, search only the directories + listed in it. */ + is_done = foreach_dirinpath (search_path, 0, + foreachfile_callback, func, data); + } + else + { + /* Otherwise search the default paths. */ + is_done = foreach_dirinpath (user_search_path, 0, + foreachfile_callback, func, data); + if (!is_done) + { + is_done = foreach_dirinpath (getenv("LTDL_LIBRARY_PATH"), 0, + foreachfile_callback, func, data); + } + +#ifdef LTDL_SHLIBPATH_VAR + if (!is_done) + { + is_done = foreach_dirinpath (getenv(LTDL_SHLIBPATH_VAR), 0, + foreachfile_callback, func, data); + } +#endif +#ifdef LTDL_SYSSEARCHPATH + if (!is_done) + { + is_done = foreach_dirinpath (getenv(LTDL_SYSSEARCHPATH), 0, + foreachfile_callback, func, data); + } +#endif + } + + return is_done; +} + +int +lt_dlclose (handle) + lt_dlhandle handle; +{ + lt_dlhandle cur, last; + int errors = 0; + + LT_DLMUTEX_LOCK (); + + /* check whether the handle is valid */ + last = cur = handles; + while (cur && handle != cur) + { + last = cur; + cur = cur->next; + } + + if (!cur) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + ++errors; + goto done; + } + + handle->info.ref_count--; + + /* Note that even with resident modules, we must track the ref_count + correctly incase the user decides to reset the residency flag + later (even though the API makes no provision for that at the + moment). */ + if (handle->info.ref_count <= 0 && !LT_DLIS_RESIDENT (handle)) + { + lt_user_data data = handle->loader->dlloader_data; + + if (handle != handles) + { + last->next = handle->next; + } + else + { + handles = handle->next; + } + + errors += handle->loader->module_close (data, handle->module); + errors += unload_deplibs(handle); + + LT_DLFREE (handle->info.filename); + LT_DLFREE (handle->info.name); + LT_DLFREE (handle); + + goto done; + } + + if (LT_DLIS_RESIDENT (handle)) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CLOSE_RESIDENT_MODULE)); + ++errors; + } + + done: + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +lt_ptr +lt_dlsym (handle, symbol) + lt_dlhandle handle; + const char *symbol; +{ + int lensym; + char lsym[LT_SYMBOL_LENGTH]; + char *sym; + lt_ptr address; + lt_user_data data; + + if (!handle) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + return 0; + } + + if (!symbol) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); + return 0; + } + + lensym = LT_STRLEN (symbol) + LT_STRLEN (handle->loader->sym_prefix) + + LT_STRLEN (handle->info.name); + + if (lensym + LT_SYMBOL_OVERHEAD < LT_SYMBOL_LENGTH) + { + sym = lsym; + } + else + { + sym = LT_EMALLOC (char, lensym + LT_SYMBOL_OVERHEAD + 1); + if (!sym) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (BUFFER_OVERFLOW)); + return 0; + } + } + + data = handle->loader->dlloader_data; + if (handle->info.name) + { + const char *saved_error; + + LT_DLMUTEX_GETERROR (saved_error); + + /* this is a libtool module */ + if (handle->loader->sym_prefix) + { + strcpy(sym, handle->loader->sym_prefix); + strcat(sym, handle->info.name); + } + else + { + strcpy(sym, handle->info.name); + } + + strcat(sym, "_LTX_"); + strcat(sym, symbol); + + /* try "modulename_LTX_symbol" */ + address = handle->loader->find_sym (data, handle->module, sym); + if (address) + { + if (sym != lsym) + { + LT_DLFREE (sym); + } + return address; + } + LT_DLMUTEX_SETERROR (saved_error); + } + + /* otherwise try "symbol" */ + if (handle->loader->sym_prefix) + { + strcpy(sym, handle->loader->sym_prefix); + strcat(sym, symbol); + } + else + { + strcpy(sym, symbol); + } + + address = handle->loader->find_sym (data, handle->module, sym); + if (sym != lsym) + { + LT_DLFREE (sym); + } + + return address; +} + +const char * +lt_dlerror () +{ + const char *error; + + LT_DLMUTEX_GETERROR (error); + LT_DLMUTEX_SETERROR (0); + + return error ? error : LT_DLSTRERROR (UNKNOWN); +} + +int +lt_dlpath_insertdir (ppath, before, dir) + char **ppath; + char *before; + const char *dir; +{ + int errors = 0; + char *canonical = 0; + char *argz = 0; + size_t argz_len = 0; + + assert (ppath); + assert (dir && *dir); + + if (canonicalize_path (dir, &canonical) != 0) + { + ++errors; + goto cleanup; + } + + assert (canonical && *canonical); + + /* If *PPATH is empty, set it to DIR. */ + if (*ppath == 0) + { + assert (!before); /* BEFORE cannot be set without PPATH. */ + assert (dir); /* Without DIR, don't call this function! */ + + *ppath = lt_estrdup (dir); + if (*ppath == 0) + ++errors; + + return errors; + } + + assert (ppath && *ppath); + + if (argzize_path (*ppath, &argz, &argz_len) != 0) + { + ++errors; + goto cleanup; + } + + /* Convert BEFORE into an equivalent offset into ARGZ. This only works + if *PPATH is already canonicalized, and hence does not change length + with respect to ARGZ. We canonicalize each entry as it is added to + the search path, and don't call this function with (uncanonicalized) + user paths, so this is a fair assumption. */ + if (before) + { + assert (*ppath <= before); + assert (before - *ppath <= strlen (*ppath)); + + before = before - *ppath + argz; + } + + if (lt_argz_insert (&argz, &argz_len, before, dir) != 0) + { + ++errors; + goto cleanup; + } + + argz_stringify (argz, argz_len, LT_PATHSEP_CHAR); + LT_DLMEM_REASSIGN (*ppath, argz); + + cleanup: + LT_DLFREE (canonical); + LT_DLFREE (argz); + + return errors; +} + +int +lt_dladdsearchdir (search_dir) + const char *search_dir; +{ + int errors = 0; + + if (search_dir && *search_dir) + { + LT_DLMUTEX_LOCK (); + if (lt_dlpath_insertdir (&user_search_path, 0, search_dir) != 0) + ++errors; + LT_DLMUTEX_UNLOCK (); + } + + return errors; +} + +int +lt_dlinsertsearchdir (before, search_dir) + const char *before; + const char *search_dir; +{ + int errors = 0; + + if (before) + { + LT_DLMUTEX_LOCK (); + if ((before < user_search_path) + || (before >= user_search_path + LT_STRLEN (user_search_path))) + { + LT_DLMUTEX_UNLOCK (); + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_POSITION)); + return 1; + } + LT_DLMUTEX_UNLOCK (); + } + + if (search_dir && *search_dir) + { + LT_DLMUTEX_LOCK (); + if (lt_dlpath_insertdir (&user_search_path, + (char *) before, search_dir) != 0) + { + ++errors; + } + LT_DLMUTEX_UNLOCK (); + } + + return errors; +} + +int +lt_dlsetsearchpath (search_path) + const char *search_path; +{ + int errors = 0; + + LT_DLMUTEX_LOCK (); + LT_DLFREE (user_search_path); + LT_DLMUTEX_UNLOCK (); + + if (!search_path || !LT_STRLEN (search_path)) + { + return errors; + } + + LT_DLMUTEX_LOCK (); + if (canonicalize_path (search_path, &user_search_path) != 0) + ++errors; + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +const char * +lt_dlgetsearchpath () +{ + const char *saved_path; + + LT_DLMUTEX_LOCK (); + saved_path = user_search_path; + LT_DLMUTEX_UNLOCK (); + + return saved_path; +} + +int +lt_dlmakeresident (handle) + lt_dlhandle handle; +{ + int errors = 0; + + if (!handle) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + ++errors; + } + else + { + LT_DLSET_FLAG (handle, LT_DLRESIDENT_FLAG); + } + + return errors; +} + +int +lt_dlisresident (handle) + lt_dlhandle handle; +{ + if (!handle) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + return -1; + } + + return LT_DLIS_RESIDENT (handle); +} + + + + +/* --- MODULE INFORMATION --- */ + +const lt_dlinfo * +lt_dlgetinfo (handle) + lt_dlhandle handle; +{ + if (!handle) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); + return 0; + } + + return &(handle->info); +} + +lt_dlhandle +lt_dlhandle_next (place) + lt_dlhandle place; +{ + return place ? place->next : handles; +} + +int +lt_dlforeach (func, data) + int (*func) LT_PARAMS((lt_dlhandle handle, lt_ptr data)); + lt_ptr data; +{ + int errors = 0; + lt_dlhandle cur; + + LT_DLMUTEX_LOCK (); + + cur = handles; + while (cur) + { + lt_dlhandle tmp = cur; + + cur = cur->next; + if ((*func) (tmp, data)) + { + ++errors; + break; + } + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +lt_dlcaller_id +lt_dlcaller_register () +{ + static lt_dlcaller_id last_caller_id = 0; + int result; + + LT_DLMUTEX_LOCK (); + result = ++last_caller_id; + LT_DLMUTEX_UNLOCK (); + + return result; +} + +lt_ptr +lt_dlcaller_set_data (key, handle, data) + lt_dlcaller_id key; + lt_dlhandle handle; + lt_ptr data; +{ + int n_elements = 0; + lt_ptr stale = (lt_ptr) 0; + int i; + + /* This needs to be locked so that the caller data can be updated + simultaneously by different threads. */ + LT_DLMUTEX_LOCK (); + + if (handle->caller_data) + while (handle->caller_data[n_elements].key) + ++n_elements; + + for (i = 0; i < n_elements; ++i) + { + if (handle->caller_data[i].key == key) + { + stale = handle->caller_data[i].data; + break; + } + } + + /* Ensure that there is enough room in this handle's caller_data + array to accept a new element (and an empty end marker). */ + if (i == n_elements) + { + lt_caller_data *temp + = LT_DLREALLOC (lt_caller_data, handle->caller_data, 2+ n_elements); + + if (!temp) + { + stale = 0; + goto done; + } + + handle->caller_data = temp; + + /* We only need this if we needed to allocate a new caller_data. */ + handle->caller_data[i].key = key; + handle->caller_data[1+ i].key = 0; + } + + handle->caller_data[i].data = data; + + done: + LT_DLMUTEX_UNLOCK (); + + return stale; +} + +lt_ptr +lt_dlcaller_get_data (key, handle) + lt_dlcaller_id key; + lt_dlhandle handle; +{ + lt_ptr result = (lt_ptr) 0; + + /* This needs to be locked so that the caller data isn't updated by + another thread part way through this function. */ + LT_DLMUTEX_LOCK (); + + /* Locate the index of the element with a matching KEY. */ + { + int i; + for (i = 0; handle->caller_data[i].key; ++i) + { + if (handle->caller_data[i].key == key) + { + result = handle->caller_data[i].data; + break; + } + } + } + + LT_DLMUTEX_UNLOCK (); + + return result; +} + + + +/* --- USER MODULE LOADER API --- */ + + +int +lt_dlloader_add (place, dlloader, loader_name) + lt_dlloader *place; + const struct lt_user_dlloader *dlloader; + const char *loader_name; +{ + int errors = 0; + lt_dlloader *node = 0, *ptr = 0; + + if ((dlloader == 0) /* diagnose null parameters */ + || (dlloader->module_open == 0) + || (dlloader->module_close == 0) + || (dlloader->find_sym == 0)) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + return 1; + } + + /* Create a new dlloader node with copies of the user callbacks. */ + node = LT_EMALLOC (lt_dlloader, 1); + if (!node) + return 1; + + node->next = 0; + node->loader_name = loader_name; + node->sym_prefix = dlloader->sym_prefix; + node->dlloader_exit = dlloader->dlloader_exit; + node->module_open = dlloader->module_open; + node->module_close = dlloader->module_close; + node->find_sym = dlloader->find_sym; + node->dlloader_data = dlloader->dlloader_data; + + LT_DLMUTEX_LOCK (); + if (!loaders) + { + /* If there are no loaders, NODE becomes the list! */ + loaders = node; + } + else if (!place) + { + /* If PLACE is not set, add NODE to the end of the + LOADERS list. */ + for (ptr = loaders; ptr->next; ptr = ptr->next) + { + /*NOWORK*/; + } + + ptr->next = node; + } + else if (loaders == place) + { + /* If PLACE is the first loader, NODE goes first. */ + node->next = place; + loaders = node; + } + else + { + /* Find the node immediately preceding PLACE. */ + for (ptr = loaders; ptr->next != place; ptr = ptr->next) + { + /*NOWORK*/; + } + + if (ptr->next != place) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + ++errors; + } + else + { + /* Insert NODE between PTR and PLACE. */ + node->next = place; + ptr->next = node; + } + } + + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +int +lt_dlloader_remove (loader_name) + const char *loader_name; +{ + lt_dlloader *place = lt_dlloader_find (loader_name); + lt_dlhandle handle; + int errors = 0; + + if (!place) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + return 1; + } + + LT_DLMUTEX_LOCK (); + + /* Fail if there are any open modules which use this loader. */ + for (handle = handles; handle; handle = handle->next) + { + if (handle->loader == place) + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (REMOVE_LOADER)); + ++errors; + goto done; + } + } + + if (place == loaders) + { + /* PLACE is the first loader in the list. */ + loaders = loaders->next; + } + else + { + /* Find the loader before the one being removed. */ + lt_dlloader *prev; + for (prev = loaders; prev->next; prev = prev->next) + { + if (!strcmp (prev->next->loader_name, loader_name)) + { + break; + } + } + + place = prev->next; + prev->next = prev->next->next; + } + + if (place->dlloader_exit) + { + errors = place->dlloader_exit (place->dlloader_data); + } + + LT_DLFREE (place); + + done: + LT_DLMUTEX_UNLOCK (); + + return errors; +} + +lt_dlloader * +lt_dlloader_next (place) + lt_dlloader *place; +{ + lt_dlloader *next; + + LT_DLMUTEX_LOCK (); + next = place ? place->next : loaders; + LT_DLMUTEX_UNLOCK (); + + return next; +} + +const char * +lt_dlloader_name (place) + lt_dlloader *place; +{ + const char *name = 0; + + if (place) + { + LT_DLMUTEX_LOCK (); + name = place ? place->loader_name : 0; + LT_DLMUTEX_UNLOCK (); + } + else + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + } + + return name; +} + +lt_user_data * +lt_dlloader_data (place) + lt_dlloader *place; +{ + lt_user_data *data = 0; + + if (place) + { + LT_DLMUTEX_LOCK (); + data = place ? &(place->dlloader_data) : 0; + LT_DLMUTEX_UNLOCK (); + } + else + { + LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); + } + + return data; +} + +lt_dlloader * +lt_dlloader_find (loader_name) + const char *loader_name; +{ + lt_dlloader *place = 0; + + LT_DLMUTEX_LOCK (); + for (place = loaders; place; place = place->next) + { + if (strcmp (place->loader_name, loader_name) == 0) + { + break; + } + } + LT_DLMUTEX_UNLOCK (); + + return place; +} From cf736a072dd34e9aef4044244b9a7f948f0ad4a2 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:52:02 +0000 Subject: [PATCH 224/306] * raw-ltdl.h: guile's modified version of the upstream ltdl.h. --- libguile-ltdl/raw-ltdl.h | 344 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 344 insertions(+) create mode 100644 libguile-ltdl/raw-ltdl.h diff --git a/libguile-ltdl/raw-ltdl.h b/libguile-ltdl/raw-ltdl.h new file mode 100644 index 000000000..89b5af34d --- /dev/null +++ b/libguile-ltdl/raw-ltdl.h @@ -0,0 +1,344 @@ +/* ltdl.h -- generic dlopen functions + Copyright (C) 1998-2000, 2002 Free Software Foundation, Inc. + Originally by Thomas Tanner + This file is part of GNU Libtool. + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +As a special exception to the GNU Lesser General Public License, +if you distribute this file as part of a program or library that +is built using GNU libtool, you may include it under the same +distribution terms that you use for the rest of that program. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free +Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +02111-1307 USA +*/ + +/* Only include this header file once. */ +#ifndef LTDL_H +#define LTDL_H 1 + +#include "guile-ltdl.h" + +#include /* for size_t declaration */ + + +/* --- MACROS FOR PORTABILITY --- */ + +/* LTDL_BEGIN_C_DECLS should be used at the beginning of your declarations, + so that C++ compilers don't mangle their names. Use LTDL_END_C_DECLS at + the end of C declarations. */ +#ifdef __cplusplus +# define LT_BEGIN_C_DECLS extern "C" { +# define LT_END_C_DECLS } +#else +# define LT_BEGIN_C_DECLS /* empty */ +# define LT_END_C_DECLS /* empty */ +#endif + +LT_BEGIN_C_DECLS + + +/* LT_PARAMS is a macro used to wrap function prototypes, so that compilers + that don't understand ANSI C prototypes still work, and ANSI C + compilers can issue warnings about type mismatches. */ +#if defined (__STDC__) || defined (_AIX) || (defined (__mips) && defined (_SYSTYPE_SVR4)) || defined(WIN32) || defined(__cplusplus) +# define LT_PARAMS(protos) protos +# define lt_ptr void* +#else +# define LT_PARAMS(protos) () +# define lt_ptr char* +#endif + +/* LT_STMT_START/END are used to create macros which expand to a + a single compound statement in a portable way. */ +#if defined (__GNUC__) && !defined (__STRICT_ANSI__) && !defined (__cplusplus) +# define LT_STMT_START (void)( +# define LT_STMT_END ) +#else +# if (defined (sun) || defined (__sun__)) +# define LT_STMT_START if (1) +# define LT_STMT_END else (void)0 +# else +# define LT_STMT_START do +# define LT_STMT_END while (0) +# endif +#endif + +/* LT_CONC creates a new concatenated symbol for the compiler + in a portable way. */ +#if defined(__STDC__) || defined(__cplusplus) +# define LT_CONC(s,t) s##t +#else +# define LT_CONC(s,t) s/**/t +#endif + +/* LT_STRLEN can be used safely on NULL pointers. */ +#define LT_STRLEN(s) (((s) && (s)[0]) ? strlen (s) : 0) + + + +/* --- WINDOWS SUPPORT --- */ + + +/* Canonicalise Windows and Cygwin recognition macros. */ +#ifdef __CYGWIN32__ +# ifndef __CYGWIN__ +# define __CYGWIN__ __CYGWIN32__ +# endif +#endif +#if defined(_WIN32) || defined(WIN32) +# ifndef __WINDOWS__ +# ifdef _WIN32 +# define __WINDOWS__ _WIN32 +# else +# ifdef WIN32 +# define __WINDOWS__ WIN32 +# endif +# endif +# endif +#endif + +#ifdef __WINDOWS__ +# ifndef __CYGWIN__ +/* LT_DIRSEP_CHAR is accepted *in addition* to '/' as a directory + separator when it is set. */ +# define LT_DIRSEP_CHAR '\\' +# define LT_PATHSEP_CHAR ';' +# endif +#endif +#ifndef LT_PATHSEP_CHAR +# define LT_PATHSEP_CHAR ':' +#endif + +/* DLL building support on win32 hosts; mostly to workaround their + ridiculous implementation of data symbol exporting. */ +#ifndef LT_SCOPE +# ifdef __WINDOWS__ +# ifdef DLL_EXPORT /* defined by libtool (if required) */ +# define LT_SCOPE __declspec(dllexport) +# endif +# ifdef LIBLTDL_DLL_IMPORT /* define if linking with this dll */ +# define LT_SCOPE extern __declspec(dllimport) +# endif +# endif +# ifndef LT_SCOPE /* static linking or !__WINDOWS__ */ +# define LT_SCOPE extern +# endif +#endif + + + + +/* --- DYNAMIC MODULE LOADING API --- */ + + +typedef struct lt_dlhandle_struct *lt_dlhandle; /* A loaded module. */ + +/* Initialisation and finalisation functions for libltdl. */ +SCMLTXT int lt_dlinit LT_PARAMS((void)); +SCMLTXT int lt_dlexit LT_PARAMS((void)) SCM_UNUSED; + +/* Module search path manipulation. */ +SCMLTXT int lt_dladdsearchdir LT_PARAMS((const char *search_dir)) SCM_UNUSED; +SCMLTXT int lt_dlinsertsearchdir LT_PARAMS((const char *before, + const char *search_dir)) SCM_UNUSED; +SCMLTXT int lt_dlsetsearchpath LT_PARAMS((const char *search_path)) SCM_UNUSED; +SCMLTXT const char *lt_dlgetsearchpath LT_PARAMS((void)) SCM_UNUSED; +SCMLTXT int lt_dlforeachfile LT_PARAMS(( + const char *search_path, + int (*func) (const char *filename, lt_ptr data), + lt_ptr data)) SCM_UNUSED; + +/* Portable libltdl versions of the system dlopen() API. */ +SCMLTXT lt_dlhandle lt_dlopen LT_PARAMS((const char *filename)); +SCMLTXT lt_dlhandle lt_dlopenext LT_PARAMS((const char *filename)); +SCMLTXT lt_ptr lt_dlsym LT_PARAMS((lt_dlhandle handle, + const char *name)); +SCMLTXT const char *lt_dlerror LT_PARAMS((void)); +SCMLTXT int lt_dlclose LT_PARAMS((lt_dlhandle handle)); + +/* Module residency management. */ +SCMLTXT int lt_dlmakeresident LT_PARAMS((lt_dlhandle handle)) SCM_UNUSED; +SCMLTXT int lt_dlisresident LT_PARAMS((lt_dlhandle handle)) SCM_UNUSED; + + + + +/* --- MUTEX LOCKING --- */ + + +typedef void lt_dlmutex_lock LT_PARAMS((void)); +typedef void lt_dlmutex_unlock LT_PARAMS((void)); +typedef void lt_dlmutex_seterror LT_PARAMS((const char *errmsg)); +typedef const char *lt_dlmutex_geterror LT_PARAMS((void)); + +SCMLTXT int lt_dlmutex_register LT_PARAMS((lt_dlmutex_lock *lock, + lt_dlmutex_unlock *unlock, + lt_dlmutex_seterror *seterror, + lt_dlmutex_geterror *geterror)) SCM_UNUSED; + + + + +/* --- MEMORY HANDLING --- */ + + +/* By default, the realloc function pointer is set to our internal + realloc implementation which iself uses lt_dlmalloc and lt_dlfree. + libltdl relies on a featureful realloc, but if you are sure yours + has the right semantics then you can assign it directly. Generally, + it is safe to assign just a malloc() and a free() function. */ +LT_SCOPE lt_ptr (*lt_dlmalloc) LT_PARAMS((size_t size)); +LT_SCOPE lt_ptr (*lt_dlrealloc) LT_PARAMS((lt_ptr ptr, size_t size)) SCM_UNUSED; +LT_SCOPE void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)); + + + + +/* --- PRELOADED MODULE SUPPORT --- */ + + +/* A preopened symbol. Arrays of this type comprise the exported + symbols for a dlpreopened module. */ +typedef struct { + const char *name; + lt_ptr address; +} lt_dlsymlist; + +SCMLTXT int lt_dlpreload LT_PARAMS((const lt_dlsymlist *preloaded)); +SCMLTXT int lt_dlpreload_default + LT_PARAMS((const lt_dlsymlist *preloaded)); + +#define LTDL_SET_PRELOADED_SYMBOLS() LT_STMT_START{ \ + extern const lt_dlsymlist lt_preloaded_symbols[]; \ + lt_dlpreload_default(lt_preloaded_symbols); \ + }LT_STMT_END + + + + +/* --- MODULE INFORMATION --- */ + + +/* Read only information pertaining to a loaded module. */ +typedef struct { + char *filename; /* file name */ + char *name; /* module name */ + int ref_count; /* number of times lt_dlopened minus + number of times lt_dlclosed. */ +} lt_dlinfo; + +SCMLTXT const lt_dlinfo *lt_dlgetinfo LT_PARAMS((lt_dlhandle handle)) SCM_UNUSED; +SCMLTXT lt_dlhandle lt_dlhandle_next LT_PARAMS((lt_dlhandle place)) SCM_UNUSED; +SCMLTXT int lt_dlforeach LT_PARAMS(( + int (*func) (lt_dlhandle handle, lt_ptr data), + lt_ptr data)) SCM_UNUSED; + +/* Associating user data with loaded modules. */ +typedef unsigned lt_dlcaller_id; + +SCMLTXT lt_dlcaller_id lt_dlcaller_register LT_PARAMS((void)) SCM_UNUSED; +SCMLTXT lt_ptr lt_dlcaller_set_data LT_PARAMS((lt_dlcaller_id key, + lt_dlhandle handle, + lt_ptr data)) SCM_UNUSED; +SCMLTXT lt_ptr lt_dlcaller_get_data LT_PARAMS((lt_dlcaller_id key, + lt_dlhandle handle)) SCM_UNUSED; + + + +/* --- USER MODULE LOADER API --- */ + + +typedef struct lt_dlloader lt_dlloader; +typedef lt_ptr lt_user_data; +typedef lt_ptr lt_module; + +/* Function pointer types for creating user defined module loaders. */ +typedef lt_module lt_module_open LT_PARAMS((lt_user_data loader_data, + const char *filename)); +typedef int lt_module_close LT_PARAMS((lt_user_data loader_data, + lt_module handle)); +typedef lt_ptr lt_find_sym LT_PARAMS((lt_user_data loader_data, + lt_module handle, + const char *symbol)); +typedef int lt_dlloader_exit LT_PARAMS((lt_user_data loader_data)); + +struct lt_user_dlloader { + const char *sym_prefix; + lt_module_open *module_open; + lt_module_close *module_close; + lt_find_sym *find_sym; + lt_dlloader_exit *dlloader_exit; + lt_user_data dlloader_data; +}; + +SCMLTXT lt_dlloader *lt_dlloader_next LT_PARAMS((lt_dlloader *place)); +SCMLTXT lt_dlloader *lt_dlloader_find LT_PARAMS(( + const char *loader_name)); +SCMLTXT const char *lt_dlloader_name LT_PARAMS((lt_dlloader *place)) SCM_UNUSED; +SCMLTXT lt_user_data *lt_dlloader_data LT_PARAMS((lt_dlloader *place)) SCM_UNUSED; +SCMLTXT int lt_dlloader_add LT_PARAMS((lt_dlloader *place, + const struct lt_user_dlloader *dlloader, + const char *loader_name)); +SCMLTXT int lt_dlloader_remove LT_PARAMS(( + const char *loader_name)) SCM_UNUSED; + + + +/* --- ERROR MESSAGE HANDLING --- */ + + +/* Defining error strings alongside their symbolic names in a macro in + this way allows us to expand the macro in different contexts with + confidence that the enumeration of symbolic names will map correctly + onto the table of error strings. */ +#define lt_dlerror_table \ + LT_ERROR(UNKNOWN, "unknown error") \ + LT_ERROR(DLOPEN_NOT_SUPPORTED, "dlopen support not available") \ + LT_ERROR(INVALID_LOADER, "invalid loader") \ + LT_ERROR(INIT_LOADER, "loader initialization failed") \ + LT_ERROR(REMOVE_LOADER, "loader removal failed") \ + LT_ERROR(FILE_NOT_FOUND, "file not found") \ + LT_ERROR(DEPLIB_NOT_FOUND, "dependency library not found") \ + LT_ERROR(NO_SYMBOLS, "no symbols defined") \ + LT_ERROR(CANNOT_OPEN, "can't open the module") \ + LT_ERROR(CANNOT_CLOSE, "can't close the module") \ + LT_ERROR(SYMBOL_NOT_FOUND, "symbol not found") \ + LT_ERROR(NO_MEMORY, "not enough memory") \ + LT_ERROR(INVALID_HANDLE, "invalid module handle") \ + LT_ERROR(BUFFER_OVERFLOW, "internal buffer overflow") \ + LT_ERROR(INVALID_ERRORCODE, "invalid errorcode") \ + LT_ERROR(SHUTDOWN, "library already shutdown") \ + LT_ERROR(CLOSE_RESIDENT_MODULE, "can't close resident module") \ + LT_ERROR(INVALID_MUTEX_ARGS, "invalid mutex handler registration") \ + LT_ERROR(INVALID_POSITION, "invalid search path insert position") + +/* Enumerate the symbolic error names. */ +enum { +#define LT_ERROR(name, diagnostic) LT_CONC(LT_ERROR_, name), + lt_dlerror_table +#undef LT_ERROR + + LT_ERROR_MAX +}; + +/* These functions are only useful from inside custom module loaders. */ +SCMLTXT int lt_dladderror LT_PARAMS((const char *diagnostic)) SCM_UNUSED; +SCMLTXT int lt_dlseterror LT_PARAMS((int errorcode)) SCM_UNUSED; + + + +LT_END_C_DECLS + +#endif /* !LTDL_H */ From aa5af3d1be28fbfc763af4a2c2695d9b326d196e Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:54:50 +0000 Subject: [PATCH 225/306] * ChangeLog: moved from ../libltdl. --- libguile-ltdl/ChangeLog | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/libguile-ltdl/ChangeLog b/libguile-ltdl/ChangeLog index 137ecd2b4..22de280c4 100644 --- a/libguile-ltdl/ChangeLog +++ b/libguile-ltdl/ChangeLog @@ -1,15 +1,5 @@ 2002-10-04 Rob Browning - * raw-ltdl.h: guile's modified version of the upstream ltdl.h. - - * raw-ltdl.c: guile's modified version of the upstream ltdl.c. - - * guile-ltdl.h: main header file for guile's internal - libguile-ltdl. - - * guile-ltdl.c: main source file for libguile-ltdl -- #includes - raw-ltdl.c and raw-ldtl.h directly. See README. - * COPYING.LIB: moved from ../libltdl. * ChangeLog: moved from ../libltdl. @@ -24,19 +14,26 @@ * upstream/ltdl.h: upstream source. - * raw-ltdl.c: Remove custom realloc. (#define rpl_realloc - realloc). You can't define realloc like this unless you also - define malloc. This is a quick hack for now; we may want - something cleaner later. + * guile-ltdl.h: main header file for guile's internal + libguile-ltdl. + + * guile-ltdl.c: main source file for libguile-ltdl -- #includes + raw-ltdl.c and raw-ldtl.h directly. See README. + + * raw-ltdl.h: guile's modified version of the upstream ltdl.h. + + * raw-ltdl.c: guile's modified version of the upstream ltdl.c. (memcpy): coerce ptrs to (char *) before copying characters through them -- I can't recall for sure, but I believe this was causing an overrun error at times. - (realloc): commented out -- as mentioned above, you can't define + (realloc): Remove custom realloc. (#define rpl_realloc realloc) + and comment out later code for custom realloc. You can't define your own malloc unless you know enough about the malloc in use to be able to tell how big the src ptr is. The disabled code incorrectly used the *destination* ptr to decide how much to copy. This sometimes results in out-of-bound accesses which cause - segfaults. + segfaults. This is a quick hack for now; we may want something + cleaner later. (tryall_dlopen_module): check to be sure (dirname_len > 0) before testing first character against '/'. (try_dlopen): check for feof(file) in read loop -- otherwise From 45cf70fa41fe7cd3f1922394f0485e460a5393d4 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:55:16 +0000 Subject: [PATCH 226/306] * Makefile.am (libguile_la_LIBADD): switch to use libguile-ltdl.la. --- libguile/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 87694b67b..47c3a4cb3 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -26,7 +26,7 @@ DEFS = @DEFS@ ## Check for headers in $(srcdir)/.., so that #include ## will find MUMBLE.h in this dir when we're ## building. -INCLUDES = -I.. -I$(srcdir)/.. ${INCLTDL} +INCLUDES = -I.. -I$(top_srcdir) -I$(top_srcdir)/libguile-ltdl ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \ --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/' @@ -135,7 +135,7 @@ noinst_HEADERS = coop-threads.c coop-threads.h coop.c \ private-gc.h libguile_la_DEPENDENCIES = @LIBLOBJS@ -libguile_la_LIBADD = @LIBLOBJS@ $(LIBLTDL) $(THREAD_LIBS_LOCAL) +libguile_la_LIBADD = @LIBLOBJS@ ../libguile-ltdl/libguile-ltdl.la $(THREAD_LIBS_LOCAL) libguile_la_LDFLAGS = -version-info @LIBGUILE_INTERFACE_CURRENT@:@LIBGUILE_INTERFACE_REVISION@:@LIBGUILE_INTERFACE_AGE@ -export-dynamic -no-undefined # These are headers visible as From 66d4f5ccaab3289b299544d19f47db49335f69d4 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:55:22 +0000 Subject: [PATCH 227/306] * dynl.c (sysdep_dynl_link): switch to scm_lt_dlhandle, scm_lt_dlopenext, and scm_lt_dlerror. (sysdep_dynl_unlink): switch to scm_lt_dlhandle, scm_lt_dlclose, and scm_lt_dlerror. (sysdep_dynl_func): switch to scm_lt_dlhandle, scm_lt_dlsym, and scm_lt_dlerror. (sysdep_dynl_init): switch to scm_lt_dlinit(); --- libguile/dynl.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/libguile/dynl.c b/libguile/dynl.c index b567796bc..4d38d4055 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -75,7 +75,7 @@ maybe_drag_in_eprintf () #include "libguile/lang.h" #include "libguile/validate.h" -#include "libltdl/ltdl.h" +#include "guile-ltdl.h" /* From the libtool manual: "Note that libltdl is not threadsafe, @@ -90,7 +90,7 @@ maybe_drag_in_eprintf () static void * sysdep_dynl_link (const char *fname, const char *subr) { - lt_dlhandle handle; + scm_lt_dlhandle handle; handle = scm_lt_dlopenext (fname); if (NULL == handle) { @@ -107,7 +107,7 @@ sysdep_dynl_link (const char *fname, const char *subr) static void sysdep_dynl_unlink (void *handle, const char *subr) { - if (scm_lt_dlclose ((lt_dlhandle) handle)) + if (scm_lt_dlclose ((scm_lt_dlhandle) handle)) { scm_misc_error (subr, (char *) scm_lt_dlerror (), SCM_EOL); } @@ -118,7 +118,7 @@ sysdep_dynl_func (const char *symb, void *handle, const char *subr) { void *fptr; - fptr = scm_lt_dlsym ((lt_dlhandle) handle, symb); + fptr = scm_lt_dlsym ((scm_lt_dlhandle) handle, symb); if (!fptr) { scm_misc_error (subr, (char *) scm_lt_dlerror (), SCM_EOL); From 823b49519f6ec2305994ae2e6eb77ad5bf934a70 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:55:28 +0000 Subject: [PATCH 228/306] * guile.c (main): switch to scm_lt_dlset_preloaded_symbols; --- libguile/guile.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/guile.c b/libguile/guile.c index ae17a9606..b96262008 100644 --- a/libguile/guile.c +++ b/libguile/guile.c @@ -55,7 +55,7 @@ #include #endif #ifdef DYNAMIC_LINKING -#include +#include #endif #ifdef HAVE_WINSOCK2_H @@ -89,7 +89,7 @@ int main (int argc, char **argv) { #if defined (DYNAMIC_LINKING) && !defined (__MINGW32__) - LTDL_SET_PRELOADED_SYMBOLS (); + scm_lt_dlset_preloaded_symbols (); #endif scm_boot_guile (argc, argv, inner_main, 0); return 0; /* never reached */ From 1360a142dedf9618b2a187a6c5a2fedbc2e8ecdd Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:55:43 +0000 Subject: [PATCH 229/306] *** empty log message *** --- .cvsignore | 2 ++ ChangeLog | 19 +++++++++++++++++++ libguile/ChangeLog | 13 +++++++++++++ 3 files changed, 34 insertions(+) diff --git a/.cvsignore b/.cvsignore index 7e0793c94..779ced18e 100644 --- a/.cvsignore +++ b/.cvsignore @@ -1,7 +1,9 @@ +BUGS Makefile Makefile.in aclocal.m4 autom4te.cache +benchmark-guile check-guile check-guile.log config.build-subdirs diff --git a/ChangeLog b/ChangeLog index f93272162..b1117d482 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,22 @@ +2002-10-04 Rob Browning + + * libltdl: moved to libguile-ltdl. + + * Makefile.am (SUBDIRS): remove libltdl. + + * autogen.sh: remove support for libltdl sub-configure. + (ac_version): widen support check to any 2.5? autoconf version. + 2.54 is out now. + + * configure.in: turn on -Werror by default. We're now clean. I'd + like to stay that way. If we want, we can turn it off by default + when we make the stable release, but I caught a lot of bugs this + way. Accomodate libguile-ltdl -- therea are some ltdl things that + are commented out now INCLTDL and LIBLTDL. I think we may not + need them anymore, but I'll leave them until we're sure. We also + killed off the libltdl dir and related options including the + AC_CONFIG_SUBDIRS. + 2002-10-04 Marius Vollmer * configure.in: Use AC_LIBLTDL_CONVENIENCE instead of diff --git a/libguile/ChangeLog b/libguile/ChangeLog index af28abc96..105e6b336 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,18 @@ 2002-10-04 Rob Browning + * guile.c (main): switch to scm_lt_dlset_preloaded_symbols; + + * dynl.c (sysdep_dynl_link): switch to scm_lt_dlhandle, + scm_lt_dlopenext, and scm_lt_dlerror. + (sysdep_dynl_unlink): switch to scm_lt_dlhandle, scm_lt_dlclose, + and scm_lt_dlerror. + (sysdep_dynl_func): switch to scm_lt_dlhandle, scm_lt_dlsym, + and scm_lt_dlerror. + (sysdep_dynl_init): switch to scm_lt_dlinit(); + + * Makefile.am (libguile_la_LIBADD): switch to use + libguile-ltdl.la. + * numbers.c (s_scm_integer_expt): (expt 0 1) should be 1. 2002-10-04 Marius Vollmer From 1c09a4c30ff9f5d00a89a63d3645c1d98929ef7f Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:55:51 +0000 Subject: [PATCH 230/306] * Makefile.am (SUBDIRS): remove libltdl. --- Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.am b/Makefile.am index d40a4b2e8..9e6c2fe26 100644 --- a/Makefile.am +++ b/Makefile.am @@ -21,7 +21,7 @@ AUTOMAKE_OPTIONS = 1.5 -SUBDIRS = oop qt libltdl libguile ice-9 guile-config guile-readline \ +SUBDIRS = oop qt libguile-ltdl libguile ice-9 guile-config guile-readline \ scripts srfi doc examples test-suite benchmark-suite lang am bin_SCRIPTS = guile-tools From 39eef5091d22dab77b928cc9a05928e369a98916 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:55:57 +0000 Subject: [PATCH 231/306] * autogen.sh: remove support for libltdl sub-configure. (ac_version): widen support check to any 2.5? autoconf version. 2.54 is out now. --- autogen.sh | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/autogen.sh b/autogen.sh index c4924e6d8..a99f69987 100755 --- a/autogen.sh +++ b/autogen.sh @@ -48,16 +48,23 @@ libtoolize --force --copy --automake ###################################################################### +ac_version=`autoconf --version | head -1` +ac_version=`echo ${ac_version} | sed -e 's/autoconf.* \([0-9].[0-9]\+\)$/\1/'` +case "${ac_version}" in + (2.5?) autoconf=autoconf ;; +esac # configure.in reqs autoconf-2.53; try to find it -for suf in "-2.53" "2.53" "" false; do - version=`autoconf$suf --version 2>/dev/null | head -1 | awk '{print $NF}' | awk -F. '{print $1 * 100 + $2}'` - if test "0$version" -eq 253; then - autoconf=autoconf$suf - autoheader=autoheader$suf - break - fi -done +if test -z "$autoconf"; then + for suf in "-2.53" "2.53" "" false; do + version=`autoconf$suf --version 2>/dev/null | head -1 | awk '{print $NF}' | awk -F. '{print $1 * 100 + $2}'` + if test "0$version" -eq 253; then + autoconf=autoconf$suf + autoheader=autoheader$suf + break + fi + done +fi if test -z "$autoconf"; then echo "ERROR: Please install autoconf 2.53" @@ -94,13 +101,6 @@ $autoconf $automake --add-missing $automake --add-missing -# Make sure that libltdl uses the same autoconf version as the rest. -# -echo "libltdl..." -(cd libltdl && aclocal) -(cd libltdl && autoconf) -(cd libltdl && $automake --gnu --add-missing) - echo "guile-readline..." (cd guile-readline && ./autogen.sh) From bdcccc1806105a5556cb13a0dd92db7a2de1a070 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 04:57:09 +0000 Subject: [PATCH 232/306] * configure.in: turn on -Werror by default. We're now clean. I'd like to stay that way. If we want, we can turn it off by default when we make the stable release, but I caught a lot of bugs this way. Accomodate libguile-ltdl -- therea are some ltdl things that are commented out now INCLTDL and LIBLTDL. I think we may not need them anymore, but I'll leave them until we're sure. We also killed off the libltdl dir and related options including the AC_CONFIG_SUBDIRS. I also added some explicit tests for some headers and functions that weren't listed but were in scmconfig.h.in. though this may have been unnecessary. --- configure.in | 47 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 32 insertions(+), 15 deletions(-) diff --git a/configure.in b/configure.in index 1ac6d2c82..e55b02a58 100644 --- a/configure.in +++ b/configure.in @@ -43,15 +43,16 @@ AC_CONFIG_SUBDIRS(guile-readline) # #-------------------------------------------------------------------- +GUILE_ERROR_ON_WARNING="yes" + AC_ARG_ENABLE(error-on-warning, [ --enable-error-on-warning treat compile warnings as errors], [case "${enableval}" in - yes | y) CFLAGS="${CFLAGS} -Werror"; enable_compile_warnings=no ;; - no | n) ;; + yes | y) GUILE_ERROR_ON_WARNING="yes" ;; + no | n) GUILE_ERROR_ON_WARNING="no" ;; *) AC_MSG_ERROR(bad value ${enableval} for --enable-error-on-warning) ;; esac]) - AC_ARG_ENABLE(debug-freelist, [ --enable-debug-freelist include garbage collector freelist debugging code], if test "$enable_debug_freelist" = y || test "$enable_debug_freelist" = yes; then @@ -150,13 +151,10 @@ AC_CYGWIN AC_MINGW32 AC_LIBTOOL_WIN32_DLL -AC_LIBLTDL_CONVENIENCE -AC_CONFIG_SUBDIRS(libltdl) - AC_PROG_INSTALL AC_PROG_CC AC_PROG_CPP -AC_LIBTOOL_DLOPEN +AC_PROG_AWK AC_AIX AC_ISC_POSIX @@ -164,9 +162,9 @@ AC_MINIX AM_PROG_CC_STDC -## Needed for building DLLs on Cygwin, before AM_PROG_LIBTOOL -AC_LIBTOOL_WIN32_DLL +AC_LIBTOOL_DLOPEN AM_PROG_LIBTOOL +AC_LIB_LTDL AC_CHECK_PROG(have_makeinfo, makeinfo, yes, no) AM_CONDITIONAL(HAVE_MAKEINFO, test "$have_makeinfo" = yes) @@ -264,7 +262,13 @@ AC_HEADER_STDC AC_HEADER_DIRENT AC_HEADER_TIME AC_HEADER_SYS_WAIT -AC_CHECK_HEADERS(io.h libc.h limits.h malloc.h memory.h string.h regex.h rxposix.h rx/rxposix.h sys/ioctl.h sys/select.h sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h direct.h) + +AC_CHECK_HEADERS([io.h libc.h limits.h malloc.h memory.h string.h \ +regex.h rxposix.h rx/rxposix.h sys/dir.h sys/ioctl.h sys/select.h \ +sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \ +sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \ +direct.h]) + GUILE_HEADER_LIBC_WITH_UNISTD AC_TYPE_GETGROUPS @@ -306,11 +310,15 @@ if test "$MINGW32" = "yes" ; then fi AC_SUBST(EXTRA_DEFS) -AC_SUBST(INCLTDL) -AC_SUBST(LIBLTDL) +# FIXME: check to see if we still need these. +#AC_SUBST(INCLTDL) +#AC_SUBST(LIBLTDL) + AC_SUBST(DLPREOPEN) -AC_CHECK_FUNCS(ctermid ftime fchown getcwd geteuid gettimeofday lstat mkdir mknod nice readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt strftime strptime symlink sync tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer) +AC_CHECK_HEADERS([assert.h]) + +AC_CHECK_FUNCS([ctermid ftime fchown getcwd geteuid gettimeofday lstat mkdir mknod nice readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt strftime strptime symlink sync tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex]) AC_CHECK_HEADERS(crypt.h sys/resource.h sys/file.h) AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname) @@ -739,6 +747,15 @@ if test "$cross_compiling" = "yes"; then fi AC_SUBST(GUILE_FOR_BUILD) +# Do this here so we don't screw up any of the tests above that might +# not be "warning free" + +if test "${GUILE_ERROR_ON_WARNING}" = yes +then + CFLAGS="${CFLAGS} -Werror" + enable_compile_warnings=no +fi + ## If we're using GCC, ask for aggressive warnings. case "$GCC" in yes ) @@ -750,8 +767,6 @@ case "$GCC" in CFLAGS="$CFLAGS -Wall -Wmissing-prototypes" ;; esac -AC_PROG_AWK - ## NOTE the code below sets LIBOBJS directly and so is now forbidden ## -- I'm disabling it for now in the hopes that the newer autoconf ## will DTRT -- if not, we need to fix up the sed command to match the @@ -824,6 +839,8 @@ AC_CONFIG_FILES([ libguile/guile-func-name-check libguile/guile-snarf-docs libguile/version.h + libguile-ltdl/Makefile + libguile-ltdl/upstream/Makefile ice-9/Makefile lang/Makefile lang/elisp/Makefile From 47f2f62523e026710fbc5889947d05b829a62619 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 5 Oct 2002 11:52:07 +0000 Subject: [PATCH 233/306] Make sure that $autoheader is always set. When we would use the plain "autoconf", $autoheader would end up empty and libguile/scmconfig.h.in would not be updated. --- autogen.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/autogen.sh b/autogen.sh index a99f69987..00252629b 100755 --- a/autogen.sh +++ b/autogen.sh @@ -51,7 +51,7 @@ libtoolize --force --copy --automake ac_version=`autoconf --version | head -1` ac_version=`echo ${ac_version} | sed -e 's/autoconf.* \([0-9].[0-9]\+\)$/\1/'` case "${ac_version}" in - (2.5?) autoconf=autoconf ;; + (2.5?) autoconf=autoconf; autoheader=autoheader ;; esac # configure.in reqs autoconf-2.53; try to find it @@ -75,7 +75,7 @@ fi #detect automake version -# configure.in reqs autoconf-2.53; try to find it +# configure.in reqs automake-1.6; try to find it for suf in "-1.6" "1.6" "" false; do version=`automake$suf --version 2>/dev/null | head -1 | awk '{print $NF}' | awk -F. '{print $1 * 10 + $2}'` if test "0$version" -eq 16; then From d2d414843b344b6b6beb158d5676650b6fc66d23 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 5 Oct 2002 11:55:56 +0000 Subject: [PATCH 234/306] (ltdl.h.diff, ltdl.c.diff): Create them in '.' not in 'upstream' since we are already in upstream. --- libguile-ltdl/upstream/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile-ltdl/upstream/Makefile.am b/libguile-ltdl/upstream/Makefile.am index 1a0a7e2be..4fb36282d 100644 --- a/libguile-ltdl/upstream/Makefile.am +++ b/libguile-ltdl/upstream/Makefile.am @@ -42,7 +42,7 @@ ltdl.h.diff: ltdl.h ../raw-ltdl.h -e 's/ SCM_UNUSED//go;' \ raw-ltdl.guilemod.h.tmp mv raw-ltdl.guilemod.h.tmp raw-ltdl.guilemod.h - diff -ru upstream/ltdl.h raw-ltdl.guilemod.h > upstream/ltdl.h.diff; \ + diff -ru ltdl.h raw-ltdl.guilemod.h > ltdl.h.diff; \ test "$$?" -eq 1 ltdl.c.diff: ltdl.c ../raw-ltdl.c @@ -53,7 +53,7 @@ ltdl.c.diff: ltdl.c ../raw-ltdl.c -e 's/ SCM_UNUSED//go;' \ raw-ltdl.guilemod.c.tmp mv raw-ltdl.guilemod.c.tmp raw-ltdl.guilemod.c - diff -ru upstream/ltdl.c raw-ltdl.guilemod.c > upstream/ltdl.c.diff; \ + diff -ru ltdl.c raw-ltdl.guilemod.c > ltdl.c.diff; \ test "$$?" -eq 1 CLEANFILES := \ From f4e093308a9e84c7f2352df6bda98040e6762b04 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 5 Oct 2002 11:57:35 +0000 Subject: [PATCH 235/306] (end-multiline): Use '*function-name*' instead of nonexisting 'name'. --- scripts/snarf-check-and-output-texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/snarf-check-and-output-texi b/scripts/snarf-check-and-output-texi index d669cab86..a74eee08c 100755 --- a/scripts/snarf-check-and-output-texi +++ b/scripts/snarf-check-and-output-texi @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; snarf-check-and-output-texi --- called by the doc snarfer. -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -154,7 +154,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (if (and (not (eqv? *snarf-type* 'register)) (not (= (length *args*) all))) (error (format #f "~A:~A: ~A's C implementation takes ~A args (should take ~A)" - *file* *line* name (length *args*) all))) + *file* *line* *function-name* (length *args*) all))) (let ((nice-sig (if (eq? *snarf-type* 'register) *function-name* From 5e405a6055fdd097d765d126f2a90e0a80adade2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 5 Oct 2002 11:57:41 +0000 Subject: [PATCH 236/306] *** empty log message *** --- ChangeLog | 6 ++++++ NEWS | 23 +++++++++++++++++++++++ libguile-ltdl/ChangeLog | 5 +++++ scripts/ChangeLog | 5 +++++ 4 files changed, 39 insertions(+) diff --git a/ChangeLog b/ChangeLog index b1117d482..53dd837cf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2002-10-05 Marius Vollmer + + * autogen.sh: Make sure that $autoheader is always set. When we + would use the plain "autoconf", $autoheader would end up empty and + libguile/scmconfig.h.in would not be updated. + 2002-10-04 Rob Browning * libltdl: moved to libguile-ltdl. diff --git a/NEWS b/NEWS index e1f4454c1..ac8394ef7 100644 --- a/NEWS +++ b/NEWS @@ -27,6 +27,29 @@ debugging evaluator gives better error messages. * Changes to Scheme functions and syntax +** New functions 'all-threads' and 'current-thread'. + +** Signals and system asyncs work better with threads. + +The function 'sigaction' now takes a fourth, optional, argument that +specifies the thread that the handler should run in. When the +argument is omitted, the handler will run in the thread that called +'sigaction'. + +Likewise, 'system-async-mark' takes a second, optional, argument that +specifies the thread that the async should run in. When it is +omitted, the async will run in the thread that called +'system-async-mark'. + +C code can use the new functions scm_sigaction_for_thread and +scm_system_async_mark_for_thread to pass the new thread argument. + +** The function 'system-async' is deprecated. + +You can now pass any zero-argument procedure to 'system-async-mark'. +The function 'system-async' will just return its argument unchanged +now. + ** New function 'unsetenv'. ** New macro 'define-syntax-public'. diff --git a/libguile-ltdl/ChangeLog b/libguile-ltdl/ChangeLog index 22de280c4..e7178e386 100644 --- a/libguile-ltdl/ChangeLog +++ b/libguile-ltdl/ChangeLog @@ -1,3 +1,8 @@ +2002-10-05 Marius Vollmer + + * upstream/Makefile.am (ltdl.h.diff, ltdl.c.diff): Create them in + '.' not in 'upstream' since we are already in upstream. + 2002-10-04 Rob Browning * COPYING.LIB: moved from ../libltdl. diff --git a/scripts/ChangeLog b/scripts/ChangeLog index 6efb5a853..83e877702 100644 --- a/scripts/ChangeLog +++ b/scripts/ChangeLog @@ -1,3 +1,8 @@ +2002-10-05 Marius Vollmer + + * snarf-check-and-output-texi (end-multiline): Use '*function-name*' + instead of nonexisting 'name'. + 2002-10-04 Rob Browning * summarize-guile-TODO (as-leaf): make #\: a char-set. From f6b44bd99f1d4ae963dfb3aaa66a30e9c1574924 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 5 Oct 2002 13:06:58 +0000 Subject: [PATCH 237/306] * async.c (scm_async_click): Set the cdr of a executed handler cell to SCM_BOOL_F, not SCM_EOL. (scm_i_queue_async_cell): Queue the cell at the end of the list, and only if the handler procedure is not already present. (scm_system_async_mark_for_thread): Initialize cdr of handler cell with SCM_BOOL_F. * scmsigs.c (scm_sigaction_for_thread): Likewise. --- libguile/async.c | 23 ++++++++++++++++++----- libguile/scmsigs.c | 2 +- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/libguile/async.c b/libguile/async.c index 53edabda2..06fe0b75b 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -179,7 +179,7 @@ scm_async_click () do { SCM c = SCM_CDR (asyncs); - SCM_SETCDR (asyncs, SCM_EOL); + SCM_SETCDR (asyncs, SCM_BOOL_F); scm_call_0 (SCM_CAR (asyncs)); asyncs = c; } @@ -204,10 +204,23 @@ SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0, void scm_i_queue_async_cell (SCM c, scm_root_state *root) { - if (SCM_CDR (c) == SCM_EOL) + if (SCM_CDR (c) == SCM_BOOL_F) { - SCM_SETCDR (c, root->active_asyncs); - root->active_asyncs = c; + SCM p = root->active_asyncs; + SCM_SETCDR (c, SCM_EOL); + if (p == SCM_EOL) + root->active_asyncs = c; + else + { + SCM pp; + while ((pp = SCM_CDR(p)) != SCM_EOL) + { + if (SCM_CAR (p) == SCM_CAR (c)) + return; + p = pp; + } + SCM_SETCDR (p, c); + } } } @@ -218,7 +231,7 @@ SCM_DEFINE (scm_system_async_mark_for_thread, "system-async-mark", 1, 1, 0, "use the current thread.") #define FUNC_NAME s_scm_system_async_mark_for_thread { - scm_i_queue_async_cell (scm_cons (proc, SCM_EOL), + scm_i_queue_async_cell (scm_cons (proc, SCM_BOOL_F), (SCM_UNBNDP (thread) ? scm_root : scm_i_thread_root (thread))); diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index c77fad0a9..ec1926eba 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -276,7 +276,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, handler = close_1 (handler, signum); SCM_VECTOR_SET (*signal_handlers, csig, handler); SCM_VECTOR_SET (signal_handler_cells, csig, - scm_cons (handler, SCM_EOL)); + scm_cons (handler, SCM_BOOL_F)); SCM_VECTOR_SET (signal_handler_threads, csig, thread); } From a7d3641dc2dddba08b2e53bec396071c176d5a58 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 5 Oct 2002 13:07:06 +0000 Subject: [PATCH 238/306] (root_mark): Mark active_asyncs slot. --- libguile/root.c | 1 + 1 file changed, 1 insertion(+) diff --git a/libguile/root.c b/libguile/root.c index 6f7d20297..93405f8a2 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -80,6 +80,7 @@ root_mark (SCM root) scm_gc_mark (s->cur_errp); /* No need to gc mark def_loadp */ scm_gc_mark (s->fluids); + scm_gc_mark (s->active_asyncs); return SCM_ROOT_STATE (root) -> parent; } From 9310d6f29e0fbff786f76fa80ea8a91b17c51b3d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 5 Oct 2002 13:07:28 +0000 Subject: [PATCH 239/306] *** empty log message *** --- libguile/ChangeLog | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 105e6b336..264bfed5f 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,15 @@ +2002-10-05 Marius Vollmer + + * root.c (root_mark): Mark active_asyncs slot. + + * async.c (scm_async_click): Set the cdr of a executed handler + cell to SCM_BOOL_F, not SCM_EOL. + (scm_i_queue_async_cell): Queue the cell at the end of the list, + and only if the handler procedure is not already present. + (scm_system_async_mark_for_thread): Initialize cdr of handler cell + with SCM_BOOL_F. + * scmsigs.c (scm_sigaction_for_thread): Likewise. + 2002-10-04 Rob Browning * guile.c (main): switch to scm_lt_dlset_preloaded_symbols; From 60aa332f83f373ec128d54e01ce89b68e86a5014 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Sat, 5 Oct 2002 20:34:24 +0000 Subject: [PATCH 240/306] *** empty log message *** --- ChangeLog | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 53dd837cf..a3e8c32e2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -21,7 +21,9 @@ are commented out now INCLTDL and LIBLTDL. I think we may not need them anymore, but I'll leave them until we're sure. We also killed off the libltdl dir and related options including the - AC_CONFIG_SUBDIRS. + AC_CONFIG_SUBDIRS. I also added some explicit tests for some + headers and functions that weren't listed but were in + scmconfig.h.in. though this may have been unnecessary. 2002-10-04 Marius Vollmer From b6506f45202f7e6baf584440d75ada581c050afc Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 7 Oct 2002 16:34:28 +0000 Subject: [PATCH 241/306] * scheme-scheduling.texi (Asyncs): Updated. * posix.texi (sigaction): Updated. --- doc/ref/posix.texi | 27 +++++--- doc/ref/scheme-scheduling.texi | 119 +++++++++++++++++++-------------- 2 files changed, 84 insertions(+), 62 deletions(-) diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 776f2485e..f372c6e48 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -1443,7 +1443,7 @@ or user, as indicated by @var{which} and @var{who}. @var{which} is one of the variables @code{PRIO_PROCESS}, @code{PRIO_PGRP} or @code{PRIO_USER}, and @var{who} is interpreted relative to @var{which} (a process identifier for @code{PRIO_PROCESS}, -process group identifier for @code{PRIO_PGRP}, and a user +hhhhprocess group identifier for @code{PRIO_PGRP}, and a user identifier for @code{PRIO_USER}. A zero value of @var{who} denotes the current process, process group, or user. @var{prio} is a value in the range -20 and 20, the default @@ -1510,29 +1510,34 @@ Sends a specified signal @var{sig} to the current process, where @var{sig} is as described for the kill procedure. @end deffn -@deffn {Scheme Procedure} sigaction signum [handler [flags]] +@deffn {Scheme Procedure} sigaction signum [handler [flags [thread]]] @deffnx {C Function} scm_sigaction (signum, handler, flags) +@deffnx {C Function} scm_sigaction_for_thread (signum, handler, flags, thread) Install or report the signal handler for a specified signal. @var{signum} is the signal number, which can be specified using the value of variables such as @code{SIGINT}. -If @var{action} is omitted, @code{sigaction} returns a pair: the +If @var{handler} is omitted, @code{sigaction} returns a pair: the CAR is the current signal hander, which will be either an integer with the value @code{SIG_DFL} (default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which handles the signal, or @code{#f} if a non-Scheme procedure handles the signal. The CDR contains the current @code{sigaction} flags for the handler. -If @var{action} is provided, it is installed as the new handler for -@var{signum}. @var{action} can be a Scheme procedure taking one -argument, or the value of @code{SIG_DFL} (default action) or +If @var{handler} is provided, it is installed as the new handler for +@var{signum}. The parameter @var{handler} can be a Scheme procedure +taking one argument, or the value of @code{SIG_DFL} (default action) or @code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler -was installed before @code{sigaction} was first used. Flags can -optionally be specified for the new handler (@code{SA_RESTART} will -always be added if it's available and the system is using restartable -system calls.) The return value is a pair with information about the -old handler as described above. +was installed before @code{sigaction} was first used. When a scheme +procedure has been specified, that procedure will run in the given +@var{thread}. When no thread has been given, the thread that made this +call to @code{sigaction} is used. + +Flags can optionally be specified for the new handler (@code{SA_RESTART} +will always be added if it's available and the system is using +restartable system calls.) The return value is a pair with information +about the old handler as described above. This interface does not provide access to the "signal blocking" facility. Maybe this is not needed, since the thread support may diff --git a/doc/ref/scheme-scheduling.texi b/doc/ref/scheme-scheduling.texi index ea060177a..01e35c1bb 100644 --- a/doc/ref/scheme-scheduling.texi +++ b/doc/ref/scheme-scheduling.texi @@ -7,11 +7,11 @@ plus the Cygnus programmer's manual; it should be *very* carefully reviewed and largely reorganized.] @menu -* Arbiters:: Synchronization primitives. -* Asyncs:: Asynchronous procedure invocation. -* Dynamic Roots:: Root frames of execution. -* Threads:: Multiple threads of execution. -* Fluids:: Thread-local variables. +* Arbiters:: Synchronization primitives. +* Asyncs:: Asynchronous procedure invocation. +* Dynamic Roots:: Root frames of execution. +* Threads:: Multiple threads of execution. +* Fluids:: Thread-local variables. @end menu @@ -54,54 +54,40 @@ arbiter was locked. Otherwise, return @code{#f}. @section Asyncs @cindex asyncs +@cindex user asyncs @cindex system asyncs @c FIXME::martin: Review me! -An async is a pair of one thunk (a parameterless procedure) and a mark. -Setting the mark on an async guarantees that the thunk will be executed -somewhen in the future (@dfn{asynchronously}). Setting the mark more -than once is satisfied by one execution of the thunk. +Asyncs are a means of deferring the excution of Scheme code until it is +safe to do so. -Guile supports two types of asyncs: Normal asyncs and system asyncs. -They differ in that marked system asyncs are executed implicitly as soon -as possible, whereas normal asyncs have to be invoked explicitly. -System asyncs are held in an internal data structure and are maintained -by Guile. +Guile provides two kinds of asyncs that share the basic concept but are +otherwise quite different: system asyncs and user asyncs. System asyncs +are integrated into the core of Guile and are executed automatically +when the system is in a state to allow the execution of Scheme code. +For example, it is not possible to execute Scheme code in a POSIX signal +handler, but such a signal handler can queue a system async to be +executed in the near future, when it is safe to do so. -Normal asyncs are created with @code{async}, system asyncs with -@code{system-async}. They are marked with @code{async-mark} or -@code{system-async-mark}, respectively. +System asyncs can also be queued for threads other than the current one. +This way, you can cause threads to asynchronously execute arbitrary +code. -@deffn {Scheme Procedure} async thunk -@deffnx {C Function} scm_async (thunk) -Create a new async for the procedure @var{thunk}. -@end deffn +User asyncs offer a convenient means of queueing procedures for future +execution and triggering this execution. They will not be executed +automatically. -@deffn {Scheme Procedure} system-async thunk -@deffnx {C Function} scm_system_async (thunk) -Create a new async for the procedure @var{thunk}. Also -add it to the system's list of active async objects. -@end deffn +@menu +* System asyncs:: +* User asyncs:: +@end menu -@deffn {Scheme Procedure} async-mark a -@deffnx {C Function} scm_async_mark (a) -Mark the async @var{a} for future execution. -@end deffn +@node System asyncs +@subsection System asyncs -@deffn {Scheme Procedure} system-async-mark a -@deffnx {C Function} scm_system_async_mark (a) -Mark the async @var{a} for future execution. -@end deffn - -As already mentioned above, system asyncs are executed automatically. -Normal asyncs have to be explicitly invoked by storing one or more of -them into a list and passing them to @code{run-asyncs}. - -@deffn {Scheme Procedure} run-asyncs list_of_a -@deffnx {C Function} scm_run_asyncs (list_of_a) -Execute all thunks from the asyncs of the list @var{list_of_a}. -@end deffn +To cause the future asynchronous execution of a procedure in a given +thread, use @code{system-async-mark}. Automatic invocation of system asyncs can be temporarily disabled by calling @code{mask-signals} and @code{unmask-signals}. Setting the mark @@ -110,6 +96,20 @@ run once execution is enabled again. Please note that calls to these procedures should always be paired, and they must not be nested, e.g. no @code{mask-signals} is allowed if another one is still active. +@deffn {Scheme procedure} system-async-mark proc [thread] +@deffnx {C Function} scm_system_async_mark (proc) +@deffnx {C Function} scm_system_async_mark_for_thread (proc, thread) +Mark @var{proc} (a procedure with zero arguments) for future execution +in @var{thread}. When @var{proc} has already been marked for +@var{thread} but has not been executed yet, this call has no effect. +When @var{thread} is omitted, the thread that called +@code{system-async-mark} is used. + +This procedure is not safe to be called from signal handlers. Use +@code{scm_sigaction} or @code{scm_sigaction_for_thread} to install +signal handlers. +@end deffn + @deffn {Scheme Procedure} mask-signals @deffnx {C Function} scm_mask_signals () Mask signals. The returned value is not specified. @@ -120,13 +120,30 @@ Mask signals. The returned value is not specified. Unmask signals. The returned value is not specified. @end deffn -@c FIXME::martin: Find an example for usage of `noop'. What is that -@c procedure for anyway? +@node User asyncs +@subsection User asyncs -@deffn {Scheme Procedure} noop . args -@deffnx {C Function} scm_noop (args) -Do nothing. When called without arguments, return @code{#f}, -otherwise return the first argument. +A user async is a pair of a thunk (a parameterless procedure) and a +mark. Setting the mark on a user async will cause the thunk to be +executed when the user async is passed to @code{run-asyncs}. Setting +the mark more than once is satisfied by one execution of the thunk. + +User asyncs are created with @code{async}. They are marked with +@code{async-mark}. + +@deffn {Scheme Procedure} async thunk +@deffnx {C Function} scm_async (thunk) +Create a new user async for the procedure @var{thunk}. +@end deffn + +@deffn {Scheme Procedure} async-mark a +@deffnx {C Function} scm_async_mark (a) +Mark the user async @var{a} for future execution. +@end deffn + +@deffn {Scheme Procedure} run-asyncs list_of_a +@deffnx {C Function} scm_run_asyncs (list_of_a) +Execute all thunks from the marked asyncs of the list @var{list_of_a}. @end deffn @@ -259,8 +276,8 @@ When using Guile threads, keep in mind that each guile thread is executed in a new dynamic root. @menu -* Low level thread primitives:: -* Higher level thread procedures:: +* Low level thread primitives:: +* Higher level thread procedures:: @end menu From 66894177486be0ac1f5fdff6f6cff92b1c1e3a51 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 7 Oct 2002 16:38:04 +0000 Subject: [PATCH 242/306] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index bdeafd188..455386db6 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-10-07 Marius Vollmer + + * scheme-scheduling.texi (Asyncs): Updated. + * posix.texi (sigaction): Updated. + 2002-10-03 Neil Jerram * posix.texi (Processes), scheme-options.texi (Common Feature From 34010f56945e872f003a3702df1c347320eeeb4e Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 9 Oct 2002 19:07:23 +0000 Subject: [PATCH 243/306] Extend soft ports to use input-waiting thunks. --- ice-9/ChangeLog | 5 +++++ ice-9/buffered-input.scm | 7 ++++++- libguile/ChangeLog | 6 ++++++ libguile/vports.c | 28 ++++++++++++++++++++++++++-- 4 files changed, 43 insertions(+), 3 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index badbb5337..ef37fda7e 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2002-10-09 Neil Jerram + + * buffered-input.scm (make-buffered-input-port): Build an + input-waiting thunk for just extended version of make-soft-port. + 2002-10-04 Rob Browning * boot-9.scm (expt): switch if sense and use negative? rather than diff --git a/ice-9/buffered-input.scm b/ice-9/buffered-input.scm index 1cfc2ea76..19182d199 100644 --- a/ice-9/buffered-input.scm +++ b/ice-9/buffered-input.scm @@ -105,8 +105,13 @@ with @var{continuation?} set to @code{#t}." (if (not (char-whitespace? res)) (set! (buffered-input-continuation? port) #t)) res))))) + (input-waiting + (lambda () + (if (eof-object? read-string) + 1 + (- (string-length read-string) string-index)))) (port #f)) - (set! port (make-soft-port (vector #f #f #f get-character #f) "r")) + (set! port (make-soft-port (vector #f #f #f get-character #f input-waiting) "r")) (set! (buffered-input-continuation? port) #f) port))) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 264bfed5f..794115fb9 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-10-09 Neil Jerram + + * vports.c (scm_make_soft_port): Allow vector argument to carry a + 6th element: an input waiting thunk. + (sf_input_waiting): New. + 2002-10-05 Marius Vollmer * root.c (root_mark): Mark active_asyncs slot. diff --git a/libguile/vports.c b/libguile/vports.c index 94e44976c..53f37ac91 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -139,12 +139,28 @@ sf_close (SCM port) } +static int +sf_input_waiting (SCM port) +{ + SCM p = SCM_PACK (SCM_STREAM (port)); + if (SCM_VECTOR_LENGTH (p) >= 6) + { + SCM f = SCM_VELTS (p)[5]; + if (SCM_NFALSEP (f)) + return SCM_INUM (scm_call_0 (f)); + } + /* Default is such that char-ready? for soft ports returns #t, as it + did before this extension was implemented. */ + return 1; +} + + SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, (SCM pv, SCM modes), "Return a port capable of receiving or delivering characters as\n" "specified by the @var{modes} string (@pxref{File Ports,\n" - "open-file}). @var{pv} must be a vector of length 5. Its\n" + "open-file}). @var{pv} must be a vector of length 5 or 6. Its\n" "components are as follows:\n" "\n" "@enumerate 0\n" @@ -158,6 +174,9 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, "thunk for getting one character\n" "@item\n" "thunk for closing port (not by garbage collection)\n" + "@item\n" + "(if present and not @code{#f}) thunk for computing the number of\n" + "characters that can be read from the port without blocking.\n" "@end enumerate\n" "\n" "For an output-only port only elements 0, 1, 2, and 4 need be\n" @@ -185,9 +204,13 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_make_soft_port { + int vlen; scm_t_port *pt; SCM z; - SCM_VALIDATE_VECTOR_LEN (1, pv,5); + + SCM_VALIDATE_VECTOR (1, pv); + vlen = SCM_VECTOR_LENGTH (pv); + SCM_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME); SCM_VALIDATE_STRING (2, modes); SCM_DEFER_INTS; @@ -211,6 +234,7 @@ scm_make_sfptob () scm_set_port_mark (tc, scm_markstream); scm_set_port_flush (tc, sf_flush); scm_set_port_close (tc, sf_close); + scm_set_port_input_waiting (tc, sf_input_waiting); return tc; } From 9768e0a96e8513dd8a9b59d25e43bbcb2909a5a2 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 9 Oct 2002 19:34:55 +0000 Subject: [PATCH 244/306] Use scm_num2int rather than SCM_INUM in soft port extension. --- libguile/vports.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/vports.c b/libguile/vports.c index 53f37ac91..be1fa2c52 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -147,7 +147,7 @@ sf_input_waiting (SCM port) { SCM f = SCM_VELTS (p)[5]; if (SCM_NFALSEP (f)) - return SCM_INUM (scm_call_0 (f)); + return scm_num2int (scm_call_0 (f), SCM_ARGn, NULL); } /* Default is such that char-ready? for soft ports returns #t, as it did before this extension was implemented. */ From c9cfbf5beb48315e69a051349cb6bfe7deb9ebfe Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Wed, 9 Oct 2002 21:15:59 +0000 Subject: [PATCH 245/306] * guile.c (main): change to call scm_lt_dlpreload_default and pass in lt_preloaded_symbols, a value libtool automagically adds to the binary. --- libguile/guile.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libguile/guile.c b/libguile/guile.c index b96262008..6f00fee74 100644 --- a/libguile/guile.c +++ b/libguile/guile.c @@ -89,7 +89,9 @@ int main (int argc, char **argv) { #if defined (DYNAMIC_LINKING) && !defined (__MINGW32__) - scm_lt_dlset_preloaded_symbols (); + /* libtool automagically inserts this variable into your executable... */ + extern const scm_lt_dlsymlist lt_preloaded_symbols[]; + scm_lt_dlpreload_default (lt_preloaded_symbols); #endif scm_boot_guile (argc, argv, inner_main, 0); return 0; /* never reached */ From 76cf0fbd0a76415d4c3b3baa1ac0cf2f6776dcf4 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Wed, 9 Oct 2002 21:16:05 +0000 Subject: [PATCH 246/306] *** empty log message *** --- libguile-ltdl/ChangeLog | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/libguile-ltdl/ChangeLog b/libguile-ltdl/ChangeLog index e7178e386..d7d7b93bc 100644 --- a/libguile-ltdl/ChangeLog +++ b/libguile-ltdl/ChangeLog @@ -1,3 +1,26 @@ +2002-10-09 Rob Browning + + * upstream/Makefile.am (ltdl.h.diff): remove + SCM_INSERTED_DLSYMLIST_STRUCT_DECL during diff computation. + (ltdl.c.diff): remove SCM_INSERTED_DLSYMLIST_STRUCT_DECL during + diff computation. + + * raw-ltdl.h: add SCM_INSERTED_DLSYMLIST_STRUCT_DECL so we can + insert our own struct name here. + + * guile-ltdl.h: add scm_lt_dlsymlist typedef. + (scm_lt_dlpreload_default): new function. Replaces + scm_lt_dlset_preloaded_symbols which depended on global that + libtool automagically defines in binaries, not libs. + + * guile-ltdl.c (scm_lt_dlpreload_default): new function. Replaces + scm_lt_dlset_preloaded_symbols which depended on global that + libtool automagically defines in binaries, not libs. Now the call + in guile.c has to pass us that magic value. + (SCM_INSERTED_DLSYMLIST_STRUCT_DECL): used to add a struct name in + the lt_dlsymlist typedef -- we use such a crazy name so we can + remove this in the upstream diff computation. + 2002-10-05 Marius Vollmer * upstream/Makefile.am (ltdl.h.diff, ltdl.c.diff): Create them in From 8b1da91cd5570a44763651c589944575264d9030 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Wed, 9 Oct 2002 21:16:12 +0000 Subject: [PATCH 247/306] * guile-ltdl.c (scm_lt_dlpreload_default): new function. Replaces scm_lt_dlset_preloaded_symbols which depended on global that libtool automagically defines in binaries, not libs. Now the call in guile.c has to pass us that magic value. (SCM_INSERTED_DLSYMLIST_STRUCT_DECL): used to add a struct name in the lt_dlsymlist typedef -- we use such a crazy name so we can remove this in the upstream diff computation. --- libguile-ltdl/guile-ltdl.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libguile-ltdl/guile-ltdl.c b/libguile-ltdl/guile-ltdl.c index 709aea452..f858770e9 100644 --- a/libguile-ltdl/guile-ltdl.c +++ b/libguile-ltdl/guile-ltdl.c @@ -28,6 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA #include "guile-ltdl.h" #define lt_dlhandle_struct scm_i_lt_dlhandle_struct +#define SCM_INSERTED_DLSYMLIST_STRUCT_DECL scm_i_lt_dlsymlist_struct #define LT_SCOPE static #define SCMLTXT static @@ -43,10 +44,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA #include "raw-ltdl.c" void -scm_lt_dlset_preloaded_symbols (void) +scm_lt_dlpreload_default (const scm_lt_dlsymlist *preloads) { - extern const lt_dlsymlist lt_preloaded_symbols[]; - lt_dlpreload_default(lt_preloaded_symbols); + lt_dlpreload_default(preloads); } int From a798ac8c4268fca0ec43539692006e6f355e5fa5 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Wed, 9 Oct 2002 21:16:18 +0000 Subject: [PATCH 248/306] * guile-ltdl.h: add scm_lt_dlsymlist typedef. (scm_lt_dlpreload_default): new function. Replaces scm_lt_dlset_preloaded_symbols which depended on global that libtool automagically defines in binaries, not libs. --- libguile-ltdl/guile-ltdl.h | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libguile-ltdl/guile-ltdl.h b/libguile-ltdl/guile-ltdl.h index 65b820f5a..2f957d5e7 100644 --- a/libguile-ltdl/guile-ltdl.h +++ b/libguile-ltdl/guile-ltdl.h @@ -27,9 +27,10 @@ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA #define SCM_LTDL_H 1 typedef struct scm_i_lt_dlhandle_struct *scm_lt_dlhandle; +typedef struct scm_i_lt_dlsymlist_struct scm_lt_dlsymlist; typedef void * scm_lt_ptr; -void scm_lt_dlset_preloaded_symbols (void); +void scm_lt_dlpreload_default (const scm_lt_dlsymlist *preloads); int scm_lt_dlinit (void); scm_lt_dlhandle scm_lt_dlopenext (const char *filename); scm_lt_ptr scm_lt_dlsym (scm_lt_dlhandle handle, const char *name); From c11a6400fa1e263ba4967af371f5f0e32efee5d8 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Wed, 9 Oct 2002 21:16:24 +0000 Subject: [PATCH 249/306] * raw-ltdl.h: add SCM_INSERTED_DLSYMLIST_STRUCT_DECL so we can insert our own struct name here. --- libguile-ltdl/raw-ltdl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile-ltdl/raw-ltdl.h b/libguile-ltdl/raw-ltdl.h index 89b5af34d..632168bdb 100644 --- a/libguile-ltdl/raw-ltdl.h +++ b/libguile-ltdl/raw-ltdl.h @@ -211,7 +211,7 @@ LT_SCOPE void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)); /* A preopened symbol. Arrays of this type comprise the exported symbols for a dlpreopened module. */ -typedef struct { +typedef struct SCM_INSERTED_DLSYMLIST_STRUCT_DECL { const char *name; lt_ptr address; } lt_dlsymlist; From 6ea383bbe8d4c03298711dceca4349e1bf426473 Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Wed, 9 Oct 2002 21:16:31 +0000 Subject: [PATCH 250/306] * upstream/Makefile.am (ltdl.h.diff): remove SCM_INSERTED_DLSYMLIST_STRUCT_DECL during diff computation. (ltdl.c.diff): remove SCM_INSERTED_DLSYMLIST_STRUCT_DECL during diff computation. --- libguile-ltdl/upstream/Makefile.am | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libguile-ltdl/upstream/Makefile.am b/libguile-ltdl/upstream/Makefile.am index 4fb36282d..175b60397 100644 --- a/libguile-ltdl/upstream/Makefile.am +++ b/libguile-ltdl/upstream/Makefile.am @@ -40,6 +40,7 @@ ltdl.h.diff: ltdl.h ../raw-ltdl.h -e 's/SCMLTXT/extern/go;' \ -e 's/SCMLTSTATIC //go;' \ -e 's/ SCM_UNUSED//go;' \ + -e 's/SCM_INSERTED_DLSYMLIST_STRUCT_DECL //go;' \ raw-ltdl.guilemod.h.tmp mv raw-ltdl.guilemod.h.tmp raw-ltdl.guilemod.h diff -ru ltdl.h raw-ltdl.guilemod.h > ltdl.h.diff; \ @@ -51,6 +52,7 @@ ltdl.c.diff: ltdl.c ../raw-ltdl.c -e 's/SCMLTXT/extern/go;' \ -e 's/SCMLTSTATIC //go;' \ -e 's/ SCM_UNUSED//go;' \ + -e 's/SCM_INSERTED_DLSYMLIST_STRUCT_DECL //go;' \ raw-ltdl.guilemod.c.tmp mv raw-ltdl.guilemod.c.tmp raw-ltdl.guilemod.c diff -ru ltdl.c raw-ltdl.guilemod.c > ltdl.c.diff; \ From aae9a22bfbe11981c1d406f3c268c323b5e9078f Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Wed, 9 Oct 2002 21:56:00 +0000 Subject: [PATCH 251/306] * Makefile.am (srfiinclude_HEADERS, srfiincludedir): install the srfi headers into guile/srfi/. --- srfi/Makefile.am | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/srfi/Makefile.am b/srfi/Makefile.am index b46d2acbb..5ec635701 100644 --- a/srfi/Makefile.am +++ b/srfi/Makefile.am @@ -28,18 +28,21 @@ DEFS = @DEFS@ @EXTRA_DEFS@ ## building. INCLUDES = -I.. -I$(srcdir)/.. +srfiincludedir = $(pkgincludedir)/srfi + +# These headers are visible as +srfiinclude_HEADERS = srfi-4.h srfi-13.h srfi-14.h lib_LTLIBRARIES = libguile-srfi-srfi-13-14.la libguile-srfi-srfi-4.la BUILT_SOURCES = srfi-13.x srfi-14.x srfi-4.x -libguile_srfi_srfi_4_la_SOURCES = srfi-4.x srfi-4.c srfi-4.h +libguile_srfi_srfi_4_la_SOURCES = srfi-4.x srfi-4.c libguile_srfi_srfi_4_la_LIBADD = ../libguile/libguile.la libguile_srfi_srfi_4_la_LDFLAGS = -export-dynamic \ -version-info @LIBGUILE_SRFI_SRFI_4_INTERFACE@ -libguile_srfi_srfi_13_14_la_SOURCES = srfi-13.x srfi-13.c srfi-14.x srfi-14.c\ - srfi-13.h srfi-14.h +libguile_srfi_srfi_13_14_la_SOURCES = srfi-13.x srfi-13.c srfi-14.x srfi-14.c libguile_srfi_srfi_13_14_la_LIBADD = ../libguile/libguile.la libguile_srfi_srfi_13_14_la_LDFLAGS = -export-dynamic \ -version-info @LIBGUILE_SRFI_SRFI_13_14_INTERFACE@ From de46f022e4a130c7b4d95ef1f8f3bae9b1c760a6 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 9 Oct 2002 22:26:37 +0000 Subject: [PATCH 252/306] (scm_compile_shell_switches): Do not set scm_mask_ints. Asyncs are enabled by default. --- libguile/script.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/libguile/script.c b/libguile/script.c index f3d89dc3e..f94de47e2 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -641,8 +641,6 @@ scm_compile_shell_switches (int argc, char **argv) quit. */ tail = scm_cons (scm_cons (sym_quit, SCM_EOL), tail); - /* Allow asyncs (signal handlers etc.) to be run. */ - scm_mask_ints = 0; } /* After the following line, actions will be added to the front. */ From 8ee25fb9f8ee291af6a1f0e49308bbc7d12e2e31 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 9 Oct 2002 22:37:29 +0000 Subject: [PATCH 253/306] * root.h (scm_root_state): Added 'block_async' slot. (scm_active_asyncs): Removed abbrev. * root.c (scm_make_root): Initialize 'block_asyncs' slot. --- libguile/root.c | 1 + libguile/root.h | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/libguile/root.c b/libguile/root.c index 93405f8a2..3017a16c0 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -131,6 +131,7 @@ scm_make_root (SCM parent) } root_state->active_asyncs = SCM_EOL; + root_state->block_asyncs = 0; SCM_REDEFER_INTS; SCM_NEWSMOB (root, scm_tc16_root, root_state); diff --git a/libguile/root.h b/libguile/root.h index f332d0054..6d7658d9e 100644 --- a/libguile/root.h +++ b/libguile/root.h @@ -109,6 +109,8 @@ typedef struct scm_root_state SCM active_asyncs; /* The thunks to be run at the next safe point */ + unsigned int block_asyncs; /* Non-zero means that asyncs should + not be run. */ } scm_root_state; #define scm_stack_base (scm_root->stack_base) @@ -126,7 +128,6 @@ typedef struct scm_root_state #define scm_cur_outp (scm_root->cur_outp) #define scm_cur_errp (scm_root->cur_errp) #define scm_cur_loadp (scm_root->cur_loadp) -#define scm_active_asyncs (scm_root->active_asyncs) #ifdef USE_THREADS #define scm_root ((scm_root_state *) SCM_THREAD_LOCAL_DATA) From e292f7aac8b8d7fb3659afb84f6af0c0798f0ec7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 9 Oct 2002 22:44:02 +0000 Subject: [PATCH 254/306] * async.h (scm_call_with_blocked_asyncs, scm_call_with_unblocked_asyncs, scm_c_call_with_blocked_asyncs, scm_c_call_with_unblocked_asyncs): New prototypes. (scm_mask_signals, scm_unmask_signals): Deprecated. (scm_mask_ints): Turned into a macro. * async.c (scm_mask_ints): Removed. (scm_run_asyncs): Do not set scm_mask_ints while running an async. this should not be necessary. (scm_async_click): Test block_asyncs instead of scm_mask_ints. (scm_mask_signals, scm_unmask_signals): Deprecated. Emit deprecation warning and check for errornous use. Set block_asyncs instead of scm_mask_ints. (increase_block, decrease_block, scm_call_with_blocked_asyncs, scm_call_with_unblocked_asyncs, scm_c_call_with_blocked_asyncs, scm_c_call_with_unblocked_asyncs): New. --- libguile/async.c | 101 +++++++++++++++++++++++++++++++++++++++++------ libguile/async.h | 13 +++++- 2 files changed, 100 insertions(+), 14 deletions(-) diff --git a/libguile/async.c b/libguile/async.c index 06fe0b75b..994a8ef04 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -49,6 +49,7 @@ #include "libguile/root.h" #include "libguile/smob.h" #include "libguile/lang.h" +#include "libguile/dynwind.h" #include "libguile/deprecation.h" #include "libguile/validate.h" @@ -61,6 +62,10 @@ #include #endif +/* This is not used for anything except checking that DEFER_INTS and + ALLOW_INTS are used properly. + */ +int scm_ints_disabled = 1; /* {Asynchronous Events} @@ -91,11 +96,6 @@ * implement yourself. */ -/* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and - * when the interpreter is not running at all. - */ -int scm_ints_disabled = 1; -unsigned int scm_mask_ints = 1; @@ -149,13 +149,11 @@ SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, SCM_VALIDATE_CONS (1, list_of_a); a = SCM_CAR (list_of_a); VALIDATE_ASYNC (SCM_ARG1, a); - scm_mask_ints = 1; if (ASYNC_GOT_IT (a)) { SET_ASYNC_GOT_IT (a, 0); scm_call_0 (ASYNC_THUNK (a)); } - scm_mask_ints = 0; list_of_a = SCM_CDR (list_of_a); } return SCM_BOOL_T; @@ -171,11 +169,11 @@ scm_async_click () { SCM asyncs; - if (!scm_mask_ints) + if (scm_root->block_asyncs == 0) { - while (!SCM_NULLP(asyncs = scm_active_asyncs)) + while (!SCM_NULLP(asyncs = scm_root->active_asyncs)) { - scm_active_asyncs = SCM_EOL; + scm_root->active_asyncs = SCM_EOL; do { SCM c = SCM_CDR (asyncs); @@ -264,12 +262,20 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1, +#if (SCM_DEBUG_DEPRECATED == 0) + SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0, (), "Unmask signals. The returned value is not specified.") #define FUNC_NAME s_scm_unmask_signals { - scm_mask_ints = 0; + scm_c_issue_deprecation_warning + ("'unmask-signals' is deprecated. " + "Use 'call-with-blocked-asyncs' instead."); + + if (scm_root->block_asyncs == 0) + SCM_MISC_ERROR ("signals already unmasked", SCM_EOL); + scm_root->block_asyncs = 0; return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -280,11 +286,82 @@ SCM_DEFINE (scm_mask_signals, "mask-signals", 0, 0, 0, "Mask signals. The returned value is not specified.") #define FUNC_NAME s_scm_mask_signals { - scm_mask_ints = 1; + scm_c_issue_deprecation_warning + ("'mask-signals' is deprecated. Use 'call-with-blocked-asyncs' instead."); + + if (scm_root->block_asyncs > 0) + SCM_MISC_ERROR ("signals already masked", SCM_EOL); + scm_root->block_asyncs = 1; return SCM_UNSPECIFIED; } #undef FUNC_NAME +#endif /* SCM_DEBUG_DEPRECATED == 0 */ + +static void +increase_block (void *unused) +{ + scm_root->block_asyncs++; +} + +static void +decrease_block (void *unused) +{ + scm_root->block_asyncs--; +} + +SCM_DEFINE (scm_call_with_blocked_asyncs, "call-with-blocked-asyncs", 1, 0, 0, + (SCM proc), + "Call @var{proc} with no arguments and block the execution\n" + "of system asyncs by one level for the current thread while\n" + "it is running. Return the value returned by @var{proc}.\n") +#define FUNC_NAME s_scm_call_with_blocked_asyncs +{ + return scm_internal_dynamic_wind (increase_block, + (scm_t_inner) scm_call_0, + decrease_block, + proc, NULL); +} +#undef FUNC_NAME + +void * +scm_c_call_with_blocked_asyncs (void *(*proc) (void *data), void *data) +{ + return scm_internal_dynamic_wind (increase_block, + (scm_t_inner) proc, + decrease_block, + data, NULL); +} + + +SCM_DEFINE (scm_call_with_unblocked_asyncs, "call-with-unblocked-asyncs", 1, 0, 0, + (SCM proc), + "Call @var{proc} with no arguments and unblock the execution\n" + "of system asyncs by one level for the current thread while\n" + "it is running. Return the value returned by @var{proc}.\n") +#define FUNC_NAME s_scm_call_with_unblocked_asyncs +{ + if (scm_root->block_asyncs == 0) + SCM_MISC_ERROR ("asyncs already unblocked", SCM_EOL); + return scm_internal_dynamic_wind (decrease_block, + (scm_t_inner) scm_call_0, + increase_block, + proc, NULL); +} +#undef FUNC_NAME + +void * +scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data) +{ + if (scm_root->block_asyncs == 0) + scm_misc_error ("scm_c_call_with_unblocked_asyncs", + "asyncs already unblocked", SCM_EOL); + return scm_internal_dynamic_wind (decrease_block, + (scm_t_inner) proc, + increase_block, + data, NULL); +} + void diff --git a/libguile/async.h b/libguile/async.h index 64f1945af..a033b4e0d 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -51,7 +51,7 @@ -SCM_API unsigned int scm_mask_ints; +#define scm_mask_ints (scm_root->block_asyncs != 0) @@ -65,9 +65,18 @@ SCM_API SCM scm_system_async_mark_for_thread (SCM a, SCM thread); SCM_API void scm_i_queue_async_cell (SCM cell, scm_root_state *); SCM_API SCM scm_run_asyncs (SCM list_of_a); SCM_API SCM scm_noop (SCM args); +SCM_API SCM scm_call_with_blocked_asyncs (SCM proc); +SCM_API SCM scm_call_with_unblocked_asyncs (SCM proc); +void *scm_c_call_with_blocked_asyncs (void *(*p) (void *d), void *d); +void *scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d); +SCM_API void scm_init_async (void); + +#if (SCM_DEBUG_DEPRECATED == 0) + SCM_API SCM scm_unmask_signals (void); SCM_API SCM scm_mask_signals (void); -SCM_API void scm_init_async (void); + +#endif #endif /* SCM_ASYNC_H */ From be2588b87dfd508c44e831d11737cb41a6d6f7a9 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 9 Oct 2002 22:45:07 +0000 Subject: [PATCH 255/306] (SCM_ASYNC_TICK): Do without the scm_active_asyncs abbrev. --- libguile/__scm.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/__scm.h b/libguile/__scm.h index 4539800d2..700ff9d7f 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -408,7 +408,7 @@ typedef long SCM_STACKITEM; #define SCM_ASYNC_TICK /*fixme* should change names */ \ do { \ - if (scm_active_asyncs != SCM_EOL) \ + if (scm_root->active_asyncs != SCM_EOL) \ scm_async_click (); \ } while (0) From bb00edfa92fa043e4ba1e521de1742ae90ad3fcd Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 9 Oct 2002 22:47:34 +0000 Subject: [PATCH 256/306] (top-repl): Use 2 as the limit when saving the stack. (error-catching-loop): use call-with-blocked-asyncs and call-with-unblocked-asyncs instead of mask-signals and unmask-signals. --- ice-9/boot-9.scm | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index c1a03f000..f3d50b744 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2122,8 +2122,7 @@ (lambda () (lazy-catch #t (lambda () - (dynamic-wind - (lambda () (unmask-signals)) + (call-with-unblocked-asyncs (lambda () (with-traps (lambda () @@ -2137,8 +2136,7 @@ (set! first #f) (let loop ((v (thunk))) (loop (thunk))) - #f))) - (lambda () (mask-signals)))) + #f))))) lazy-handler-dispatch)) @@ -2194,7 +2192,8 @@ (#t (error "sorry, not implemented"))))) (set! batch-mode? (lambda () (not interactive))) - (loop (lambda () #t)))) + (call-with-blocked-asyncs + (lambda () (loop (lambda () #t)))))) ;;(define the-last-stack (make-fluid)) Defined by scm_init_backtrace () (define before-signal-stack (make-fluid)) @@ -2872,7 +2871,7 @@ ;; Make a backup copy of the stack (fluid-set! before-signal-stack (fluid-ref the-last-stack)) - (save-stack 1) + (save-stack 2) (scm-error 'signal #f msg From a6c106718330d1b25554a9e99b775e002815e272 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 9 Oct 2002 22:48:30 +0000 Subject: [PATCH 257/306] (System Asyncs): Updated. --- doc/ref/scheme-scheduling.texi | 37 ++++++++++++++++++++++------------ 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/doc/ref/scheme-scheduling.texi b/doc/ref/scheme-scheduling.texi index 01e35c1bb..da5db4e8a 100644 --- a/doc/ref/scheme-scheduling.texi +++ b/doc/ref/scheme-scheduling.texi @@ -57,8 +57,6 @@ arbiter was locked. Otherwise, return @code{#f}. @cindex user asyncs @cindex system asyncs -@c FIXME::martin: Review me! - Asyncs are a means of deferring the excution of Scheme code until it is safe to do so. @@ -90,11 +88,16 @@ To cause the future asynchronous execution of a procedure in a given thread, use @code{system-async-mark}. Automatic invocation of system asyncs can be temporarily disabled by -calling @code{mask-signals} and @code{unmask-signals}. Setting the mark -while async execution is disabled will nevertheless cause the async to -run once execution is enabled again. Please note that calls to these -procedures should always be paired, and they must not be nested, e.g. no -@code{mask-signals} is allowed if another one is still active. +calling @code{call-with-blocked-asyncs}. This function works by +temporarily increasing the @emph{async blocking level} of the current +thread while a given procedure is running. The blocking level starts +out at zero, and whenever a safe point is reached, a blocking level +greater than zero will prevent the execution of queued asyncs. + +Analogously, the procedure @code{call-with-unblocked-asyncs} will +temporarily decrease the blocking level of the current thread. You +can use it when you want to disable asyncs by default and only allow +them temporarily. @deffn {Scheme procedure} system-async-mark proc [thread] @deffnx {C Function} scm_system_async_mark (proc) @@ -110,14 +113,22 @@ This procedure is not safe to be called from signal handlers. Use signal handlers. @end deffn -@deffn {Scheme Procedure} mask-signals -@deffnx {C Function} scm_mask_signals () -Mask signals. The returned value is not specified. +@deffn {Scheme Procedure} call-with-blocked-asyncs proc +@deffnx {C Function} scm_call_with_blocked_asyncs (proc) +@deffnx {C Function} void *scm_c_call_with_blocked_asyncs (void *(*p) (void *d), void *d) +Call @var{proc} and block the execution of system asyncs by one level +for the current thread while it is running. Return the value returned +by @var{proc}. For the first two variants, call @var{proc} with no +arguments; for the third, call it with @var{data}. @end deffn -@deffn {Scheme Procedure} unmask-signals -@deffnx {C Function} scm_unmask_signals () -Unmask signals. The returned value is not specified. +@deffn {Scheme Procedure} call-with-unblocked-asyncs proc +@deffnx {C Function} scm_call_with_unblocked_asyncs (proc) +@deffnx {C Function} void *scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d) +Call @var{proc} and unblock the execution of system asyncs by one +level for the current thread while it is running. Return the value +returned by @var{proc}. For the first two variants, call @var{proc} +with no arguments; for the third, call it with @var{data}. @end deffn @node User asyncs From acfa1f528ec59324ef2079bce5774105ecfd84e7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 9 Oct 2002 22:49:00 +0000 Subject: [PATCH 258/306] *** empty log message *** --- NEWS | 28 ++++++++++++++++++++++++++++ doc/ref/ChangeLog | 4 ++++ ice-9/ChangeLog | 7 +++++++ libguile/ChangeLog | 28 ++++++++++++++++++++++++++++ 4 files changed, 67 insertions(+) diff --git a/NEWS b/NEWS index ac8394ef7..5965d7383 100644 --- a/NEWS +++ b/NEWS @@ -50,6 +50,23 @@ You can now pass any zero-argument procedure to 'system-async-mark'. The function 'system-async' will just return its argument unchanged now. +** New functions 'call-with-blocked-asyncs' and + 'call-with-unblocked-asyncs' + +The expression (call-with-blocked-asyncs PROC) will call PROC and will +block execution of system asyncs for the current thread by one level +while PROC runs. Likewise, call-with-unblocked-asyncs will call a +procedure and will unblock the execution of system asyncs by one +level for the current thread. + +Only system asyncs are affected by these functions. + +** The functions 'mask-signals' and 'unmask-signals' are deprecated. + +Use 'call-with-blocked-asyncs' or 'call-with-unblocked-asyncs' +instead. Those functions are easier to use correctly and can be +nested. + ** New function 'unsetenv'. ** New macro 'define-syntax-public'. @@ -138,6 +155,17 @@ during evaluation, but prior to evaluation. * Changes to the C interface +** The value 'scm_mask_ints' is no longer writable. + +Previously, you could set scm_mask_ints directly. This is no longer +possible. Use scm_c_call_with_blocked_asyncs and +scm_c_call_with_unblocked_asyncs instead. + +** New functions scm_c_call_with_blocked_asyncs and + scm_c_call_with_unblocked_asyncs + +Like scm_call_with_blocked_asyncs etc. but for C functions. + ** New snarfer macro SCM_DEFINE_PUBLIC. This is like SCM_DEFINE, but also calls scm_c_export for the defined diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 455386db6..95d75db5e 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,7 @@ +2002-10-10 Marius Vollmer + + * scheme-scheduling.texi (System Asyncs): Updated. + 2002-10-07 Marius Vollmer * scheme-scheduling.texi (Asyncs): Updated. diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index ef37fda7e..f99793a1a 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,10 @@ +2002-10-10 Marius Vollmer + + * boot-9.scm (top-repl): Use 2 as the limit when saving the stack. + (error-catching-loop): use call-with-blocked-asyncs and + call-with-unblocked-asyncs instead of mask-signals and + unmask-signals. + 2002-10-09 Neil Jerram * buffered-input.scm (make-buffered-input-port): Build an diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 794115fb9..05793eb53 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,31 @@ +2002-10-10 Marius Vollmer + + * root.h (scm_root_state): Added 'block_async' slot. + (scm_active_asyncs): Removed abbrev. + * root.c (scm_make_root): Initialize 'block_asyncs' slot. + + * __scm.h (SCM_ASYNC_TICK): Do without the scm_active_asyncs + abbrev. + + * async.h (scm_call_with_blocked_asyncs, + scm_call_with_unblocked_asyncs, scm_c_call_with_blocked_asyncs, + scm_c_call_with_unblocked_asyncs): New prototypes. + (scm_mask_signals, scm_unmask_signals): Deprecated. + (scm_mask_ints): Turned into a macro. + * async.c (scm_mask_ints): Removed. + (scm_run_asyncs): Do not set scm_mask_ints while running an async. + this should not be necessary. + (scm_async_click): Test block_asyncs instead of scm_mask_ints. + (scm_mask_signals, scm_unmask_signals): Deprecated. Emit + deprecation warning and check for errornous use. Set block_asyncs + instead of scm_mask_ints. + (increase_block, decrease_block, scm_call_with_blocked_asyncs, + scm_call_with_unblocked_asyncs, scm_c_call_with_blocked_asyncs, + scm_c_call_with_unblocked_asyncs): New. + + * script.c (scm_compile_shell_switches): Do not set scm_mask_ints. + Asyncs are enabled by default. + 2002-10-09 Neil Jerram * vports.c (scm_make_soft_port): Allow vector argument to carry a From e581432ec34259d07bdcdd0bde2d94a4e894ca81 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 10 Oct 2002 18:11:06 +0000 Subject: [PATCH 259/306] (scm_sigaction_for_thread): Store original handler in signal_handlers, not the closure that is used as the async. The closure is stored in signal_handler_cells, as previously. --- libguile/scmsigs.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index ec1926eba..766a7b25d 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -273,10 +273,9 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, if (orig_handlers[csig] == SIG_ERR) save_handler = 1; #endif - handler = close_1 (handler, signum); SCM_VECTOR_SET (*signal_handlers, csig, handler); SCM_VECTOR_SET (signal_handler_cells, csig, - scm_cons (handler, SCM_BOOL_F)); + scm_cons (close_1 (handler, signum), SCM_BOOL_F)); SCM_VECTOR_SET (signal_handler_threads, csig, thread); } From 6d16b1257f79d745b5af61c5cb8aff89c4988c26 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 10 Oct 2002 18:11:20 +0000 Subject: [PATCH 260/306] *** empty log message *** --- libguile/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 05793eb53..457478003 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-10-10 Marius Vollmer + + * scmsigs.c (scm_sigaction_for_thread): Store original handler in + signal_handlers, not the closure that is used as the async. + The closure is stored in signal_handler_cells, as previously. + 2002-10-10 Marius Vollmer * root.h (scm_root_state): Added 'block_async' slot. From 4feac0b9045bcc0c6e2348b3de94bacdc7a30293 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 11 Oct 2002 13:02:50 +0000 Subject: [PATCH 261/306] * async.c (s_scm_system_async_mark_for_thread): Only call scm_i_thread_root when USE_THREADS is defined. Use scm_root otherwise. * scmsigs.c (take_signal): Only call scm_i_thread_root when USE_THREADS is defined. Use scm_root otherwise. (scm_sigaction_for_thread): Ignore THREAD argument when USE_THREADS is not defined. Also, move THREAD argument defaulting out of HAVE_SIGACTION section, which was a bug. --- libguile/async.c | 4 ++++ libguile/scmsigs.c | 11 +++++++++++ 2 files changed, 15 insertions(+) diff --git a/libguile/async.c b/libguile/async.c index 994a8ef04..6b133fb68 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -229,10 +229,14 @@ SCM_DEFINE (scm_system_async_mark_for_thread, "system-async-mark", 1, 1, 0, "use the current thread.") #define FUNC_NAME s_scm_system_async_mark_for_thread { +#ifdef USE_THREADS scm_i_queue_async_cell (scm_cons (proc, SCM_BOOL_F), (SCM_UNBNDP (thread) ? scm_root : scm_i_thread_root (thread))); +#else + scm_i_queue_async_cell (scm_cons (proc, SCM_BOOL_F), scm_root); +#endif return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index 766a7b25d..889751d0c 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -129,9 +129,14 @@ take_signal (int signum) { if (signum >= 0 && signum < NSIG) { +#ifdef USE_THREADS SCM thread = SCM_VECTOR_REF (signal_handler_threads, signum); scm_i_queue_async_cell (SCM_VECTOR_REF(signal_handler_cells, signum), scm_i_thread_root (thread)); +#else + scm_i_queue_async_cell (SCM_VECTOR_REF(signal_handler_cells, signum), + scm_root); +#endif } #ifndef HAVE_SIGACTION signal (signum, take_signal); @@ -213,11 +218,17 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, action.sa_flags |= SCM_INUM (flags); } sigemptyset (&action.sa_mask); +#endif + +#ifdef USE_THREAD if (SCM_UNBNDP (thread)) thread = scm_current_thread (); else SCM_VALIDATE_THREAD (4, thread); +#else + thread = SCM_BOOL_F; #endif + SCM_DEFER_INTS; old_handler = SCM_VECTOR_REF(*signal_handlers, csig); if (SCM_UNBNDP (handler)) From 0402b6e86e75a1508a0ad6c607e24d0d9afe53e3 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 11 Oct 2002 13:05:43 +0000 Subject: [PATCH 262/306] (INCLUDES): Also look for includes in "." and "$(srcdir)". This is needed for VPATH builds. (EXTRA_DIST): Also distribute EXTRA_HEADERS. --- libguile-ltdl/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile-ltdl/Makefile.am b/libguile-ltdl/Makefile.am index 6bb4aa20d..46b613568 100644 --- a/libguile-ltdl/Makefile.am +++ b/libguile-ltdl/Makefile.am @@ -28,14 +28,14 @@ DEFS = @DEFS@ ## Check for headers in $(srcdir)/.., so that #include ## will find MUMBLE.h in this dir when we're ## building. -INCLUDES = -I.. -I$(srcdir)/.. +INCLUDES = -I. -I$(srcdir) -I.. -I$(srcdir)/.. ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \ --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/' # We don't install this header since no one should be using the lib directly. EXTRA_HEADERS = guile-ltdl.h raw-ltdl.h -EXTRA_DIST = raw-ltdl.c +EXTRA_DIST = raw-ltdl.c $(EXTRA_HEADERS) lib_LTLIBRARIES = libguile-ltdl.la libguile_ltdl_la_SOURCES = guile-ltdl.c From 7e2e61669b832bde90e746cc17c55e2c70316086 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 11 Oct 2002 13:07:14 +0000 Subject: [PATCH 263/306] * upstream/Makefile.am (ltdl.h.diff, ltdl.c.diff): Look for raw-ltdl.h and raw-ltdl.c in "$(srcdir)/..". This is needed for VPATH builds. --- libguile-ltdl/upstream/Makefile.am | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/libguile-ltdl/upstream/Makefile.am b/libguile-ltdl/upstream/Makefile.am index 175b60397..9f8782e81 100644 --- a/libguile-ltdl/upstream/Makefile.am +++ b/libguile-ltdl/upstream/Makefile.am @@ -34,8 +34,8 @@ ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_L EXTRA_DIST := ltdl.h ltdl.c ltdl.h.diff ltdl.c.diff BUILT_SOURCES := ltdl.h.diff ltdl.c.diff -ltdl.h.diff: ltdl.h ../raw-ltdl.h - cp ../raw-ltdl.h raw-ltdl.guilemod.h.tmp +ltdl.h.diff: ltdl.h $(srcdir)/../raw-ltdl.h + cp $(srcdir)/../raw-ltdl.h raw-ltdl.guilemod.h.tmp perl -pi \ -e 's/SCMLTXT/extern/go;' \ -e 's/SCMLTSTATIC //go;' \ @@ -46,8 +46,8 @@ ltdl.h.diff: ltdl.h ../raw-ltdl.h diff -ru ltdl.h raw-ltdl.guilemod.h > ltdl.h.diff; \ test "$$?" -eq 1 -ltdl.c.diff: ltdl.c ../raw-ltdl.c - cp ../raw-ltdl.c raw-ltdl.guilemod.c.tmp +ltdl.c.diff: ltdl.c $(srcdir)/../raw-ltdl.c + cp $(srcdir)/../raw-ltdl.c raw-ltdl.guilemod.c.tmp perl -pi \ -e 's/SCMLTXT/extern/go;' \ -e 's/SCMLTSTATIC //go;' \ From 41f77ff5056be67a7afefa57fd6295519da4acc4 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 11 Oct 2002 13:07:43 +0000 Subject: [PATCH 264/306] *** empty log message *** --- libguile-ltdl/ChangeLog | 10 ++++++++++ libguile/ChangeLog | 12 ++++++++++++ 2 files changed, 22 insertions(+) diff --git a/libguile-ltdl/ChangeLog b/libguile-ltdl/ChangeLog index d7d7b93bc..8f5081536 100644 --- a/libguile-ltdl/ChangeLog +++ b/libguile-ltdl/ChangeLog @@ -1,3 +1,13 @@ +2002-10-11 Marius Vollmer + + * upstream/Makefile.am (ltdl.h.diff, ltdl.c.diff): Look for + raw-ltdl.h and raw-ltdl.c in "$(srcdir)/..". This is needed for + VPATH builds. + + * Makefile.am (INCLUDES): Also look for includes in "." and + "$(srcdir)". This is needed for VPATH builds. + (EXTRA_DIST): Also distribute EXTRA_HEADERS. + 2002-10-09 Rob Browning * upstream/Makefile.am (ltdl.h.diff): remove diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 457478003..336f51743 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,15 @@ +2002-10-11 Marius Vollmer + + * async.c (s_scm_system_async_mark_for_thread): Only call + scm_i_thread_root when USE_THREADS is defined. Use scm_root + otherwise. + + * scmsigs.c (take_signal): Only call scm_i_thread_root when + USE_THREADS is defined. Use scm_root otherwise. + (scm_sigaction_for_thread): Ignore THREAD argument when + USE_THREADS is not defined. Also, move THREAD argument defaulting + out of HAVE_SIGACTION section, which was a bug. + 2002-10-10 Marius Vollmer * scmsigs.c (scm_sigaction_for_thread): Store original handler in From e71a8bf2efe1f8caa67b4eb605f2c642c36dc849 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sun, 13 Oct 2002 11:02:58 +0000 Subject: [PATCH 265/306] * evalext.h: Replaced SCM_DEBUG_DEPRECATED with !SCM_ENABLE_DEPRECATED. --- libguile/ChangeLog | 5 +++++ libguile/async.h | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 336f51743..18d755c82 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-10-13 Dirk Herrmann + + * evalext.h: Replaced SCM_DEBUG_DEPRECATED with + !SCM_ENABLE_DEPRECATED. + 2002-10-11 Marius Vollmer * async.c (s_scm_system_async_mark_for_thread): Only call diff --git a/libguile/async.h b/libguile/async.h index a033b4e0d..984c04977 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -71,7 +71,7 @@ void *scm_c_call_with_blocked_asyncs (void *(*p) (void *d), void *d); void *scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d); SCM_API void scm_init_async (void); -#if (SCM_DEBUG_DEPRECATED == 0) +#if (SCM_ENABLE_DEPRECATED == 1) SCM_API SCM scm_unmask_signals (void); SCM_API SCM scm_mask_signals (void); From c565712cd0838e216e71ac4972397851c92bdecc Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 13 Oct 2002 18:24:59 +0000 Subject: [PATCH 266/306] (libpath.h): Fixed typo in top_srcdir_absolute substitution. Thanks to David Allouche! --- libguile/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 47c3a4cb3..ee84ce8a1 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -186,7 +186,7 @@ libpath.h: $(srcdir)/Makefile.in $(top_builddir)/config.status @echo '#define SCM_SITE_DIR "$(pkgdatadir)/site"' >> libpath.tmp @echo '#define SCM_BUILD_INFO { \' >> libpath.tmp @echo ' { "srcdir", "'"`cd @srcdir@; pwd`"'" }, \' >> libpath.tmp - @echo ' { "top_srcdir", "top_srcdir_absolute@" }, \' >> libpath.tmp + @echo ' { "top_srcdir", "@top_srcdir_absolute@" }, \' >> libpath.tmp @echo ' { "prefix", "@prefix@" }, \' >> libpath.tmp @echo ' { "exec_prefix", "@exec_prefix@" }, \' >> libpath.tmp @echo ' { "bindir", "@bindir@" }, \' >> libpath.tmp From a90bdb7346dc223ff5eef5bc70da4b889004f892 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 13 Oct 2002 18:25:29 +0000 Subject: [PATCH 267/306] *** empty log message *** --- THANKS | 1 + libguile/ChangeLog | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/THANKS b/THANKS index 72874bb66..7f9c97e69 100644 --- a/THANKS +++ b/THANKS @@ -11,6 +11,7 @@ Sponsors since the last release: For fixes or providing information which led to a fix: + David Allouche Martin Baulig Fabrice Bauzac Rob Browning diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 18d755c82..adde703e3 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-10-13 Marius Vollmer + + * Makefile.am (libpath.h): Fixed typo in top_srcdir_absolute + substitution. Thanks to David Allouche! + 2002-10-13 Dirk Herrmann * evalext.h: Replaced SCM_DEBUG_DEPRECATED with From e5b4630dd365fd4b40f2e66ced9a227eb9373801 Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sun, 13 Oct 2002 22:20:46 +0000 Subject: [PATCH 268/306] * autogen.sh (ac_version): try automake 1.7 too. --- ChangeLog | 4 ++++ autogen.sh | 7 +++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index a3e8c32e2..807c9be1c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2002-10-13 Gary Houston + + * autogen.sh (ac_version): try automake 1.7 too. + 2002-10-05 Marius Vollmer * autogen.sh: Make sure that $autoheader is always set. When we diff --git a/autogen.sh b/autogen.sh index 00252629b..522e9d1c0 100755 --- a/autogen.sh +++ b/autogen.sh @@ -75,10 +75,10 @@ fi #detect automake version -# configure.in reqs automake-1.6; try to find it -for suf in "-1.6" "1.6" "" false; do +# configure.in requires particular automake; try to find it +for suf in "-1.7" "1.7" "-1.6" "1.6" "" false; do version=`automake$suf --version 2>/dev/null | head -1 | awk '{print $NF}' | awk -F. '{print $1 * 10 + $2}'` - if test "0$version" -eq 16; then + if test "0$version" -eq 17 -o "0$version" -eq 16; then automake=automake$suf break fi @@ -89,7 +89,6 @@ if test -z "$automake"; then exit 1 fi - ################################################################ $autoheader $autoconf From 844c219a586835f305ebdcddb306c34dbc4d4b35 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 14 Oct 2002 10:47:48 +0000 Subject: [PATCH 269/306] (build-link): Include "-lguile-ltdl" in link flags. --- guile-config/guile-config.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guile-config/guile-config.in b/guile-config/guile-config.in index ff3f08a7e..c1d60f37f 100644 --- a/guile-config/guile-config.in +++ b/guile-config/guile-config.in @@ -175,10 +175,10 @@ ;; Display the flags, separated by spaces. (if (or (string=? libdir "/usr/lib") (string=? libdir "/usr/lib/")) - (display-separated (cons "-lguile" other-flags)) + (display-separated (cons "-lguile -lguile-ltdl" other-flags)) (display-separated (cons (string-append "-L" (get-build-info 'libdir)) - (cons "-lguile" other-flags)))) + (cons "-lguile -lguile-ltdl" other-flags)))) (newline))) (define (help-link) From 17860e177e71d2b575cd0e29aabfa2a57cd8144e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 14 Oct 2002 10:48:12 +0000 Subject: [PATCH 270/306] *** empty log message *** --- guile-config/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/guile-config/ChangeLog b/guile-config/ChangeLog index d938f4280..c30a8ee94 100644 --- a/guile-config/ChangeLog +++ b/guile-config/ChangeLog @@ -1,3 +1,8 @@ +2002-10-14 Marius Vollmer + + * guile-config.in (build-link): Include "-lguile-ltdl" in link + flags. + 2002-07-17 Marius Vollmer * qthreads.m4: Added configuration for ARM. From cc772cf8ef4e3e77d8e3a109522b790bd407be9c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 14 Oct 2002 21:47:40 +0000 Subject: [PATCH 271/306] (Whirlwind Tour): Added pointer to examples directory. --- doc/ref/intro.texi | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/ref/intro.texi b/doc/ref/intro.texi index f46b7ffb4..4d6109aeb 100644 --- a/doc/ref/intro.texi +++ b/doc/ref/intro.texi @@ -54,7 +54,8 @@ imposed on them. @chapter A Whirlwind Tour This chapter presents a quick tour of all the ways that Guile can be -used. +used. There are additional examples in the @file{examples/} +directory in the Guile source distribution. @menu * Running Guile Interactively:: From e7d58d262ed3d63a7cbaa56484a0a71b36e45285 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 14 Oct 2002 21:47:47 +0000 Subject: [PATCH 272/306] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 95d75db5e..dec70e82e 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-10-14 Marius Vollmer + + * intro.texi (Whirlwind Tour): Added pointer to examples + directory. + 2002-10-10 Marius Vollmer * scheme-scheduling.texi (System Asyncs): Updated. From 53864e11e35f516a7983ca2186732bdc7785722d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 14 Oct 2002 22:54:50 +0000 Subject: [PATCH 273/306] Replaced "$<" in non-pattern rules with its value. This is to support makes that know about "$<" only in pattern rules, like Sun's make. --- libguile/Makefile.am | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libguile/Makefile.am b/libguile/Makefile.am index ee84ce8a1..48ce44bb4 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -41,9 +41,9 @@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c ## For some reason, OBJEXT does not include the dot c-tokenize.$(OBJEXT): c-tokenize.c if [ "$(cross_compiling)" = "yes" ]; then \ - $(CC_FOR_BUILD) -c -o $@ $<; \ + $(CC_FOR_BUILD) -c -o $@ c-tokenize.c; \ else \ - $(COMPILE) -c -o $@ $<; \ + $(COMPILE) -c -o $@ c-tokenize.c; \ fi ## Override default rule; this should run on BUILD host. @@ -247,17 +247,17 @@ if HAVE_MAKEINFO guile-procedures.txt: guile-procedures.texi rm -f $@ - makeinfo --force -o $@ $< || test -f $@ + makeinfo --force -o $@ guile-procedures.texi || test -f $@ else guile-procedures.txt: guile-procedures.texi - cp $< $@ + cp guile-procedures.texi $@ endif c-tokenize.c: c-tokenize.lex - flex -t $< > $@ || { rm $@; false; } + flex -t c-tokenize.lex > $@ || { rm $@; false; } schemelibdir = $(pkgdatadir)/$(VERSION) schemelib_DATA = guile-procedures.txt From ff810d7abe620224f0eec5b179c65d08b42b2432 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 14 Oct 2002 22:55:24 +0000 Subject: [PATCH 274/306] *** empty log message *** --- libguile/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index adde703e3..2a7c292b5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-10-15 Marius Vollmer + + * Makefile.am: Replaced "$<" in non-pattern rules with its value. + This is to support makes that know about "$<" only in pattern + rules, like Sun's make. + 2002-10-13 Marius Vollmer * Makefile.am (libpath.h): Fixed typo in top_srcdir_absolute From 47ac1e47b9a539216e957c440f9f7ac10040a93d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 15 Oct 2002 10:36:42 +0000 Subject: [PATCH 275/306] Update to last change: include $(srcdir)/ in replaced $< constructs. --- libguile/Makefile.am | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 48ce44bb4..9fdbc64c8 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -41,9 +41,9 @@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c ## For some reason, OBJEXT does not include the dot c-tokenize.$(OBJEXT): c-tokenize.c if [ "$(cross_compiling)" = "yes" ]; then \ - $(CC_FOR_BUILD) -c -o $@ c-tokenize.c; \ + $(CC_FOR_BUILD) -c -o $@ $(srcdir)/c-tokenize.c; \ else \ - $(COMPILE) -c -o $@ c-tokenize.c; \ + $(COMPILE) -c -o $@ $(srcdir)/c-tokenize.c; \ fi ## Override default rule; this should run on BUILD host. @@ -247,17 +247,17 @@ if HAVE_MAKEINFO guile-procedures.txt: guile-procedures.texi rm -f $@ - makeinfo --force -o $@ guile-procedures.texi || test -f $@ + makeinfo --force -o $@ $(srcdir)/guile-procedures.texi || test -f $@ else guile-procedures.txt: guile-procedures.texi - cp guile-procedures.texi $@ + cp $(srcdir)/guile-procedures.texi $@ endif c-tokenize.c: c-tokenize.lex - flex -t c-tokenize.lex > $@ || { rm $@; false; } + flex -t $(srcdir)/c-tokenize.lex > $@ || { rm $@; false; } schemelibdir = $(pkgdatadir)/$(VERSION) schemelib_DATA = guile-procedures.txt From f77420343729541d9d959ae887bcf3d5af168d27 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 15 Oct 2002 12:06:14 +0000 Subject: [PATCH 276/306] ... but not for guile-procedures.texi since that is created in the build dir. --- libguile/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 9fdbc64c8..beb73a15d 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -247,12 +247,12 @@ if HAVE_MAKEINFO guile-procedures.txt: guile-procedures.texi rm -f $@ - makeinfo --force -o $@ $(srcdir)/guile-procedures.texi || test -f $@ + makeinfo --force -o $@ guile-procedures.texi || test -f $@ else guile-procedures.txt: guile-procedures.texi - cp $(srcdir)/guile-procedures.texi $@ + cp guile-procedures.texi $@ endif From 3d527b275536d99effe4e25e6f6edabf38c89581 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 15:54:23 +0000 Subject: [PATCH 277/306] New files. --- libguile/null-threads.c | 318 ++++++++++++++++++++++++++++++++++++++++ libguile/null-threads.h | 98 +++++++++++++ 2 files changed, 416 insertions(+) create mode 100644 libguile/null-threads.c create mode 100644 libguile/null-threads.h diff --git a/libguile/null-threads.c b/libguile/null-threads.c new file mode 100644 index 000000000..ac1a135e1 --- /dev/null +++ b/libguile/null-threads.c @@ -0,0 +1,318 @@ +/* Copyright (C) 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + + +#include "libguile/validate.h" +#include "libguile/root.h" +#include "libguile/stackchk.h" +#include "libguile/async.h" +#include "sys/time.h" +#include "sys/types.h" + +void *scm_null_threads_data; + +static SCM main_thread; + +void +scm_threads_init (SCM_STACKITEM *i) +{ + main_thread = scm_permanent_object (scm_cell (scm_tc16_thread, 0)); + scm_null_threads_data = NULL; +} + +#ifdef __ia64__ +# define SCM_MARK_BACKING_STORE() do { \ + ucontext_t ctx; \ + SCM_STACKITEM * top, * bot; \ + getcontext (&ctx); \ + scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \ + ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \ + / sizeof (SCM_STACKITEM))); \ + bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \ + top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \ + scm_mark_locations (bot, top - bot); } while (0) +#else +# define SCM_MARK_BACKING_STORE() +#endif + +void +scm_threads_mark_stacks (void) +{ + /* Mark objects on the C stack. */ + SCM_FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, + ( (size_t) (sizeof (SCM_STACKITEM) - 1 + + sizeof scm_save_regs_gc_mark) + / sizeof (SCM_STACKITEM))); + + { + unsigned long stack_len = scm_stack_size (scm_stack_base); +#ifdef SCM_STACK_GROWS_UP + scm_mark_locations (scm_stack_base, stack_len); +#else + scm_mark_locations (scm_stack_base - stack_len, stack_len); +#endif + } + SCM_MARK_BACKING_STORE(); +} + +SCM +scm_call_with_new_thread (SCM argl) +#define FUNC_NAME s_call_with_new_thread +{ + SCM_MISC_ERROR ("threads are not supported in this version of Guile", + SCM_EOL); + return SCM_BOOL_F; +} +#undef FUNC_NAME + +SCM +scm_spawn_thread (scm_t_catch_body body, void *body_data, + scm_t_catch_handler handler, void *handler_data) +{ + scm_misc_error ("scm_spawn_thread", + "threads are not supported in this version of Guile", + SCM_EOL); + return SCM_BOOL_F; +} + +SCM +scm_current_thread (void) +{ + return main_thread; +} + +SCM +scm_all_threads (void) +{ + return scm_list_1 (main_thread); +} + +scm_root_state * +scm_i_thread_root (SCM thread) +{ + return (scm_root_state *)scm_null_threads_data; +} + +SCM +scm_join_thread (SCM thread) +#define FUNC_NAME s_join_thread +{ + SCM_MISC_ERROR ("threads are not supported in this version of Guile", + SCM_EOL); + return SCM_BOOL_F; +} +#undef FUNC_NAME + +SCM +scm_yield (void) +{ + return SCM_BOOL_T; +} + +/* Block until a new async might have been queued. + */ +static void +block () +{ + select (0, NULL, NULL, NULL, NULL); +} + +int +scm_null_mutex_init (scm_null_mutex *m) +{ + m->locked = 0; + return 0; +} + +int +scm_null_mutex_lock (scm_null_mutex *m) +{ + while (m->locked) + { + block (); + SCM_ASYNC_TICK; + } + m->locked = 1; + return 1; +} + +int +scm_null_mutex_unlock (scm_null_mutex *m) +{ + if (m->locked == 0) + return 0; + m->locked = 0; + return 1; +} + +int +scm_null_mutex_destroy (scm_null_mutex *m) +{ + return 1; +} + +SCM +scm_make_mutex (void) +{ + SCM m = scm_make_smob (scm_tc16_mutex); + scm_null_mutex_init (SCM_MUTEX_DATA(m)); + return m; +} + +SCM +scm_lock_mutex (SCM m) +{ + SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); + scm_null_mutex_lock (SCM_MUTEX_DATA(m)); + return SCM_BOOL_T; +} + +SCM +scm_unlock_mutex (SCM m) +{ + SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); + if (!scm_null_mutex_unlock (SCM_MUTEX_DATA(m))) + scm_misc_error (s_unlock_mutex, "mutex is not locked", SCM_EOL); + return SCM_BOOL_T; +} + +int +scm_null_condvar_init (scm_null_condvar *c) +{ + c->signalled = 0; + return 0; +} + +int +scm_null_condvar_wait (scm_null_condvar *c, scm_null_mutex *m) +{ + scm_null_mutex_unlock (m); + while (!c->signalled) + { + block (); + SCM_ASYNC_TICK; + } + scm_null_mutex_lock (m); + c->signalled = 0; + return 0; +} + +int +scm_null_condvar_signal (scm_null_condvar *c) +{ + c->signalled = 1; + return 0; +} + +int +scm_null_condvar_destroy (scm_null_condvar *c) +{ + return 1; +} + +SCM +scm_make_condition_variable (void) +{ + SCM c = scm_make_smob (scm_tc16_condvar); + scm_null_condvar_init (SCM_CONDVAR_DATA (c)); + return c; +} + +SCM +scm_wait_condition_variable (SCM c, SCM m) +{ + SCM_ASSERT (SCM_CONDVARP (c), + c, + SCM_ARG1, + s_wait_condition_variable); + SCM_ASSERT (SCM_MUTEXP (m), + m, + SCM_ARG2, + s_wait_condition_variable); + scm_null_condvar_wait (SCM_CONDVAR_DATA (c), SCM_MUTEX_DATA (m)); + return SCM_BOOL_T; +} + +SCM +scm_signal_condition_variable (SCM c) +{ + SCM_ASSERT (SCM_CONDVARP (c), + c, + SCM_ARG1, + s_signal_condition_variable); + scm_null_condvar_signal (SCM_CONDVAR_DATA (c)); + return SCM_BOOL_T; +} + +unsigned long +scm_thread_usleep (unsigned long usec) +{ + struct timeval timeout; + timeout.tv_sec = 0; + timeout.tv_usec = usec; + select (0, NULL, NULL, NULL, &timeout); + return 0; /* Maybe we should calculate actual time slept, + but this is faster... :) */ +} + +unsigned long +scm_thread_sleep (unsigned long sec) +{ + time_t now = time (NULL); + struct timeval timeout; + unsigned long slept; + timeout.tv_sec = sec; + timeout.tv_usec = 0; + select (0, NULL, NULL, NULL, &timeout); + slept = time (NULL) - now; + return slept > sec ? 0 : sec - slept; +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/null-threads.h b/libguile/null-threads.h new file mode 100644 index 000000000..92efcad8f --- /dev/null +++ b/libguile/null-threads.h @@ -0,0 +1,98 @@ +/* classes: h_files */ + +#ifndef SCM_NULL_DEFS_H +#define SCM_NULL_DEFS_H + +/* Copyright (C) 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + +/* The null-threads implementation. We provide the standard API, but + no new threads can be created. +*/ + +#define SCM_CRITICAL_SECTION_START +#define SCM_CRITICAL_SECTION_END +#define SCM_THREAD_SWITCHING_CODE + +typedef struct scm_null_mutex { + int locked; +} scm_null_mutex; + +SCM_API int scm_null_mutex_init (scm_null_mutex *); +SCM_API int scm_null_mutex_lock (scm_null_mutex *); +SCM_API int scm_null_mutex_unlock (scm_null_mutex *); +SCM_API int scm_null_mutex_destroy (scm_null_mutex *); + +typedef scm_null_mutex scm_t_mutex; +#define scm_mutex_init scm_null_mutex_init +#define scm_mutex_lock scm_null_mutex_lock +#define scm_mutex_unlock scm_null_mutex_unlock + +typedef struct scm_null_condvar { + int signalled; +} scm_null_condvar; + +SCM_API int scm_null_condvar_init (scm_null_condvar *); +SCM_API int scm_null_condvar_wait (scm_null_condvar *, scm_null_mutex *); +SCM_API int scm_null_condvar_signal (scm_null_condvar *); +SCM_API int scm_null_condvar_destroy (scm_null_condvar *); + +typedef scm_null_condvar scm_t_condvar; +#define scm_cond_init scm_null_condvar_init +#define scm_cond_wait scm_null_condvar_wait +#define scm_cond_signal scm_null_condvar_signal +#define scm_cond_broadcast scm_null_condvar_signal /* yes */ +#define scm_cond_destroy scm_null_condvar_destroy + +SCM_API void *scm_null_threads_data; + +#define SCM_THREAD_LOCAL_DATA (scm_null_threads_data) +#define SCM_SET_THREAD_LOCAL_DATA(ptr) (scm_null_threads_data = (ptr)) + +#endif /* SCM_NULL_DEFS_H */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ From 212d33ec605e6cfe3df7d815e0dd363e5ce17b8d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 15:57:13 +0000 Subject: [PATCH 278/306] * threads.h: Include null-threads.h when !USE_COOP_THREADS. * threads.c: Include null-threads.c when !USE_COOP_THREADS. (scm_init_threads): Use generic type names scm_t_mutex and scm_t_coop instead of coop_m and coop_t. --- libguile/threads.c | 7 +++++-- libguile/threads.h | 2 ++ 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/libguile/threads.c b/libguile/threads.c index e06d7402c..dcd91af05 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -133,6 +133,8 @@ SCM_REGISTER_PROC(s_signal_condition_variable, "signal-condition-variable", 1, 0 #ifdef USE_COOP_THREADS #include "libguile/coop-threads.c" +#else +#include "libguile/null-threads.c" #endif @@ -141,8 +143,9 @@ void scm_init_threads (SCM_STACKITEM *i) { scm_tc16_thread = scm_make_smob_type ("thread", 0); - scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (coop_m)); - scm_tc16_condvar = scm_make_smob_type ("condition-variable", sizeof (coop_c)); + scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_t_mutex)); + scm_tc16_condvar = scm_make_smob_type ("condition-variable", + sizeof (scm_t_condvar)); #include "libguile/threads.x" /* Initialize implementation specific details of the threads support */ diff --git a/libguile/threads.h b/libguile/threads.h index e4106b2b1..c6a6630e6 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -108,6 +108,8 @@ SCM_API scm_root_state *scm_i_thread_root (SCM thread); #ifdef USE_COOP_THREADS #include "libguile/coop-defs.h" +#else +#include "libguile/null-threads.h" #endif #endif /* SCM_THREADS_H */ From f9b52b7aa5759c54e964a4b5fad654e13546d168 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 15:59:37 +0000 Subject: [PATCH 279/306] (noinst_HEADERS): Added null-threads.c. (modinclude_HEADERS): Added null-threads.h. --- libguile/Makefile.am | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/libguile/Makefile.am b/libguile/Makefile.am index beb73a15d..f27df00c4 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -129,9 +129,10 @@ install-exec-hook: ## compile, since they are #included. So instead we list them here. ## Perhaps we can deal with them normally once the merge seems to be ## working. -noinst_HEADERS = coop-threads.c coop-threads.h coop.c \ - num2integral.i.c num2float.i.c convert.i.c \ - win32-uname.h win32-dirent.h win32-socket.h\ +noinst_HEADERS = coop-threads.c coop-threads.h coop.c \ + null-threads.c \ + num2integral.i.c num2float.i.c convert.i.c \ + win32-uname.h win32-dirent.h win32-socket.h \ private-gc.h libguile_la_DEPENDENCIES = @LIBLOBJS@ @@ -144,8 +145,9 @@ pkginclude_HEADERS = gh.h # These are headers visible as . modincludedir = $(includedir)/libguile modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h boolean.h \ - chars.h continuations.h convert.h coop-defs.h debug.h debug-malloc.h \ - deprecation.h dynl.h dynwind.h environments.h eq.h error.h eval.h \ + chars.h continuations.h convert.h coop-defs.h null-threads.h debug.h \ + debug-malloc.h \ + deprecation.h dynl.h dynwind.h environments.h eq.h error.h eval.h \ evalext.h extensions.h feature.h filesys.h fluids.h fports.h gc.h \ gdb_interface.h gdbint.h \ goops.h gsubr.h guardians.h hash.h hashtab.h hooks.h init.h \ From f6ecc207bf59fe12bda68fd9b5256e7142ef3e62 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:01:22 +0000 Subject: [PATCH 280/306] (scm_sigaction_for_thread): It's "USE_THREADS" not "USE_THREAD". --- libguile/scmsigs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index 889751d0c..4e617794d 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -220,7 +220,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, sigemptyset (&action.sa_mask); #endif -#ifdef USE_THREAD +#ifdef USE_THREADS if (SCM_UNBNDP (thread)) thread = scm_current_thread (); else From 389626c5eca87558c4f5fc5f4c1789802f0dd427 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:03:44 +0000 Subject: [PATCH 281/306] (scm_cell, scm_double_cell): Also allow USE_NULL_THREADS to not protect the slot initializers. --- libguile/inline.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libguile/inline.h b/libguile/inline.h index 393182b6a..2fd498c44 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -137,8 +137,8 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) SCM_GC_SET_CELL_WORD (z, 0, car); #ifdef USE_THREADS -#ifndef USE_COOP_THREADS - /* When we are using non-cooperating threads, we might need to make +#if !defined(USE_COOP_THREADS) && !defined(USE_NULL_THREADS) + /* When we are using preemtive threads, we might need to make sure that the initial values for the slots are protected until the cell is completely initialized. */ @@ -188,7 +188,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, SCM_GC_SET_CELL_WORD (z, 0, car); #ifdef USE_THREADS -#ifndef USE_COOP_THREADS +#if !defined(USE_COOP_THREADS) && !defined(USE_NULL_THREADS) /* When we are using non-cooperating threads, we might need to make sure that the initial values for the slots are protected until the cell is completely initialized. From e37d58d53b30a4c84becaef9f3f830f369d53930 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:08:03 +0000 Subject: [PATCH 282/306] (scm_init_feature): Don't add 'threads' for USE_NULL_THREADS. --- libguile/feature.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libguile/feature.c b/libguile/feature.c index 9a9bdc303..55d25f1c6 100644 --- a/libguile/feature.c +++ b/libguile/feature.c @@ -118,7 +118,9 @@ scm_init_feature() scm_add_feature ("full-continuation"); #endif #ifdef USE_THREADS +#ifndef USE_NULL_THREADS scm_add_feature ("threads"); +#endif #endif scm_c_define ("char-code-limit", SCM_MAKINUM (SCM_CHAR_CODE_LIMIT)); From 5ae37f7114c1abf00983456513a9d1ec65bfeadc Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:09:22 +0000 Subject: [PATCH 283/306] (scm_i_thread_root): Do not validate argument. --- libguile/coop-threads.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index cf099cf60..ae00d3428 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -395,12 +395,9 @@ scm_all_threads (void) scm_root_state * scm_i_thread_root (SCM thread) -#define FUNC_NAME "scm_i_thread_root" { - SCM_VALIDATE_THREAD (1, thread); return (scm_root_state *)((coop_t *)SCM_THREAD_DATA (thread))->data; } -#undef FUNC_NAME SCM scm_join_thread (SCM thread) From 8ef70d1e3ceb6e6303b28141e000eb8603b38d22 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:10:40 +0000 Subject: [PATCH 284/306] (scm_t_cond): Renamed from scm_t_condvar, which was the wrong name. --- libguile/null-threads.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/null-threads.h b/libguile/null-threads.h index 92efcad8f..ea13873f7 100644 --- a/libguile/null-threads.h +++ b/libguile/null-threads.h @@ -77,7 +77,7 @@ SCM_API int scm_null_condvar_wait (scm_null_condvar *, scm_null_mutex *); SCM_API int scm_null_condvar_signal (scm_null_condvar *); SCM_API int scm_null_condvar_destroy (scm_null_condvar *); -typedef scm_null_condvar scm_t_condvar; +typedef scm_null_condvar scm_t_cond; #define scm_cond_init scm_null_condvar_init #define scm_cond_wait scm_null_condvar_wait #define scm_cond_signal scm_null_condvar_signal From 7751157e03b6abfee15901880486e0deabaa62d1 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:25:45 +0000 Subject: [PATCH 285/306] It's scm_t_cond, not scm_t_condvar. --- libguile/threads.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/threads.c b/libguile/threads.c index dcd91af05..f6762c9bd 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -145,7 +145,7 @@ scm_init_threads (SCM_STACKITEM *i) scm_tc16_thread = scm_make_smob_type ("thread", 0); scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_t_mutex)); scm_tc16_condvar = scm_make_smob_type ("condition-variable", - sizeof (scm_t_condvar)); + sizeof (scm_t_cond)); #include "libguile/threads.x" /* Initialize implementation specific details of the threads support */ From 028e573c8a2df385ba95d6ea6f64d62553098290 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:27:46 +0000 Subject: [PATCH 286/306] (scm_system_async_mark_for_thread): Validate thread argument. --- libguile/async.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/libguile/async.c b/libguile/async.c index 6b133fb68..3d99f5962 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -230,10 +230,13 @@ SCM_DEFINE (scm_system_async_mark_for_thread, "system-async-mark", 1, 1, 0, #define FUNC_NAME s_scm_system_async_mark_for_thread { #ifdef USE_THREADS + if (SCM_UNBNDP (thread)) + thread = scm_current_thread (); + else + SCM_VALIDATE_THREAD (2, thread); + scm_i_queue_async_cell (scm_cons (proc, SCM_BOOL_F), - (SCM_UNBNDP (thread) - ? scm_root - : scm_i_thread_root (thread))); + scm_i_thread_root (thread)); #else scm_i_queue_async_cell (scm_cons (proc, SCM_BOOL_F), scm_root); #endif From afcfb9df4dc28c85af69efd5a907b9d375a8b50f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:32:28 +0000 Subject: [PATCH 287/306] Shuffled around and extended the thread configuration code to allow the "null" thread package to be selected. Define USE_NULL_THREADS in that case. --- configure.in | 46 +++++++++++++++++++++++++++++----------------- 1 file changed, 29 insertions(+), 17 deletions(-) diff --git a/configure.in b/configure.in index e55b02a58..4ececda57 100644 --- a/configure.in +++ b/configure.in @@ -643,6 +643,8 @@ case "$with_threads" in "yes" | "qt" | "coop" | "") with_threads=qt ;; + "null" ) + ;; "no" ) ;; * ) @@ -660,12 +662,16 @@ case "${with_threads}" in ## correctly. QTHREADS_CONFIGURE ;; + "null" ) + THREAD_PACKAGE="null" + ;; esac + ## If we're using threads, bring in some other parts of Guile which ## work with them. if test "${THREAD_PACKAGE}" != "" ; then - AC_DEFINE(USE_THREADS, 1, [Define if using any sort of threads.]) + AC_DEFINE(USE_THREADS, 1, [Define if providing the thread API.]) ## Include the Guile thread interface in the library... AC_LIBOBJ([threads]) @@ -675,28 +681,34 @@ if test "${THREAD_PACKAGE}" != "" ; then "QT" ) AC_DEFINE(USE_COOP_THREADS, 1, [Define if using cooperative multithreading.]) + + AC_ARG_ENABLE(linuxthreads, + [ --disable-linuxthreads disable linuxthreads workaround],, + enable_linuxthreads=yes) + + ## Workaround for linuxthreads (optionally disabled) + if test $host_os = linux-gnu -a "$enable_linuxthreads" = yes; then + AC_DEFINE(GUILE_PTHREAD_COMPAT, 1, + [Define to enable workaround for COOP-linuxthreads compatibility.]) + AC_CHECK_LIB(pthread, main) + fi + + ## Bring in scm_internal_select, if appropriate. + if test $ac_cv_func_gettimeofday = yes && + test $ac_cv_func_select = yes; then + AC_DEFINE(GUILE_ISELECT, 1, [Define to implement scm_internal_select.]) + fi + + ;; + "null" ) + AC_DEFINE(USE_NULL_THREADS, 1, + [Define if using one-thread 'multi'threading.]) ;; * ) AC_MSG_ERROR(invalid value for THREAD_PACKAGE: ${THREAD_PACKAGE}) ;; esac - ## Bring in scm_internal_select, if appropriate. - if test $ac_cv_func_gettimeofday = yes && - test $ac_cv_func_select = yes; then - AC_DEFINE(GUILE_ISELECT, 1, [Define to implement scm_internal_select.]) - fi - - AC_ARG_ENABLE(linuxthreads, - [ --disable-linuxthreads disable linuxthreads workaround],, - enable_linuxthreads=yes) - - ## Workaround for linuxthreads (optionally disabled) - if test $host_os = linux-gnu -a "$enable_linuxthreads" = yes; then - AC_DEFINE(GUILE_PTHREAD_COMPAT, 1, - [Define to enable workaround for COOP-linuxthreads compatibility.]) - AC_CHECK_LIB(pthread, main) - fi fi ## Cross building From 2794cb50730ce1810984bcb239b88dd3bac2ee1e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:33:12 +0000 Subject: [PATCH 288/306] *** empty log message *** --- ChangeLog | 6 ++++++ libguile/ChangeLog | 26 ++++++++++++++++++++++++++ 2 files changed, 32 insertions(+) diff --git a/ChangeLog b/ChangeLog index 807c9be1c..15ec725cc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2002-10-16 Marius Vollmer + + * configure.in: Shuffled around and extended the thread + configuration code to allow the "null" thread package to be + selected. Define USE_NULL_THREADS in that case. + 2002-10-13 Gary Houston * autogen.sh (ac_version): try automake 1.7 too. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2a7c292b5..d77a1b631 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,29 @@ +2002-10-16 Marius Vollmer + + * async.c (scm_system_async_mark_for_thread): Validate thread + argument. + + * coop-threads.c (scm_i_thread_root): Do not validate argument. + + * feature.c (scm_init_feature): Don't add 'threads' for + USE_NULL_THREADS. + + * inline.h (scm_cell, scm_double_cell): Also allow + USE_NULL_THREADS to not protect the slot initializers. + + * scmsigs.c (scm_sigaction_for_thread): It's "USE_THREADS" not + "USE_THREAD". + + * Makefile.am (noinst_HEADERS): Added null-threads.c. + (modinclude_HEADERS): Added null-threads.h. + + * threads.h: Include null-threads.h when !USE_COOP_THREADS. + * threads.c: Include null-threads.c when !USE_COOP_THREADS. + (scm_init_threads): Use generic type names scm_t_mutex and + scm_t_cond instead of coop_m and coop_c. + + * null-threads.c, null-threads.h: New files. + 2002-10-15 Marius Vollmer * Makefile.am: Replaced "$<" in non-pattern rules with its value. From f0b4d944b4da08be29c9f647b2b61acf5ed9c922 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 16 Oct 2002 16:36:29 +0000 Subject: [PATCH 289/306] Added blurb about "null" threads. --- NEWS | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/NEWS b/NEWS index 5965d7383..b7fd69fcf 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,20 @@ Changes since the stable branch: * Changes to the distribution +** There is a new thread implementation option: "null". + +When you configure "--with-threads=null", you will get the usual +threading API (call-with-new-thread, make-mutex, etc), but you can't +actually create new threads. + +The short term plan is to remove the support for --with-threads=no +completely so that one doesn't need to special case as much when +writing code that needs to be thread-aware but should also work +without threads. + +The long term plan is to make the selection of a thread implementation +a run-time option, not a configure time option. + ** Guile now includes its own version of libltdl. We now use a modified version of libltdl that allows us to make From 100ae50db23bfcf78a0832b4b3eb857c7067f69b Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sat, 19 Oct 2002 08:22:50 +0000 Subject: [PATCH 290/306] * async.h, async.c (scm_system_async): Fixed deprecation to work correctly when deprecated features are excluded. --- libguile/ChangeLog | 5 +++++ libguile/async.c | 10 +++++++--- libguile/async.h | 2 +- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d77a1b631..76823efb3 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-10-19 Dirk Herrmann + + * async.h, async.c (scm_system_async): Fixed deprecation to work + correctly when deprecated features are excluded. + 2002-10-16 Marius Vollmer * async.c (scm_system_async_mark_for_thread): Validate thread diff --git a/libguile/async.c b/libguile/async.c index 3d99f5962..9a11a9e11 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -186,10 +186,12 @@ scm_async_click () } } +#if (SCM_ENABLE_DEPRECATED == 1) + SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0, (SCM thunk), "This function is deprecated. You can use @var{thunk} directly\n" - "instead of explicitely creating a asnc object.\n") + "instead of explicitely creating an async object.\n") #define FUNC_NAME s_scm_system_async { scm_c_issue_deprecation_warning @@ -199,6 +201,8 @@ SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0, } #undef FUNC_NAME +#endif /* SCM_ENABLE_DEPRECATED == 1 */ + void scm_i_queue_async_cell (SCM c, scm_root_state *root) { @@ -269,7 +273,7 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1, -#if (SCM_DEBUG_DEPRECATED == 0) +#if (SCM_ENABLE_DEPRECATED == 1) SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0, (), @@ -303,7 +307,7 @@ SCM_DEFINE (scm_mask_signals, "mask-signals", 0, 0, 0, } #undef FUNC_NAME -#endif /* SCM_DEBUG_DEPRECATED == 0 */ +#endif /* SCM_ENABLE_DEPRECATED == 1 */ static void increase_block (void *unused) diff --git a/libguile/async.h b/libguile/async.h index 984c04977..f58703b63 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -58,7 +58,6 @@ SCM_API void scm_async_click (void); SCM_API void scm_switch (void); SCM_API SCM scm_async (SCM thunk); -SCM_API SCM scm_system_async (SCM thunk); SCM_API SCM scm_async_mark (SCM a); SCM_API SCM scm_system_async_mark (SCM a); SCM_API SCM scm_system_async_mark_for_thread (SCM a, SCM thread); @@ -73,6 +72,7 @@ SCM_API void scm_init_async (void); #if (SCM_ENABLE_DEPRECATED == 1) +SCM_API SCM scm_system_async (SCM thunk); SCM_API SCM scm_unmask_signals (void); SCM_API SCM scm_mask_signals (void); From 5ec1d2c8e04ebaa909e8064a80ffc76620143bcf Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Sat, 19 Oct 2002 09:07:23 +0000 Subject: [PATCH 291/306] * evalext.h, evalext.c (scm_definedp, scm_defined_p): Renamed scm_definedp to scm_defined_p and deprecated scm_definedp. --- NEWS | 4 ++++ libguile/ChangeLog | 5 +++++ libguile/evalext.c | 6 +++--- libguile/evalext.h | 8 +++++++- 4 files changed, 19 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index b7fd69fcf..786177a09 100644 --- a/NEWS +++ b/NEWS @@ -214,6 +214,10 @@ the C variables that control garbage collection. The environment variables GUILE_MAX_SEGMENT_SIZE, GUILE_INIT_SEGMENT_SIZE_2, GUILE_INIT_SEGMENT_SIZE_1, and GUILE_MIN_YIELD_2 should be used. +** The function scm_definedp has been renamed to scm_defined_p + +The name scm_definedp is deprecated. + ** The struct scm_cell has been renamed to scm_t_cell This is in accordance to Guile's naming scheme for types. Note that diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 76823efb3..e9bb2eb37 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2002-10-19 Dirk Herrmann + + * evalext.h, evalext.c (scm_definedp, scm_defined_p): Renamed + scm_definedp to scm_defined_p and deprecated scm_definedp. + 2002-10-19 Dirk Herrmann * async.h, async.c (scm_system_async): Fixed deprecation to work diff --git a/libguile/evalext.c b/libguile/evalext.c index 16b3ed567..57b32e9e9 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1998,1999,2000,2001,2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -67,13 +67,13 @@ scm_m_generalized_set_x (SCM xorig, SCM env SCM_UNUSED) scm_misc_error (scm_s_set_x, scm_s_variable, SCM_EOL); } -SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0, +SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0, (SCM sym, SCM env), "Return @code{#t} if @var{sym} is defined in the lexical " "environment @var{env}. When @var{env} is not specified, " "look in the top-level environment as defined by the " "current module.") -#define FUNC_NAME s_scm_definedp +#define FUNC_NAME s_scm_defined_p { SCM var; diff --git a/libguile/evalext.h b/libguile/evalext.h index 0f2a7dc65..e0db5d2bc 100644 --- a/libguile/evalext.h +++ b/libguile/evalext.h @@ -51,10 +51,16 @@ SCM_API SCM scm_m_generalized_set_x (SCM xorig, SCM env); -SCM_API SCM scm_definedp (SCM sym, SCM env); +SCM_API SCM scm_defined_p (SCM sym, SCM env); SCM_API SCM scm_m_undefine (SCM x, SCM env); SCM_API void scm_init_evalext (void); +#if (SCM_ENABLE_DEPRECATED == 1) + +#define scm_definedp scm_defined_p + +#endif + #endif /* SCM_EVALEXT_H */ /* From 0a50eeaadb3533ad57ebe26f91cc750e1dadc809 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sat, 19 Oct 2002 16:33:25 +0000 Subject: [PATCH 292/306] Auto docstring updates, including soft port enhancement. --- NEWS | 8 + doc/maint/ChangeLog | 4 + doc/maint/guile.texi | 818 +++------------------------------ doc/ref/ChangeLog | 5 + doc/ref/new-docstrings.texi | 36 ++ doc/ref/posix.texi | 4 +- doc/ref/scheme-binding.texi | 2 +- doc/ref/scheme-io.texi | 5 +- doc/ref/scheme-scheduling.texi | 4 +- libguile/async.c | 11 +- 10 files changed, 140 insertions(+), 757 deletions(-) diff --git a/NEWS b/NEWS index 786177a09..ee7227d85 100644 --- a/NEWS +++ b/NEWS @@ -167,6 +167,14 @@ Change your code to use either procedure->memoizing-macro or, probably better, to use r5rs macros. Also, be aware that macro expansion will not be done during evaluation, but prior to evaluation. +** Soft ports now allow a `char-ready?' procedure + +The vector argument to `make-soft-port' can now have a length of +either 5 or 6. (Previously the length had to be 5.) The optional 6th +element is interpreted as an `input-waiting' thunk -- i.e. a thunk +that returns the number of characters that can be read immediately +without the soft port blocking. + * Changes to the C interface ** The value 'scm_mask_ints' is no longer writable. diff --git a/doc/maint/ChangeLog b/doc/maint/ChangeLog index dc3bccbfe..a490b9f51 100644 --- a/doc/maint/ChangeLog +++ b/doc/maint/ChangeLog @@ -1,3 +1,7 @@ +2002-10-19 Neil Jerram + + * guile.texi: Replaced by regenerated libguile version. + 2002-07-10 Gary Houston * docstring.el: optional 2nd environment variable to locate diff --git a/doc/maint/guile.texi b/doc/maint/guile.texi index 66764cd36..725084d90 100644 --- a/doc/maint/guile.texi +++ b/doc/maint/guile.texi @@ -1,6 +1,5 @@ acons -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:59 @deffn {Scheme Procedure} acons key value alist @deffnx {C Function} scm_acons (key, value, alist) Add a new key-value pair to @var{alist}. A new pair is @@ -10,7 +9,6 @@ function is @emph{not} destructive; @var{alist} is not modified. @end deffn sloppy-assq -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:73 @deffn {Scheme Procedure} sloppy-assq key alist @deffnx {C Function} scm_sloppy_assq (key, alist) Behaves like @code{assq} but does not do any error checking. @@ -18,7 +16,6 @@ Recommended only for use in Guile internals. @end deffn sloppy-assv -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:91 @deffn {Scheme Procedure} sloppy-assv key alist @deffnx {C Function} scm_sloppy_assv (key, alist) Behaves like @code{assv} but does not do any error checking. @@ -26,7 +23,6 @@ Recommended only for use in Guile internals. @end deffn sloppy-assoc -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:109 @deffn {Scheme Procedure} sloppy-assoc key alist @deffnx {C Function} scm_sloppy_assoc (key, alist) Behaves like @code{assoc} but does not do any error checking. @@ -34,7 +30,6 @@ Recommended only for use in Guile internals. @end deffn assq -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:136 @deffn {Scheme Procedure} assq key alist @deffnx {Scheme Procedure} assv key alist @deffnx {Scheme Procedure} assoc key alist @@ -49,21 +44,18 @@ return the entire alist entry found (i.e. both the key and the value). @end deffn assv -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:157 @deffn {Scheme Procedure} assv key alist @deffnx {C Function} scm_assv (key, alist) Behaves like @code{assq} but uses @code{eqv?} for key comparison. @end deffn assoc -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:178 @deffn {Scheme Procedure} assoc key alist @deffnx {C Function} scm_assoc (key, alist) Behaves like @code{assq} but uses @code{equal?} for key comparison. @end deffn assq-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:222 @deffn {Scheme Procedure} assq-ref alist key @deffnx {Scheme Procedure} assv-ref alist key @deffnx {Scheme Procedure} assoc-ref alist key @@ -81,21 +73,18 @@ where @var{associator} is one of @code{assq}, @code{assv} or @code{assoc}. @end deffn assv-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:239 @deffn {Scheme Procedure} assv-ref alist key @deffnx {C Function} scm_assv_ref (alist, key) Behaves like @code{assq-ref} but uses @code{eqv?} for key comparison. @end deffn assoc-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:256 @deffn {Scheme Procedure} assoc-ref alist key @deffnx {C Function} scm_assoc_ref (alist, key) Behaves like @code{assq-ref} but uses @code{equal?} for key comparison. @end deffn assq-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:285 @deffn {Scheme Procedure} assq-set! alist key val @deffnx {Scheme Procedure} assv-set! alist key value @deffnx {Scheme Procedure} assoc-set! alist key value @@ -111,21 +100,18 @@ association list. @end deffn assv-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:303 @deffn {Scheme Procedure} assv-set! alist key val @deffnx {C Function} scm_assv_set_x (alist, key, val) Behaves like @code{assq-set!} but uses @code{eqv?} for key comparison. @end deffn assoc-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:321 @deffn {Scheme Procedure} assoc-set! alist key val @deffnx {C Function} scm_assoc_set_x (alist, key, val) Behaves like @code{assq-set!} but uses @code{equal?} for key comparison. @end deffn assq-remove! -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:345 @deffn {Scheme Procedure} assq-remove! alist key @deffnx {Scheme Procedure} assv-remove! alist key @deffnx {Scheme Procedure} assoc-remove! alist key @@ -135,21 +121,18 @@ the resulting alist. @end deffn assv-remove! -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:361 @deffn {Scheme Procedure} assv-remove! alist key @deffnx {C Function} scm_assv_remove_x (alist, key) Behaves like @code{assq-remove!} but uses @code{eqv?} for key comparison. @end deffn assoc-remove! -@c snarfed from /home/ghouston/guile/guile-core/libguile/alist.c:377 @deffn {Scheme Procedure} assoc-remove! alist key @deffnx {C Function} scm_assoc_remove_x (alist, key) Behaves like @code{assq-remove!} but uses @code{equal?} for key comparison. @end deffn make-arbiter -@c snarfed from /home/ghouston/guile/guile-core/libguile/arbiters.c:82 @deffn {Scheme Procedure} make-arbiter name @deffnx {C Function} scm_make_arbiter (name) Return an object of type arbiter and name @var{name}. Its @@ -158,7 +141,6 @@ process synchronization. @end deffn try-arbiter -@c snarfed from /home/ghouston/guile/guile-core/libguile/arbiters.c:92 @deffn {Scheme Procedure} try-arbiter arb @deffnx {C Function} scm_try_arbiter (arb) Return @code{#t} and lock the arbiter @var{arb} if the arbiter @@ -166,7 +148,6 @@ was unlocked. Otherwise, return @code{#f}. @end deffn release-arbiter -@c snarfed from /home/ghouston/guile/guile-core/libguile/arbiters.c:113 @deffn {Scheme Procedure} release-arbiter arb @deffnx {C Function} scm_release_arbiter (arb) Return @code{#t} and unlock the arbiter @var{arb} if the @@ -174,43 +155,40 @@ arbiter was locked. Otherwise, return @code{#f}. @end deffn async -@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:289 @deffn {Scheme Procedure} async thunk @deffnx {C Function} scm_async (thunk) Create a new async for the procedure @var{thunk}. @end deffn - system-async -@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:299 -@deffn {Scheme Procedure} system-async thunk -@deffnx {C Function} scm_system_async (thunk) -Create a new async for the procedure @var{thunk}. Also -add it to the system's list of active async objects. -@end deffn - async-mark -@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:310 @deffn {Scheme Procedure} async-mark a @deffnx {C Function} scm_async_mark (a) Mark the async @var{a} for future execution. @end deffn - system-async-mark -@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:326 -@deffn {Scheme Procedure} system-async-mark a -@deffnx {C Function} scm_system_async_mark (a) -Mark the async @var{a} for future execution. -@end deffn - run-asyncs -@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:351 @deffn {Scheme Procedure} run-asyncs list_of_a @deffnx {C Function} scm_run_asyncs (list_of_a) Execute all thunks from the asyncs of the list @var{list_of_a}. @end deffn + system-async +@deffn {Scheme Procedure} system-async thunk +@deffnx {C Function} scm_system_async (thunk) +This function is deprecated. You can use @var{thunk} directly +instead of explicitely creating an async object. + +@end deffn + + system-async-mark +@deffn {Scheme Procedure} system-async-mark proc [thread] +@deffnx {C Function} scm_system_async_mark_for_thread (proc, thread) +Register the procedure @var{proc} for future execution +in @var{thread}. When @var{thread} is not specified, +use the current thread. +@end deffn + noop -@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:385 @deffn {Scheme Procedure} noop . args @deffnx {C Function} scm_noop (args) Do nothing. When called without arguments, return @code{#f}, @@ -218,21 +196,36 @@ otherwise return the first argument. @end deffn unmask-signals -@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:437 @deffn {Scheme Procedure} unmask-signals @deffnx {C Function} scm_unmask_signals () Unmask signals. The returned value is not specified. @end deffn mask-signals -@c snarfed from /home/ghouston/guile/guile-core/libguile/async.c:448 @deffn {Scheme Procedure} mask-signals @deffnx {C Function} scm_mask_signals () Mask signals. The returned value is not specified. @end deffn + call-with-blocked-asyncs +@deffn {Scheme Procedure} call-with-blocked-asyncs proc +@deffnx {C Function} scm_call_with_blocked_asyncs (proc) +Call @var{proc} with no arguments and block the execution +of system asyncs by one level for the current thread while +it is running. Return the value returned by @var{proc}. + +@end deffn + + call-with-unblocked-asyncs +@deffn {Scheme Procedure} call-with-unblocked-asyncs proc +@deffnx {C Function} scm_call_with_unblocked_asyncs (proc) +Call @var{proc} with no arguments and unblock the execution +of system asyncs by one level for the current thread while +it is running. Return the value returned by @var{proc}. + +@end deffn + display-error -@c snarfed from /home/ghouston/guile/guile-core/libguile/backtrace.c:264 @deffn {Scheme Procedure} display-error stack port subr message args rest @deffnx {C Function} scm_display_error (stack, port, subr, message, args, rest) Display an error message to the output port @var{port}. @@ -245,7 +238,6 @@ ignored. @end deffn display-application -@c snarfed from /home/ghouston/guile/guile-core/libguile/backtrace.c:400 @deffn {Scheme Procedure} display-application frame [port [indent]] @deffnx {C Function} scm_display_application (frame, port, indent) Display a procedure application @var{frame} to the output port @@ -254,7 +246,6 @@ output. @end deffn display-backtrace -@c snarfed from /home/ghouston/guile/guile-core/libguile/backtrace.c:711 @deffn {Scheme Procedure} display-backtrace stack port [first [depth]] @deffnx {C Function} scm_display_backtrace (stack, port, first, depth) Display a backtrace to the output port @var{port}. @var{stack} @@ -265,7 +256,6 @@ which means that default values will be used. @end deffn backtrace -@c snarfed from /home/ghouston/guile/guile-core/libguile/backtrace.c:734 @deffn {Scheme Procedure} backtrace @deffnx {C Function} scm_backtrace () Display a backtrace of the stack saved by the last error @@ -273,97 +263,83 @@ to the current output port. @end deffn not -@c snarfed from /home/ghouston/guile/guile-core/libguile/boolean.c:55 @deffn {Scheme Procedure} not x @deffnx {C Function} scm_not (x) Return @code{#t} iff @var{x} is @code{#f}, else return @code{#f}. @end deffn boolean? -@c snarfed from /home/ghouston/guile/guile-core/libguile/boolean.c:65 @deffn {Scheme Procedure} boolean? obj @deffnx {C Function} scm_boolean_p (obj) Return @code{#t} iff @var{obj} is either @code{#t} or @code{#f}. @end deffn char? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:54 @deffn {Scheme Procedure} char? x @deffnx {C Function} scm_char_p (x) Return @code{#t} iff @var{x} is a character, else @code{#f}. @end deffn char=? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:63 @deffn {Scheme Procedure} char=? x y Return @code{#t} iff @var{x} is the same character as @var{y}, else @code{#f}. @end deffn char? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:100 @deffn {Scheme Procedure} char>? x y Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII sequence, else @code{#f}. @end deffn char>=? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:112 @deffn {Scheme Procedure} char>=? x y Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the ASCII sequence, else @code{#f}. @end deffn char-ci=? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:124 @deffn {Scheme Procedure} char-ci=? x y Return @code{#t} iff @var{x} is the same character as @var{y} ignoring case, else @code{#f}. @end deffn char-ci? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:160 @deffn {Scheme Procedure} char-ci>? x y Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII sequence ignoring case, else @code{#f}. @end deffn char-ci>=? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:172 @deffn {Scheme Procedure} char-ci>=? x y Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the ASCII sequence ignoring case, else @code{#f}. @end deffn char-alphabetic? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:185 @deffn {Scheme Procedure} char-alphabetic? chr @deffnx {C Function} scm_char_alphabetic_p (chr) Return @code{#t} iff @var{chr} is alphabetic, else @code{#f}. @@ -371,7 +347,6 @@ Alphabetic means the same thing as the isalpha C library function. @end deffn char-numeric? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:196 @deffn {Scheme Procedure} char-numeric? chr @deffnx {C Function} scm_char_numeric_p (chr) Return @code{#t} iff @var{chr} is numeric, else @code{#f}. @@ -379,7 +354,6 @@ Numeric means the same thing as the isdigit C library function. @end deffn char-whitespace? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:207 @deffn {Scheme Procedure} char-whitespace? chr @deffnx {C Function} scm_char_whitespace_p (chr) Return @code{#t} iff @var{chr} is whitespace, else @code{#f}. @@ -387,7 +361,6 @@ Whitespace means the same thing as the isspace C library function. @end deffn char-upper-case? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:220 @deffn {Scheme Procedure} char-upper-case? chr @deffnx {C Function} scm_char_upper_case_p (chr) Return @code{#t} iff @var{chr} is uppercase, else @code{#f}. @@ -395,7 +368,6 @@ Uppercase means the same thing as the isupper C library function. @end deffn char-lower-case? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:232 @deffn {Scheme Procedure} char-lower-case? chr @deffnx {C Function} scm_char_lower_case_p (chr) Return @code{#t} iff @var{chr} is lowercase, else @code{#f}. @@ -403,7 +375,6 @@ Lowercase means the same thing as the islower C library function. @end deffn char-is-both? -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:246 @deffn {Scheme Procedure} char-is-both? chr @deffnx {C Function} scm_char_is_both_p (chr) Return @code{#t} iff @var{chr} is either uppercase or lowercase, else @code{#f}. @@ -412,7 +383,6 @@ C library functions. @end deffn char->integer -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:260 @deffn {Scheme Procedure} char->integer chr @deffnx {C Function} scm_char_to_integer (chr) Return the number corresponding to ordinal position of @var{chr} in the @@ -420,28 +390,24 @@ ASCII sequence. @end deffn integer->char -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:272 @deffn {Scheme Procedure} integer->char n @deffnx {C Function} scm_integer_to_char (n) Return the character at position @var{n} in the ASCII sequence. @end deffn char-upcase -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:283 @deffn {Scheme Procedure} char-upcase chr @deffnx {C Function} scm_char_upcase (chr) Return the uppercase character version of @var{chr}. @end deffn char-downcase -@c snarfed from /home/ghouston/guile/guile-core/libguile/chars.c:294 @deffn {Scheme Procedure} char-downcase chr @deffnx {C Function} scm_char_downcase (chr) Return the lowercase character version of @var{chr}. @end deffn debug-options-interface -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:79 @deffn {Scheme Procedure} debug-options-interface [setting] @deffnx {C Function} scm_debug_options (setting) Option interface for the debug options. Instead of using @@ -450,56 +416,48 @@ this procedure directly, use the procedures @code{debug-enable}, @end deffn with-traps -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:122 @deffn {Scheme Procedure} with-traps thunk @deffnx {C Function} scm_with_traps (thunk) Call @var{thunk} with traps enabled. @end deffn memoized? -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:164 @deffn {Scheme Procedure} memoized? obj @deffnx {C Function} scm_memoized_p (obj) Return @code{#t} if @var{obj} is memoized. @end deffn unmemoize -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:328 @deffn {Scheme Procedure} unmemoize m @deffnx {C Function} scm_unmemoize (m) Unmemoize the memoized expression @var{m}, @end deffn memoized-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:338 @deffn {Scheme Procedure} memoized-environment m @deffnx {C Function} scm_memoized_environment (m) Return the environment of the memoized expression @var{m}. @end deffn procedure-name -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:348 @deffn {Scheme Procedure} procedure-name proc @deffnx {C Function} scm_procedure_name (proc) Return the name of the procedure @var{proc} @end deffn procedure-source -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:374 @deffn {Scheme Procedure} procedure-source proc @deffnx {C Function} scm_procedure_source (proc) Return the source of the procedure @var{proc}. @end deffn procedure-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:407 @deffn {Scheme Procedure} procedure-environment proc @deffnx {C Function} scm_procedure_environment (proc) Return the environment of the procedure @var{proc}. @end deffn local-eval -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:439 @deffn {Scheme Procedure} local-eval exp [env] @deffnx {C Function} scm_local_eval (exp, env) Evaluate @var{exp} in its environment. If @var{env} is supplied, @@ -509,14 +467,12 @@ is implicit). @end deffn debug-object? -@c snarfed from /home/ghouston/guile/guile-core/libguile/debug.c:526 @deffn {Scheme Procedure} debug-object? obj @deffnx {C Function} scm_debug_object_p (obj) Return @code{#t} if @var{obj} is a debug object. @end deffn dynamic-link -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:171 @deffn {Scheme Procedure} dynamic-link filename @deffnx {C Function} scm_dynamic_link (filename) Find the shared object (shared library) denoted by @@ -532,7 +488,6 @@ such as @file{/usr/lib} and @file{/usr/local/lib}. @end deffn dynamic-object? -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:186 @deffn {Scheme Procedure} dynamic-object? obj @deffnx {C Function} scm_dynamic_object_p (obj) Return @code{#t} if @var{obj} is a dynamic object handle, @@ -540,7 +495,6 @@ or @code{#f} otherwise. @end deffn dynamic-unlink -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:200 @deffn {Scheme Procedure} dynamic-unlink dobj @deffnx {C Function} scm_dynamic_unlink (dobj) Unlink a dynamic object from the application, if possible. The @@ -551,7 +505,6 @@ object. @end deffn dynamic-func -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:225 @deffn {Scheme Procedure} dynamic-func name dobj @deffnx {C Function} scm_dynamic_func (name, dobj) Return a ``handle'' for the function @var{name} in the @@ -566,7 +519,6 @@ since it will be added automatically when necessary. @end deffn dynamic-call -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:267 @deffn {Scheme Procedure} dynamic-call func dobj @deffnx {C Function} scm_dynamic_call (func, dobj) Call a C function in a dynamic object. Two styles of @@ -591,7 +543,6 @@ and its return value is ignored. @end deffn dynamic-args-call -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:322 @deffn {Scheme Procedure} dynamic-args-call func dobj args @deffnx {C Function} scm_dynamic_args_call (func, dobj, args) Call the C function indicated by @var{func} and @var{dobj}, @@ -610,7 +561,6 @@ converted to a Scheme number and returned from the call to @end deffn dynamic-wind -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynwind.c:119 @deffn {Scheme Procedure} dynamic-wind in_guard thunk out_guard @deffnx {C Function} scm_dynamic_wind (in_guard, thunk, out_guard) All three arguments must be 0-argument procedures. @@ -664,7 +614,6 @@ a-cont @end deffn environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:130 @deffn {Scheme Procedure} environment? obj @deffnx {C Function} scm_environment_p (obj) Return @code{#t} if @var{obj} is an environment, or @code{#f} @@ -672,7 +621,6 @@ otherwise. @end deffn environment-bound? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:141 @deffn {Scheme Procedure} environment-bound? env sym @deffnx {C Function} scm_environment_bound_p (env, sym) Return @code{#t} if @var{sym} is bound in @var{env}, or @@ -680,7 +628,6 @@ Return @code{#t} if @var{sym} is bound in @var{env}, or @end deffn environment-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:156 @deffn {Scheme Procedure} environment-ref env sym @deffnx {C Function} scm_environment_ref (env, sym) Return the value of the location bound to @var{sym} in @@ -689,7 +636,6 @@ Return the value of the location bound to @var{sym} in @end deffn environment-fold -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:226 @deffn {Scheme Procedure} environment-fold env proc init @deffnx {C Function} scm_environment_fold (env, proc, init) Iterate over all the bindings in @var{env}, accumulating some @@ -726,7 +672,6 @@ using environment-fold: @end deffn environment-define -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:261 @deffn {Scheme Procedure} environment-define env sym val @deffnx {C Function} scm_environment_define (env, sym, val) Bind @var{sym} to a new location containing @var{val} in @@ -739,7 +684,6 @@ immutable, signal an @code{environment:immutable-binding} error. @end deffn environment-undefine -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:287 @deffn {Scheme Procedure} environment-undefine env sym @deffnx {C Function} scm_environment_undefine (env, sym) Remove any binding for @var{sym} from @var{env}. If @var{sym} @@ -750,7 +694,6 @@ immutable, signal an @code{environment:immutable-binding} error. @end deffn environment-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:315 @deffn {Scheme Procedure} environment-set! env sym val @deffnx {C Function} scm_environment_set_x (env, sym, val) If @var{env} binds @var{sym} to some location, change that @@ -763,7 +706,6 @@ to an immutable location, signal an @end deffn environment-cell -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:350 @deffn {Scheme Procedure} environment-cell env sym for_write @deffnx {C Function} scm_environment_cell (env, sym, for_write) Return the value cell which @var{env} binds to @var{sym}, or @@ -781,7 +723,6 @@ re-bound to a new value cell, or becomes undefined. @end deffn environment-observe -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:402 @deffn {Scheme Procedure} environment-observe env proc @deffnx {C Function} scm_environment_observe (env, proc) Whenever @var{env}'s bindings change, apply @var{proc} to @@ -793,7 +734,6 @@ token is unspecified. @end deffn environment-observe-weak -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:419 @deffn {Scheme Procedure} environment-observe-weak env proc @deffnx {C Function} scm_environment_observe_weak (env, proc) This function is the same as environment-observe, except that @@ -805,7 +745,6 @@ list of observing procedures. @end deffn environment-unobserve -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:455 @deffn {Scheme Procedure} environment-unobserve token @deffnx {C Function} scm_environment_unobserve (token) Cancel the observation request which returned the value @@ -817,7 +756,6 @@ bindings change. @end deffn make-leaf-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1026 @deffn {Scheme Procedure} make-leaf-environment @deffnx {C Function} scm_make_leaf_environment () Create a new leaf environment, containing no bindings. @@ -826,7 +764,6 @@ will be mutable. @end deffn leaf-environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1049 @deffn {Scheme Procedure} leaf-environment? object @deffnx {C Function} scm_leaf_environment_p (object) Return @code{#t} if object is a leaf environment, or @code{#f} @@ -834,7 +771,6 @@ otherwise. @end deffn make-eval-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1414 @deffn {Scheme Procedure} make-eval-environment local imported @deffnx {C Function} scm_make_eval_environment (local, imported) Return a new environment object eval whose bindings are the @@ -861,7 +797,6 @@ In typical use, @var{local} will be a finite environment, and @end deffn eval-environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1451 @deffn {Scheme Procedure} eval-environment? object @deffnx {C Function} scm_eval_environment_p (object) Return @code{#t} if object is an eval environment, or @code{#f} @@ -869,35 +804,30 @@ otherwise. @end deffn eval-environment-local -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1461 @deffn {Scheme Procedure} eval-environment-local env @deffnx {C Function} scm_eval_environment_local (env) Return the local environment of eval environment @var{env}. @end deffn eval-environment-set-local! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1473 @deffn {Scheme Procedure} eval-environment-set-local! env local @deffnx {C Function} scm_eval_environment_set_local_x (env, local) Change @var{env}'s local environment to @var{local}. @end deffn eval-environment-imported -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1499 @deffn {Scheme Procedure} eval-environment-imported env @deffnx {C Function} scm_eval_environment_imported (env) Return the imported environment of eval environment @var{env}. @end deffn eval-environment-set-imported! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1511 @deffn {Scheme Procedure} eval-environment-set-imported! env imported @deffnx {C Function} scm_eval_environment_set_imported_x (env, imported) Change @var{env}'s imported environment to @var{imported}. @end deffn make-import-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1834 @deffn {Scheme Procedure} make-import-environment imports conflict_proc @deffnx {C Function} scm_make_import_environment (imports, conflict_proc) Return a new environment @var{imp} whose bindings are the union @@ -928,7 +858,6 @@ if one of its imported environments changes. @end deffn import-environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1863 @deffn {Scheme Procedure} import-environment? object @deffnx {C Function} scm_import_environment_p (object) Return @code{#t} if object is an import environment, or @@ -936,7 +865,6 @@ Return @code{#t} if object is an import environment, or @end deffn import-environment-imports -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1874 @deffn {Scheme Procedure} import-environment-imports env @deffnx {C Function} scm_import_environment_imports (env) Return the list of environments imported by the import @@ -944,7 +872,6 @@ environment @var{env}. @end deffn import-environment-set-imports! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:1887 @deffn {Scheme Procedure} import-environment-set-imports! env imports @deffnx {C Function} scm_import_environment_set_imports_x (env, imports) Change @var{env}'s list of imported environments to @@ -952,7 +879,6 @@ Change @var{env}'s list of imported environments to @end deffn make-export-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2154 @deffn {Scheme Procedure} make-export-environment private signature @deffnx {C Function} scm_make_export_environment (private, signature) Return a new environment @var{exp} containing only those @@ -1002,7 +928,6 @@ if the bindings in private change. @end deffn export-environment? -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2189 @deffn {Scheme Procedure} export-environment? object @deffnx {C Function} scm_export_environment_p (object) Return @code{#t} if object is an export environment, or @@ -1010,35 +935,30 @@ Return @code{#t} if object is an export environment, or @end deffn export-environment-private -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2199 @deffn {Scheme Procedure} export-environment-private env @deffnx {C Function} scm_export_environment_private (env) Return the private environment of export environment @var{env}. @end deffn export-environment-set-private! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2211 @deffn {Scheme Procedure} export-environment-set-private! env private @deffnx {C Function} scm_export_environment_set_private_x (env, private) Change the private environment of export environment @var{env}. @end deffn export-environment-signature -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2233 @deffn {Scheme Procedure} export-environment-signature env @deffnx {C Function} scm_export_environment_signature (env) Return the signature of export environment @var{env}. @end deffn export-environment-set-signature! -@c snarfed from /home/ghouston/guile/guile-core/libguile/environments.c:2307 @deffn {Scheme Procedure} export-environment-set-signature! env signature @deffnx {C Function} scm_export_environment_set_signature_x (env, signature) Change the signature of export environment @var{env}. @end deffn eq? -@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:68 @deffn {Scheme Procedure} eq? x y Return @code{#t} iff @var{x} references the same object as @var{y}. @code{eq?} is similar to @code{eqv?} except that in some cases it is @@ -1047,7 +967,6 @@ capable of discerning distinctions finer than those detectable by @end deffn eqv? -@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:91 @deffn {Scheme Procedure} eqv? x y The @code{eqv?} procedure defines a useful equivalence relation on objects. Briefly, it returns @code{#t} if @var{x} and @var{y} should normally be @@ -1057,7 +976,6 @@ and inexact numbers. @end deffn equal? -@c snarfed from /home/ghouston/guile/guile-core/libguile/eq.c:144 @deffn {Scheme Procedure} equal? x y Return @code{#t} iff @var{x} and @var{y} are recursively @code{eqv?} equivalent. @code{equal?} recursively compares the contents of pairs, @@ -1068,7 +986,6 @@ terminate if its arguments are circular data structures. @end deffn scm-error -@c snarfed from /home/ghouston/guile/guile-core/libguile/error.c:117 @deffn {Scheme Procedure} scm-error key subr message args data @deffnx {C Function} scm_error_scm (key, subr, message, args, data) Raise an error with key @var{key}. @var{subr} can be a string @@ -1087,7 +1004,6 @@ it will usually be @code{#f}. @end deffn strerror -@c snarfed from /home/ghouston/guile/guile-core/libguile/error.c:168 @deffn {Scheme Procedure} strerror err @deffnx {C Function} scm_strerror (err) Return the Unix error message corresponding to @var{err}, which @@ -1095,7 +1011,6 @@ must be an integer value. @end deffn apply:nconc2last -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3412 @deffn {Scheme Procedure} apply:nconc2last lst @deffnx {C Function} scm_nconc2last (lst) Given a list (@var{arg1} @dots{} @var{args}), this function @@ -1108,7 +1023,6 @@ destroys its argument, so use with care. @end deffn force -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3948 @deffn {Scheme Procedure} force x @deffnx {C Function} scm_force (x) If the promise @var{x} has not been computed yet, compute and @@ -1117,7 +1031,6 @@ value. @end deffn promise? -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3971 @deffn {Scheme Procedure} promise? obj @deffnx {C Function} scm_promise_p (obj) Return true if @var{obj} is a promise, i.e. a delayed computation @@ -1125,7 +1038,6 @@ Return true if @var{obj} is a promise, i.e. a delayed computation @end deffn cons-source -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:3983 @deffn {Scheme Procedure} cons-source xorig x y @deffnx {C Function} scm_cons_source (xorig, x, y) Create and return a new pair whose car and cdr are @var{x} and @var{y}. @@ -1134,7 +1046,6 @@ with the new pair. @end deffn copy-tree -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4003 @deffn {Scheme Procedure} copy-tree obj @deffnx {C Function} scm_copy_tree (obj) Recursively copy the data tree that is bound to @var{obj}, and return a @@ -1145,7 +1056,6 @@ any other object. @end deffn primitive-eval -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4096 @deffn {Scheme Procedure} primitive-eval exp @deffnx {C Function} scm_primitive_eval (exp) Evaluate @var{exp} in the top-level environment specified by @@ -1153,7 +1063,6 @@ the current module. @end deffn eval -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:4165 @deffn {Scheme Procedure} eval exp module @deffnx {C Function} scm_eval (exp, module) Evaluate @var{exp}, a list representing a Scheme expression, @@ -1164,7 +1073,6 @@ is reset to its previous value when @var{eval} returns. @end deffn eval-options-interface -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:1749 @deffn {Scheme Procedure} eval-options-interface [setting] @deffnx {C Function} scm_eval_options_interface (setting) Option interface for the evaluation options. Instead of using @@ -1173,27 +1081,23 @@ this procedure directly, use the procedures @code{eval-enable}, @end deffn evaluator-traps-interface -@c snarfed from /home/ghouston/guile/guile-core/libguile/eval.c:1766 @deffn {Scheme Procedure} evaluator-traps-interface [setting] @deffnx {C Function} scm_evaluator_traps (setting) Option interface for the evaluator trap options. @end deffn defined? -@c snarfed from /home/ghouston/guile/guile-core/libguile/evalext.c:75 @deffn {Scheme Procedure} defined? sym [env] -@deffnx {C Function} scm_definedp (sym, env) +@deffnx {C Function} scm_defined_p (sym, env) Return @code{#t} if @var{sym} is defined in the lexical environment @var{env}. When @var{env} is not specified, look in the top-level environment as defined by the current module. @end deffn map-in-order -@c snarfed from /home/ghouston/guile/guile-core/libguile/evalext.c:144 @deffn {Scheme Procedure} map-in-order implemented by the C function "scm_map" @end deffn load-extension -@c snarfed from /home/ghouston/guile/guile-core/libguile/extensions.c:154 @deffn {Scheme Procedure} load-extension lib init @deffnx {C Function} scm_load_extension (lib, init) Load and initialize the extension designated by LIB and INIT. @@ -1233,7 +1137,6 @@ well. For example, @end deffn program-arguments -@c snarfed from /home/ghouston/guile/guile-core/libguile/feature.c:77 @deffn {Scheme Procedure} program-arguments @deffnx {Scheme Procedure} command-line @deffnx {C Function} scm_program_arguments () @@ -1244,7 +1147,6 @@ options like @code{-e} and @code{-l}. @end deffn make-fluid -@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:124 @deffn {Scheme Procedure} make-fluid @deffnx {C Function} scm_make_fluid () Return a newly created fluid. @@ -1257,7 +1159,6 @@ in its own dynamic root, you can use fluids for thread local storage. @end deffn fluid? -@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:137 @deffn {Scheme Procedure} fluid? obj @deffnx {C Function} scm_fluid_p (obj) Return @code{#t} iff @var{obj} is a fluid; otherwise, return @@ -1265,7 +1166,6 @@ Return @code{#t} iff @var{obj} is a fluid; otherwise, return @end deffn fluid-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:148 @deffn {Scheme Procedure} fluid-ref fluid @deffnx {C Function} scm_fluid_ref (fluid) Return the value associated with @var{fluid} in the current @@ -1274,14 +1174,12 @@ dynamic root. If @var{fluid} has not been set, then return @end deffn fluid-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:164 @deffn {Scheme Procedure} fluid-set! fluid value @deffnx {C Function} scm_fluid_set_x (fluid, value) Set the value associated with @var{fluid} in the current dynamic root. @end deffn with-fluids* -@c snarfed from /home/ghouston/guile/guile-core/libguile/fluids.c:223 @deffn {Scheme Procedure} with-fluids* fluids values thunk @deffnx {C Function} scm_with_fluids (fluids, values, thunk) Set @var{fluids} to @var{values} temporary, and call @var{thunk}. @@ -1291,7 +1189,6 @@ one after another. @var{thunk} must be a procedure with no argument. @end deffn setvbuf -@c snarfed from /home/ghouston/guile/guile-core/libguile/fports.c:156 @deffn {Scheme Procedure} setvbuf port mode [size] @deffnx {C Function} scm_setvbuf (port, mode, size) Set the buffering mode for @var{port}. @var{mode} can be: @@ -1307,14 +1204,12 @@ If @var{size} is omitted, a default size will be used. @end deffn file-port? -@c snarfed from /home/ghouston/guile/guile-core/libguile/fports.c:245 @deffn {Scheme Procedure} file-port? obj @deffnx {C Function} scm_file_port_p (obj) Determine whether @var{obj} is a port that is related to a file. @end deffn open-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/fports.c:299 @deffn {Scheme Procedure} open-file filename mode @deffnx {C Function} scm_open_file (filename, mode) Open the file whose name is @var{filename}, and return a port @@ -1357,7 +1252,6 @@ requested, @code{open-file} throws an exception. @end deffn set-debug-cell-accesses! -@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:210 @deffn {Scheme Procedure} set-debug-cell-accesses! flag @deffnx {C Function} scm_set_debug_cell_accesses_x (flag) This function is used to turn on checking for a debug version of GUILE. This version does not support this functionality @@ -1365,7 +1259,6 @@ This function is used to turn on checking for a debug version of GUILE. This ver @end deffn gc-stats -@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:303 @deffn {Scheme Procedure} gc-stats @deffnx {C Function} scm_gc_stats () Return an association list of statistics about Guile's current @@ -1374,7 +1267,6 @@ use of storage. @end deffn object-address -@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:424 @deffn {Scheme Procedure} object-address obj @deffnx {C Function} scm_object_address (obj) Return an integer that for the lifetime of @var{obj} is uniquely @@ -1382,7 +1274,6 @@ returned by this function for @var{obj} @end deffn gc -@c snarfed from /home/ghouston/guile/guile-core/libguile/gc.c:435 @deffn {Scheme Procedure} gc @deffnx {C Function} scm_gc () Scans all of SCM objects and reclaims for further use those that are @@ -1390,7 +1281,6 @@ no longer accessible. @end deffn %compute-slots -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:291 @deffn {Scheme Procedure} %compute-slots class @deffnx {C Function} scm_sys_compute_slots (class) Return a list consisting of the names of all slots belonging to @@ -1399,7 +1289,6 @@ its superclasses. @end deffn get-keyword -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:376 @deffn {Scheme Procedure} get-keyword key l default_value @deffnx {C Function} scm_get_keyword (key, l, default_value) Determine an associated value for the keyword @var{key} from @@ -1411,7 +1300,6 @@ If @var{l} does not hold a value for @var{key}, the value @end deffn %initialize-object -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:399 @deffn {Scheme Procedure} %initialize-object obj initargs @deffnx {C Function} scm_sys_initialize_object (obj, initargs) Initialize the object @var{obj} with the given arguments @@ -1419,147 +1307,126 @@ Initialize the object @var{obj} with the given arguments @end deffn %prep-layout! -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:479 @deffn {Scheme Procedure} %prep-layout! class @deffnx {C Function} scm_sys_prep_layout_x (class) @end deffn %inherit-magic! -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:556 @deffn {Scheme Procedure} %inherit-magic! class dsupers @deffnx {C Function} scm_sys_inherit_magic_x (class, dsupers) @end deffn instance? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:799 @deffn {Scheme Procedure} instance? obj @deffnx {C Function} scm_instance_p (obj) Return @code{#t} if @var{obj} is an instance. @end deffn class-name -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:814 @deffn {Scheme Procedure} class-name obj @deffnx {C Function} scm_class_name (obj) Return the class name of @var{obj}. @end deffn class-direct-supers -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:824 @deffn {Scheme Procedure} class-direct-supers obj @deffnx {C Function} scm_class_direct_supers (obj) Return the direct superclasses of the class @var{obj}. @end deffn class-direct-slots -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:834 @deffn {Scheme Procedure} class-direct-slots obj @deffnx {C Function} scm_class_direct_slots (obj) Return the direct slots of the class @var{obj}. @end deffn class-direct-subclasses -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:844 @deffn {Scheme Procedure} class-direct-subclasses obj @deffnx {C Function} scm_class_direct_subclasses (obj) Return the direct subclasses of the class @var{obj}. @end deffn class-direct-methods -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:854 @deffn {Scheme Procedure} class-direct-methods obj @deffnx {C Function} scm_class_direct_methods (obj) Return the direct methods of the class @var{obj} @end deffn class-precedence-list -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:864 @deffn {Scheme Procedure} class-precedence-list obj @deffnx {C Function} scm_class_precedence_list (obj) Return the class precedence list of the class @var{obj}. @end deffn class-slots -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:874 @deffn {Scheme Procedure} class-slots obj @deffnx {C Function} scm_class_slots (obj) Return the slot list of the class @var{obj}. @end deffn class-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:884 @deffn {Scheme Procedure} class-environment obj @deffnx {C Function} scm_class_environment (obj) Return the environment of the class @var{obj}. @end deffn generic-function-name -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:895 @deffn {Scheme Procedure} generic-function-name obj @deffnx {C Function} scm_generic_function_name (obj) Return the name of the generic function @var{obj}. @end deffn generic-function-methods -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:905 @deffn {Scheme Procedure} generic-function-methods obj @deffnx {C Function} scm_generic_function_methods (obj) Return the methods of the generic function @var{obj}. @end deffn method-generic-function -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:916 @deffn {Scheme Procedure} method-generic-function obj @deffnx {C Function} scm_method_generic_function (obj) Return the generic function for the method @var{obj}. @end deffn method-specializers -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:926 @deffn {Scheme Procedure} method-specializers obj @deffnx {C Function} scm_method_specializers (obj) Return specializers of the method @var{obj}. @end deffn method-procedure -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:936 @deffn {Scheme Procedure} method-procedure obj @deffnx {C Function} scm_method_procedure (obj) Return the procedure of the method @var{obj}. @end deffn accessor-method-slot-definition -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:946 @deffn {Scheme Procedure} accessor-method-slot-definition obj @deffnx {C Function} scm_accessor_method_slot_definition (obj) Return the slot definition of the accessor @var{obj}. @end deffn %tag-body -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:956 @deffn {Scheme Procedure} %tag-body body @deffnx {C Function} scm_sys_tag_body (body) Internal GOOPS magic---don't use this function! @end deffn make-unbound -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:971 @deffn {Scheme Procedure} make-unbound @deffnx {C Function} scm_make_unbound () Return the unbound value. @end deffn unbound? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:980 @deffn {Scheme Procedure} unbound? obj @deffnx {C Function} scm_unbound_p (obj) Return @code{#t} if @var{obj} is unbound. @end deffn assert-bound -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:990 @deffn {Scheme Procedure} assert-bound value obj @deffnx {C Function} scm_assert_bound (value, obj) Return @var{value} if it is bound, and invoke the @@ -1567,7 +1434,6 @@ Return @var{value} if it is bound, and invoke the @end deffn @@assert-bound-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1002 @deffn {Scheme Procedure} @@assert-bound-ref obj index @deffnx {C Function} scm_at_assert_bound_ref (obj, index) Like @code{assert-bound}, but use @var{index} for accessing @@ -1575,14 +1441,12 @@ the value from @var{obj}. @end deffn %fast-slot-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1014 @deffn {Scheme Procedure} %fast-slot-ref obj index @deffnx {C Function} scm_sys_fast_slot_ref (obj, index) Return the slot value with index @var{index} from @var{obj}. @end deffn %fast-slot-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1032 @deffn {Scheme Procedure} %fast-slot-set! obj index value @deffnx {C Function} scm_sys_fast_slot_set_x (obj, index, value) Set the slot with index @var{index} in @var{obj} to @@ -1590,35 +1454,30 @@ Set the slot with index @var{index} in @var{obj} to @end deffn slot-ref-using-class -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1162 @deffn {Scheme Procedure} slot-ref-using-class class obj slot_name @deffnx {C Function} scm_slot_ref_using_class (class, obj, slot_name) @end deffn slot-set-using-class! -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1181 @deffn {Scheme Procedure} slot-set-using-class! class obj slot_name value @deffnx {C Function} scm_slot_set_using_class_x (class, obj, slot_name, value) @end deffn slot-bound-using-class? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1195 @deffn {Scheme Procedure} slot-bound-using-class? class obj slot_name @deffnx {C Function} scm_slot_bound_using_class_p (class, obj, slot_name) @end deffn slot-exists-using-class? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1210 @deffn {Scheme Procedure} slot-exists-using-class? class obj slot_name @deffnx {C Function} scm_slot_exists_using_class_p (class, obj, slot_name) @end deffn slot-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1226 @deffn {Scheme Procedure} slot-ref obj slot_name @deffnx {C Function} scm_slot_ref (obj, slot_name) Return the value from @var{obj}'s slot with the name @@ -1626,14 +1485,12 @@ Return the value from @var{obj}'s slot with the name @end deffn slot-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1243 @deffn {Scheme Procedure} slot-set! obj slot_name value @deffnx {C Function} scm_slot_set_x (obj, slot_name, value) Set the slot named @var{slot_name} of @var{obj} to @var{value}. @end deffn slot-bound? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1260 @deffn {Scheme Procedure} slot-bound? obj slot_name @deffnx {C Function} scm_slot_bound_p (obj, slot_name) Return @code{#t} if the slot named @var{slot_name} of @var{obj} @@ -1641,14 +1498,12 @@ is bound. @end deffn slot-exists? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1278 @deffn {Scheme Procedure} slot-exists? obj slot_name @deffnx {C Function} scm_slot_exists_p (obj, slot_name) Return @code{#t} if @var{obj} has a slot named @var{slot_name}. @end deffn %allocate-instance -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1317 @deffn {Scheme Procedure} %allocate-instance class initargs @deffnx {C Function} scm_sys_allocate_instance (class, initargs) Create a new instance of class @var{class} and initialize it @@ -1656,63 +1511,54 @@ from the arguments @var{initargs}. @end deffn %set-object-setter! -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1387 @deffn {Scheme Procedure} %set-object-setter! obj setter @deffnx {C Function} scm_sys_set_object_setter_x (obj, setter) @end deffn %modify-instance -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1412 @deffn {Scheme Procedure} %modify-instance old new @deffnx {C Function} scm_sys_modify_instance (old, new) @end deffn %modify-class -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1438 @deffn {Scheme Procedure} %modify-class old new @deffnx {C Function} scm_sys_modify_class (old, new) @end deffn %invalidate-class -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1462 @deffn {Scheme Procedure} %invalidate-class class @deffnx {C Function} scm_sys_invalidate_class (class) @end deffn %invalidate-method-cache! -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1589 @deffn {Scheme Procedure} %invalidate-method-cache! gf @deffnx {C Function} scm_sys_invalidate_method_cache_x (gf) @end deffn generic-capability? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1615 @deffn {Scheme Procedure} generic-capability? proc @deffnx {C Function} scm_generic_capability_p (proc) @end deffn enable-primitive-generic! -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1628 @deffn {Scheme Procedure} enable-primitive-generic! . subrs @deffnx {C Function} scm_enable_primitive_generic_x (subrs) @end deffn primitive-generic-generic -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:1649 @deffn {Scheme Procedure} primitive-generic-generic subr @deffnx {C Function} scm_primitive_generic_generic (subr) @end deffn make -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2026 @deffn {Scheme Procedure} make . args @deffnx {C Function} scm_make (args) Make a new object. @var{args} must contain the class and @@ -1720,21 +1566,18 @@ all necessary initialization information. @end deffn find-method -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2119 @deffn {Scheme Procedure} find-method . l @deffnx {C Function} scm_find_method (l) @end deffn %method-more-specific? -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2139 @deffn {Scheme Procedure} %method-more-specific? m1 m2 targs @deffnx {C Function} scm_sys_method_more_specific_p (m1, m2, targs) @end deffn %goops-loaded -@c snarfed from /home/ghouston/guile/guile-core/libguile/goops.c:2664 @deffn {Scheme Procedure} %goops-loaded @deffnx {C Function} scm_sys_goops_loaded () Announce that GOOPS is loaded and perform initialization @@ -1742,7 +1585,6 @@ on the C level which depends on the loaded GOOPS modules. @end deffn make-guardian -@c snarfed from /home/ghouston/guile/guile-core/libguile/guardians.c:330 @deffn {Scheme Procedure} make-guardian [greedy_p] @deffnx {C Function} scm_make_guardian (greedy_p) Create a new guardian. @@ -1773,21 +1615,18 @@ paper still (mostly) accurately describes the interface). @end deffn guardian-destroyed? -@c snarfed from /home/ghouston/guile/guile-core/libguile/guardians.c:358 @deffn {Scheme Procedure} guardian-destroyed? guardian @deffnx {C Function} scm_guardian_destroyed_p (guardian) Return @code{#t} if @var{guardian} has been destroyed, otherwise @code{#f}. @end deffn guardian-greedy? -@c snarfed from /home/ghouston/guile/guile-core/libguile/guardians.c:376 @deffn {Scheme Procedure} guardian-greedy? guardian @deffnx {C Function} scm_guardian_greedy_p (guardian) Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}. @end deffn destroy-guardian! -@c snarfed from /home/ghouston/guile/guile-core/libguile/guardians.c:387 @deffn {Scheme Procedure} destroy-guardian! guardian @deffnx {C Function} scm_destroy_guardian_x (guardian) Destroys @var{guardian}, by making it impossible to put any more @@ -1796,7 +1635,6 @@ objects guarded by @var{guardian}. @end deffn hashq -@c snarfed from /home/ghouston/guile/guile-core/libguile/hash.c:200 @deffn {Scheme Procedure} hashq key size @deffnx {C Function} scm_hashq (key, size) Determine a hash value for @var{key} that is suitable for @@ -1812,7 +1650,6 @@ different values, since @code{foo} will be garbage collected. @end deffn hashv -@c snarfed from /home/ghouston/guile/guile-core/libguile/hash.c:236 @deffn {Scheme Procedure} hashv key size @deffnx {C Function} scm_hashv (key, size) Determine a hash value for @var{key} that is suitable for @@ -1828,7 +1665,6 @@ different values, since @code{foo} will be garbage collected. @end deffn hash -@c snarfed from /home/ghouston/guile/guile-core/libguile/hash.c:259 @deffn {Scheme Procedure} hash key size @deffnx {C Function} scm_hash (key, size) Determine a hash value for @var{key} that is suitable for @@ -1838,7 +1674,6 @@ integer in the range 0 to @var{size} - 1. @end deffn hashq-get-handle -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:173 @deffn {Scheme Procedure} hashq-get-handle table key @deffnx {C Function} scm_hashq_get_handle (table, key) This procedure returns the @code{(key . value)} pair from the @@ -1848,7 +1683,6 @@ Uses @code{eq?} for equality testing. @end deffn hashq-create-handle! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:185 @deffn {Scheme Procedure} hashq-create-handle! table key init @deffnx {C Function} scm_hashq_create_handle_x (table, key, init) This function looks up @var{key} in @var{table} and returns its handle. @@ -1857,7 +1691,6 @@ associates @var{key} with @var{init}. @end deffn hashq-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:198 @deffn {Scheme Procedure} hashq-ref table key [dflt] @deffnx {C Function} scm_hashq_ref (table, key, dflt) Look up @var{key} in the hash table @var{table}, and return the @@ -1867,7 +1700,6 @@ is supplied). Uses @code{eq?} for equality testing. @end deffn hashq-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:212 @deffn {Scheme Procedure} hashq-set! table key val @deffnx {C Function} scm_hashq_set_x (table, key, val) Find the entry in @var{table} associated with @var{key}, and @@ -1875,7 +1707,6 @@ store @var{value} there. Uses @code{eq?} for equality testing. @end deffn hashq-remove! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:224 @deffn {Scheme Procedure} hashq-remove! table key @deffnx {C Function} scm_hashq_remove_x (table, key) Remove @var{key} (and any value associated with it) from @@ -1883,7 +1714,6 @@ Remove @var{key} (and any value associated with it) from @end deffn hashv-get-handle -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:240 @deffn {Scheme Procedure} hashv-get-handle table key @deffnx {C Function} scm_hashv_get_handle (table, key) This procedure returns the @code{(key . value)} pair from the @@ -1893,7 +1723,6 @@ Uses @code{eqv?} for equality testing. @end deffn hashv-create-handle! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:252 @deffn {Scheme Procedure} hashv-create-handle! table key init @deffnx {C Function} scm_hashv_create_handle_x (table, key, init) This function looks up @var{key} in @var{table} and returns its handle. @@ -1902,7 +1731,6 @@ associates @var{key} with @var{init}. @end deffn hashv-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:266 @deffn {Scheme Procedure} hashv-ref table key [dflt] @deffnx {C Function} scm_hashv_ref (table, key, dflt) Look up @var{key} in the hash table @var{table}, and return the @@ -1912,7 +1740,6 @@ is supplied). Uses @code{eqv?} for equality testing. @end deffn hashv-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:280 @deffn {Scheme Procedure} hashv-set! table key val @deffnx {C Function} scm_hashv_set_x (table, key, val) Find the entry in @var{table} associated with @var{key}, and @@ -1920,7 +1747,6 @@ store @var{value} there. Uses @code{eqv?} for equality testing. @end deffn hashv-remove! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:291 @deffn {Scheme Procedure} hashv-remove! table key @deffnx {C Function} scm_hashv_remove_x (table, key) Remove @var{key} (and any value associated with it) from @@ -1928,7 +1754,6 @@ Remove @var{key} (and any value associated with it) from @end deffn hash-get-handle -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:306 @deffn {Scheme Procedure} hash-get-handle table key @deffnx {C Function} scm_hash_get_handle (table, key) This procedure returns the @code{(key . value)} pair from the @@ -1938,7 +1763,6 @@ Uses @code{equal?} for equality testing. @end deffn hash-create-handle! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:318 @deffn {Scheme Procedure} hash-create-handle! table key init @deffnx {C Function} scm_hash_create_handle_x (table, key, init) This function looks up @var{key} in @var{table} and returns its handle. @@ -1947,7 +1771,6 @@ associates @var{key} with @var{init}. @end deffn hash-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:331 @deffn {Scheme Procedure} hash-ref table key [dflt] @deffnx {C Function} scm_hash_ref (table, key, dflt) Look up @var{key} in the hash table @var{table}, and return the @@ -1957,7 +1780,6 @@ is supplied). Uses @code{equal?} for equality testing. @end deffn hash-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:346 @deffn {Scheme Procedure} hash-set! table key val @deffnx {C Function} scm_hash_set_x (table, key, val) Find the entry in @var{table} associated with @var{key}, and @@ -1966,7 +1788,6 @@ testing. @end deffn hash-remove! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:358 @deffn {Scheme Procedure} hash-remove! table key @deffnx {C Function} scm_hash_remove_x (table, key) Remove @var{key} (and any value associated with it) from @@ -1974,7 +1795,6 @@ Remove @var{key} (and any value associated with it) from @end deffn hashx-get-handle -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:422 @deffn {Scheme Procedure} hashx-get-handle hash assoc table key @deffnx {C Function} scm_hashx_get_handle (hash, assoc, table, key) This behaves the same way as the corresponding @@ -1986,7 +1806,6 @@ table size. @code{assoc} must be an associator function, like @end deffn hashx-create-handle! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:441 @deffn {Scheme Procedure} hashx-create-handle! hash assoc table key init @deffnx {C Function} scm_hashx_create_handle_x (hash, assoc, table, key, init) This behaves the same way as the corresponding @@ -1998,7 +1817,6 @@ table size. @code{assoc} must be an associator function, like @end deffn hashx-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:464 @deffn {Scheme Procedure} hashx-ref hash assoc table key [dflt] @deffnx {C Function} scm_hashx_ref (hash, assoc, table, key, dflt) This behaves the same way as the corresponding @code{ref} @@ -2013,7 +1831,6 @@ equivalent to @code{hashx-ref hashq assq table key}. @end deffn hashx-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:490 @deffn {Scheme Procedure} hashx-set! hash assoc table key val @deffnx {C Function} scm_hashx_set_x (hash, assoc, table, key, val) This behaves the same way as the corresponding @code{set!} @@ -2028,7 +1845,6 @@ equivalent to @code{hashx-set! hashq assq table key}. @end deffn hash-fold -@c snarfed from /home/ghouston/guile/guile-core/libguile/hashtab.c:528 @deffn {Scheme Procedure} hash-fold proc init table @deffnx {C Function} scm_hash_fold (proc, init, table) An iterator over hash-table elements. @@ -2042,7 +1858,6 @@ table into an a-list of key-value pairs. @end deffn make-hook -@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:178 @deffn {Scheme Procedure} make-hook [n_args] @deffnx {C Function} scm_make_hook (n_args) Create a hook for storing procedure of arity @var{n_args}. @@ -2051,14 +1866,12 @@ object to be used with the other hook procedures. @end deffn hook? -@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:201 @deffn {Scheme Procedure} hook? x @deffnx {C Function} scm_hook_p (x) Return @code{#t} if @var{x} is a hook, @code{#f} otherwise. @end deffn hook-empty? -@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:212 @deffn {Scheme Procedure} hook-empty? hook @deffnx {C Function} scm_hook_empty_p (hook) Return @code{#t} if @var{hook} is an empty hook, @code{#f} @@ -2066,7 +1879,6 @@ otherwise. @end deffn add-hook! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:226 @deffn {Scheme Procedure} add-hook! hook proc [append_p] @deffnx {C Function} scm_add_hook_x (hook, proc, append_p) Add the procedure @var{proc} to the hook @var{hook}. The @@ -2076,7 +1888,6 @@ procedure is not specified. @end deffn remove-hook! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:253 @deffn {Scheme Procedure} remove-hook! hook proc @deffnx {C Function} scm_remove_hook_x (hook, proc) Remove the procedure @var{proc} from the hook @var{hook}. The @@ -2084,7 +1895,6 @@ return value of this procedure is not specified. @end deffn reset-hook! -@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:267 @deffn {Scheme Procedure} reset-hook! hook @deffnx {C Function} scm_reset_hook_x (hook) Remove all procedures from the hook @var{hook}. The return @@ -2092,7 +1902,6 @@ value of this procedure is not specified. @end deffn run-hook -@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:281 @deffn {Scheme Procedure} run-hook hook . args @deffnx {C Function} scm_run_hook (hook, args) Apply all procedures from the hook @var{hook} to the arguments @@ -2101,14 +1910,12 @@ last. The return value of this procedure is not specified. @end deffn hook->list -@c snarfed from /home/ghouston/guile/guile-core/libguile/hooks.c:308 @deffn {Scheme Procedure} hook->list hook @deffnx {C Function} scm_hook_to_list (hook) Convert the procedure list of @var{hook} to a list. @end deffn ftell -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:73 @deffn {Scheme Procedure} ftell fd_port @deffnx {C Function} scm_ftell (fd_port) Return an integer representing the current position of @@ -2120,7 +1927,6 @@ Return an integer representing the current position of @end deffn redirect-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:91 @deffn {Scheme Procedure} redirect-port old new @deffnx {C Function} scm_redirect_port (old, new) This procedure takes two ports and duplicates the underlying file @@ -2139,7 +1945,6 @@ revealed counts. @end deffn dup->fdes -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:130 @deffn {Scheme Procedure} dup->fdes fd_or_port [fd] @deffnx {C Function} scm_dup_to_fdes (fd_or_port, fd) Return a new integer file descriptor referring to the open file @@ -2148,7 +1953,6 @@ file port or a file descriptor. @end deffn dup2 -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:177 @deffn {Scheme Procedure} dup2 oldfd newfd @deffnx {C Function} scm_dup2 (oldfd, newfd) A simple wrapper for the @code{dup2} system call. @@ -2162,7 +1966,6 @@ The return value is unspecified. @end deffn fileno -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:196 @deffn {Scheme Procedure} fileno port @deffnx {C Function} scm_fileno (port) Return the integer file descriptor underlying @var{port}. Does @@ -2170,7 +1973,6 @@ not change its revealed count. @end deffn isatty? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:216 @deffn {Scheme Procedure} isatty? port @deffnx {C Function} scm_isatty_p (port) Return @code{#t} if @var{port} is using a serial non--file @@ -2178,7 +1980,6 @@ device, otherwise @code{#f}. @end deffn fdopen -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:238 @deffn {Scheme Procedure} fdopen fdes modes @deffnx {C Function} scm_fdopen (fdes, modes) Return a new port based on the file descriptor @var{fdes}. @@ -2188,7 +1989,6 @@ same as that accepted by @ref{File Ports, open-file}. @end deffn primitive-move->fdes -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:262 @deffn {Scheme Procedure} primitive-move->fdes port fd @deffnx {C Function} scm_primitive_move_to_fdes (port, fd) Moves the underlying file descriptor for @var{port} to the integer @@ -2200,7 +2000,6 @@ required value or @code{#t} if it was moved. @end deffn fdes->ports -@c snarfed from /home/ghouston/guile/guile-core/libguile/ioext.c:296 @deffn {Scheme Procedure} fdes->ports fd @deffnx {C Function} scm_fdes_to_ports (fd) Return a list of existing ports which have @var{fdes} as an @@ -2209,14 +2008,12 @@ counts. @end deffn make-keyword-from-dash-symbol -@c snarfed from /home/ghouston/guile/guile-core/libguile/keywords.c:74 @deffn {Scheme Procedure} make-keyword-from-dash-symbol symbol @deffnx {C Function} scm_make_keyword_from_dash_symbol (symbol) Make a keyword object from a @var{symbol} that starts with a dash. @end deffn keyword? -@c snarfed from /home/ghouston/guile/guile-core/libguile/keywords.c:112 @deffn {Scheme Procedure} keyword? obj @deffnx {C Function} scm_keyword_p (obj) Return @code{#t} if the argument @var{obj} is a keyword, else @@ -2224,7 +2021,6 @@ Return @code{#t} if the argument @var{obj} is a keyword, else @end deffn keyword-dash-symbol -@c snarfed from /home/ghouston/guile/guile-core/libguile/keywords.c:123 @deffn {Scheme Procedure} keyword-dash-symbol keyword @deffnx {C Function} scm_keyword_dash_symbol (keyword) Return the dash symbol for @var{keyword}. @@ -2232,7 +2028,6 @@ This is the inverse of @code{make-keyword-from-dash-symbol}. @end deffn list -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:127 @deffn {Scheme Procedure} list . objs @deffnx {C Function} scm_list (objs) Return a list containing @var{objs}, the arguments to @@ -2240,7 +2035,6 @@ Return a list containing @var{objs}, the arguments to @end deffn cons* -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:142 @deffn {Scheme Procedure} cons* arg . rest @deffnx {C Function} scm_cons_star (arg, rest) Like @code{list}, but the last arg provides the tail of the @@ -2252,28 +2046,24 @@ Schemes and in Common LISP. @end deffn null? -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:166 @deffn {Scheme Procedure} null? x @deffnx {C Function} scm_null_p (x) Return @code{#t} iff @var{x} is the empty list, else @code{#f}. @end deffn list? -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:176 @deffn {Scheme Procedure} list? x @deffnx {C Function} scm_list_p (x) Return @code{#t} iff @var{x} is a proper list, else @code{#f}. @end deffn length -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:217 @deffn {Scheme Procedure} length lst @deffnx {C Function} scm_length (lst) Return the number of elements in list @var{lst}. @end deffn append -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:246 @deffn {Scheme Procedure} append . args @deffnx {C Function} scm_append (args) Return a list consisting of the elements the lists passed as @@ -2294,7 +2084,6 @@ if the last argument is not a proper list. @end deffn append! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:280 @deffn {Scheme Procedure} append! . lists @deffnx {C Function} scm_append_x (lists) A destructive version of @code{append} (@pxref{Pairs and @@ -2305,7 +2094,6 @@ the mutated list. @end deffn last-pair -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:306 @deffn {Scheme Procedure} last-pair lst @deffnx {C Function} scm_last_pair (lst) Return a pointer to the last pair in @var{lst}, signalling an error if @@ -2313,7 +2101,6 @@ Return a pointer to the last pair in @var{lst}, signalling an error if @end deffn reverse -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:336 @deffn {Scheme Procedure} reverse lst @deffnx {C Function} scm_reverse (lst) Return a new list that contains the elements of @var{lst} but @@ -2321,7 +2108,6 @@ in reverse order. @end deffn reverse! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:370 @deffn {Scheme Procedure} reverse! lst [new_tail] @deffnx {C Function} scm_reverse_x (lst, new_tail) A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r5rs, @@ -2338,27 +2124,23 @@ of the modified list is not lost, it is wise to save the return value of @end deffn list-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:396 @deffn {Scheme Procedure} list-ref list k @deffnx {C Function} scm_list_ref (list, k) Return the @var{k}th element from @var{list}. @end deffn list-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:420 @deffn {Scheme Procedure} list-set! list k val @deffnx {C Function} scm_list_set_x (list, k, val) Set the @var{k}th element of @var{list} to @var{val}. @end deffn list-cdr-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:443 @deffn {Scheme Procedure} list-cdr-ref implemented by the C function "scm_list_tail" @end deffn list-tail -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:452 @deffn {Scheme Procedure} list-tail lst k @deffnx {Scheme Procedure} list-cdr-ref lst k @deffnx {C Function} scm_list_tail (lst, k) @@ -2371,14 +2153,12 @@ or returning the results of cdring @var{k} times down @var{lst}. @end deffn list-cdr-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:468 @deffn {Scheme Procedure} list-cdr-set! list k val @deffnx {C Function} scm_list_cdr_set_x (list, k, val) Set the @var{k}th cdr of @var{list} to @var{val}. @end deffn list-head -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:497 @deffn {Scheme Procedure} list-head lst k @deffnx {C Function} scm_list_head (lst, k) Copy the first @var{k} elements from @var{lst} into a new list, and @@ -2386,14 +2166,12 @@ return it. @end deffn list-copy -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:521 @deffn {Scheme Procedure} list-copy lst @deffnx {C Function} scm_list_copy (lst) Return a (newly-created) copy of @var{lst}. @end deffn memq -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:575 @deffn {Scheme Procedure} memq x lst @deffnx {C Function} scm_memq (x, lst) Return the first sublist of @var{lst} whose car is @code{eq?} @@ -2405,7 +2183,6 @@ returned. @end deffn memv -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:591 @deffn {Scheme Procedure} memv x lst @deffnx {C Function} scm_memv (x, lst) Return the first sublist of @var{lst} whose car is @code{eqv?} @@ -2417,7 +2194,6 @@ returned. @end deffn member -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:612 @deffn {Scheme Procedure} member x lst @deffnx {C Function} scm_member (x, lst) Return the first sublist of @var{lst} whose car is @@ -2429,7 +2205,6 @@ empty list) is returned. @end deffn delq! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:637 @deffn {Scheme Procedure} delq! item lst @deffnx {Scheme Procedure} delv! item lst @deffnx {Scheme Procedure} delete! item lst @@ -2443,7 +2218,6 @@ destructive list functions, these functions cannot modify the binding of @end deffn delv! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:661 @deffn {Scheme Procedure} delv! item lst @deffnx {C Function} scm_delv_x (item, lst) Destructively remove all elements from @var{lst} that are @@ -2451,7 +2225,6 @@ Destructively remove all elements from @var{lst} that are @end deffn delete! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:686 @deffn {Scheme Procedure} delete! item lst @deffnx {C Function} scm_delete_x (item, lst) Destructively remove all elements from @var{lst} that are @@ -2459,7 +2232,6 @@ Destructively remove all elements from @var{lst} that are @end deffn delq -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:715 @deffn {Scheme Procedure} delq item lst @deffnx {C Function} scm_delq (item, lst) Return a newly-created copy of @var{lst} with elements @@ -2469,7 +2241,6 @@ Return a newly-created copy of @var{lst} with elements @end deffn delv -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:728 @deffn {Scheme Procedure} delv item lst @deffnx {C Function} scm_delv (item, lst) Return a newly-created copy of @var{lst} with elements @@ -2479,7 +2250,6 @@ Return a newly-created copy of @var{lst} with elements @end deffn delete -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:741 @deffn {Scheme Procedure} delete item lst @deffnx {C Function} scm_delete (item, lst) Return a newly-created copy of @var{lst} with elements @@ -2489,7 +2259,6 @@ against @var{item} with @code{equal?}. @end deffn delq1! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:754 @deffn {Scheme Procedure} delq1! item lst @deffnx {C Function} scm_delq1_x (item, lst) Like @code{delq!}, but only deletes the first occurrence of @@ -2498,7 +2267,6 @@ Like @code{delq!}, but only deletes the first occurrence of @end deffn delv1! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:782 @deffn {Scheme Procedure} delv1! item lst @deffnx {C Function} scm_delv1_x (item, lst) Like @code{delv!}, but only deletes the first occurrence of @@ -2507,7 +2275,6 @@ Like @code{delv!}, but only deletes the first occurrence of @end deffn delete1! -@c snarfed from /home/ghouston/guile/guile-core/libguile/list.c:810 @deffn {Scheme Procedure} delete1! item lst @deffnx {C Function} scm_delete1_x (item, lst) Like @code{delete!}, but only deletes the first occurrence of @@ -2516,7 +2283,6 @@ Like @code{delete!}, but only deletes the first occurrence of @end deffn primitive-load -@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:111 @deffn {Scheme Procedure} primitive-load filename @deffnx {C Function} scm_primitive_load (filename) Load the file named @var{filename} and evaluate its contents in @@ -2529,7 +2295,6 @@ documentation for @code{%load-hook} later in this section. @end deffn %package-data-dir -@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:151 @deffn {Scheme Procedure} %package-data-dir @deffnx {C Function} scm_sys_package_data_dir () Return the name of the directory where Scheme packages, modules and @@ -2538,7 +2303,6 @@ libraries are kept. On most Unix systems, this will be @end deffn %library-dir -@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:163 @deffn {Scheme Procedure} %library-dir @deffnx {C Function} scm_sys_library_dir () Return the directory where the Guile Scheme library files are installed. @@ -2546,7 +2310,6 @@ E.g., may return "/usr/share/guile/1.3.5". @end deffn %site-dir -@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:175 @deffn {Scheme Procedure} %site-dir @deffnx {C Function} scm_sys_site_dir () Return the directory where the Guile site files are installed. @@ -2554,7 +2317,6 @@ E.g., may return "/usr/share/guile/site". @end deffn parse-path -@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:227 @deffn {Scheme Procedure} parse-path path [tail] @deffnx {C Function} scm_parse_path (path, tail) Parse @var{path}, which is expected to be a colon-separated @@ -2564,7 +2326,6 @@ is returned. @end deffn search-path -@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:277 @deffn {Scheme Procedure} search-path path filename [extensions] @deffnx {C Function} scm_search_path (path, filename, extensions) Search @var{path} for a directory containing a file named @@ -2577,7 +2338,6 @@ concatenated with each @var{extension}. @end deffn %search-load-path -@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:423 @deffn {Scheme Procedure} %search-load-path filename @deffnx {C Function} scm_sys_search_load_path (filename) Search @var{%load-path} for the file named @var{filename}, @@ -2590,7 +2350,6 @@ will try each extension automatically. @end deffn primitive-load-path -@c snarfed from /home/ghouston/guile/guile-core/libguile/load.c:444 @deffn {Scheme Procedure} primitive-load-path filename @deffnx {C Function} scm_primitive_load_path (filename) Search @var{%load-path} for the file named @var{filename} and @@ -2600,7 +2359,6 @@ an error is signalled. @end deffn procedure->syntax -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:107 @deffn {Scheme Procedure} procedure->syntax code @deffnx {C Function} scm_makacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2610,7 +2368,6 @@ environment. @end deffn procedure->macro -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:130 @deffn {Scheme Procedure} procedure->macro code @deffnx {C Function} scm_makmacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2628,7 +2385,6 @@ environment. For example: @end deffn procedure->memoizing-macro -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:155 @deffn {Scheme Procedure} procedure->memoizing-macro code @deffnx {C Function} scm_makmmacro (code) Return a @dfn{macro} which, when a symbol defined to this value @@ -2643,7 +2399,6 @@ form of the containing code. @end deffn macro? -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:167 @deffn {Scheme Procedure} macro? obj @deffnx {C Function} scm_macro_p (obj) Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a @@ -2651,7 +2406,6 @@ syntax transformer. @end deffn macro-type -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:187 @deffn {Scheme Procedure} macro-type m @deffnx {C Function} scm_macro_type (m) Return one of the symbols @code{syntax}, @code{macro} or @@ -2662,28 +2416,24 @@ returned. @end deffn macro-name -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:207 @deffn {Scheme Procedure} macro-name m @deffnx {C Function} scm_macro_name (m) Return the name of the macro @var{m}. @end deffn macro-transformer -@c snarfed from /home/ghouston/guile/guile-core/libguile/macros.c:218 @deffn {Scheme Procedure} macro-transformer m @deffnx {C Function} scm_macro_transformer (m) Return the transformer of the macro @var{m}. @end deffn current-module -@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:69 @deffn {Scheme Procedure} current-module @deffnx {C Function} scm_current_module () Return the current module. @end deffn set-current-module -@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:81 @deffn {Scheme Procedure} set-current-module module @deffnx {C Function} scm_set_current_module (module) Set the current module to @var{module} and return @@ -2691,7 +2441,6 @@ the previous current module. @end deffn interaction-environment -@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:104 @deffn {Scheme Procedure} interaction-environment @deffnx {C Function} scm_interaction_environment () Return a specifier for the environment that contains @@ -2702,35 +2451,30 @@ evaluate expressions dynamically typed by the user. @end deffn env-module -@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:271 @deffn {Scheme Procedure} env-module env @deffnx {C Function} scm_env_module (env) Return the module of @var{ENV}, a lexical environment. @end deffn standard-eval-closure -@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:348 @deffn {Scheme Procedure} standard-eval-closure module @deffnx {C Function} scm_standard_eval_closure (module) Return an eval closure for the module @var{module}. @end deffn standard-interface-eval-closure -@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:359 @deffn {Scheme Procedure} standard-interface-eval-closure module @deffnx {C Function} scm_standard_interface_eval_closure (module) Return a interface eval closure for the module @var{module}. Such a closure does not allow new bindings to be added. @end deffn %get-pre-modules-obarray -@c snarfed from /home/ghouston/guile/guile-core/libguile/modules.c:582 @deffn {Scheme Procedure} %get-pre-modules-obarray @deffnx {C Function} scm_get_pre_modules_obarray () Return the obarray that is used for all new bindings before the module system is booted. The first call to @code{set-current-module} will boot the module system. @end deffn exact? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:106 @deffn {Scheme Procedure} exact? x @deffnx {C Function} scm_exact_p (x) Return @code{#t} if @var{x} is an exact number, @code{#f} @@ -2738,7 +2482,6 @@ otherwise. @end deffn odd? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:123 @deffn {Scheme Procedure} odd? n @deffnx {C Function} scm_odd_p (n) Return @code{#t} if @var{n} is an odd number, @code{#f} @@ -2746,7 +2489,6 @@ otherwise. @end deffn even? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:142 @deffn {Scheme Procedure} even? n @deffnx {C Function} scm_even_p (n) Return @code{#t} if @var{n} is an even number, @code{#f} @@ -2754,7 +2496,6 @@ otherwise. @end deffn inf? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:184 @deffn {Scheme Procedure} inf? n @deffnx {C Function} scm_inf_p (n) Return @code{#t} if @var{n} is infinite, @code{#f} @@ -2762,7 +2503,6 @@ otherwise. @end deffn nan? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:201 @deffn {Scheme Procedure} nan? n @deffnx {C Function} scm_nan_p (n) Return @code{#t} if @var{n} is a NaN, @code{#f} @@ -2770,21 +2510,18 @@ otherwise. @end deffn inf -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:263 @deffn {Scheme Procedure} inf @deffnx {C Function} scm_inf () Return Inf. @end deffn nan -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:278 @deffn {Scheme Procedure} nan @deffnx {C Function} scm_nan () Return NaN. @end deffn logand -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:891 @deffn {Scheme Procedure} logand n1 n2 Return the bitwise AND of the integer arguments. @@ -2796,7 +2533,6 @@ Return the bitwise AND of the integer arguments. @end deffn logior -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:972 @deffn {Scheme Procedure} logior n1 n2 Return the bitwise OR of the integer arguments. @@ -2808,7 +2544,6 @@ Return the bitwise OR of the integer arguments. @end deffn logxor -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1054 @deffn {Scheme Procedure} logxor n1 n2 Return the bitwise XOR of the integer arguments. A bit is set in the result if it is set in an odd number of arguments. @@ -2821,7 +2556,6 @@ set in the result if it is set in an odd number of arguments. @end deffn logtest -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1118 @deffn {Scheme Procedure} logtest j k @deffnx {C Function} scm_logtest (j, k) @lisp @@ -2833,7 +2567,6 @@ set in the result if it is set in an odd number of arguments. @end deffn logbit? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1175 @deffn {Scheme Procedure} logbit? index j @deffnx {C Function} scm_logbit_p (index, j) @lisp @@ -2848,7 +2581,6 @@ set in the result if it is set in an odd number of arguments. @end deffn lognot -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1224 @deffn {Scheme Procedure} lognot n @deffnx {C Function} scm_lognot (n) Return the integer which is the 2s-complement of the integer @@ -2863,7 +2595,6 @@ argument. @end deffn integer-expt -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1241 @deffn {Scheme Procedure} integer-expt n k @deffnx {C Function} scm_integer_expt (n, k) Return @var{n} raised to the non-negative integer exponent @@ -2878,7 +2609,6 @@ Return @var{n} raised to the non-negative integer exponent @end deffn ash -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1296 @deffn {Scheme Procedure} ash n cnt @deffnx {C Function} scm_ash (n, cnt) The function ash performs an arithmetic shift left by @var{cnt} @@ -2899,7 +2629,6 @@ Formally, the function returns an integer equivalent to @end deffn bit-extract -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1349 @deffn {Scheme Procedure} bit-extract n start end @deffnx {C Function} scm_bit_extract (n, start, end) Return the integer composed of the @var{start} (inclusive) @@ -2915,7 +2644,6 @@ through @var{end} (exclusive) bits of @var{n}. The @end deffn logcount -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1421 @deffn {Scheme Procedure} logcount n @deffnx {C Function} scm_logcount (n) Return the number of bits in integer @var{n}. If integer is @@ -2934,7 +2662,6 @@ representation are counted. If 0, 0 is returned. @end deffn integer-length -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:1472 @deffn {Scheme Procedure} integer-length n @deffnx {C Function} scm_integer_length (n) Return the number of bits necessary to represent @var{n}. @@ -2950,7 +2677,6 @@ Return the number of bits necessary to represent @var{n}. @end deffn number->string -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:2336 @deffn {Scheme Procedure} number->string n [radix] @deffnx {C Function} scm_number_to_string (n, radix) Return a string holding the external representation of the @@ -2959,7 +2685,6 @@ inexact, a radix of 10 will be used. @end deffn string->number -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:2995 @deffn {Scheme Procedure} string->number string [radix] @deffnx {C Function} scm_string_to_number (string, radix) Return a number of the maximally precise representation @@ -2973,13 +2698,11 @@ syntactically valid notation for a number, then @end deffn number? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3064 @deffn {Scheme Procedure} number? implemented by the C function "scm_number_p" @end deffn complex? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3076 @deffn {Scheme Procedure} complex? x @deffnx {C Function} scm_number_p (x) Return @code{#t} if @var{x} is a complex number, @code{#f} @@ -2990,13 +2713,11 @@ rational or integer number. @end deffn real? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3084 @deffn {Scheme Procedure} real? implemented by the C function "scm_real_p" @end deffn rational? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3097 @deffn {Scheme Procedure} rational? x @deffnx {C Function} scm_real_p (x) Return @code{#t} if @var{x} is a rational number, @code{#f} @@ -3008,7 +2729,6 @@ precision. @end deffn integer? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3118 @deffn {Scheme Procedure} integer? x @deffnx {C Function} scm_integer_p (x) Return @code{#t} if @var{x} is an integer number, @code{#f} @@ -3016,7 +2736,6 @@ else. @end deffn inexact? -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:3143 @deffn {Scheme Procedure} inexact? x @deffnx {C Function} scm_inexact_p (x) Return @code{#t} if @var{x} is an inexact number, @code{#f} @@ -3024,7 +2743,6 @@ else. @end deffn $expt -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4303 @deffn {Scheme Procedure} $expt x y @deffnx {C Function} scm_sys_expt (x, y) Return @var{x} raised to the power of @var{y}. This @@ -3032,7 +2750,6 @@ procedure does not accept complex arguments. @end deffn $atan2 -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4319 @deffn {Scheme Procedure} $atan2 x y @deffnx {C Function} scm_sys_atan2 (x, y) Return the arc tangent of the two arguments @var{x} and @@ -3043,7 +2760,6 @@ procedure does not accept complex arguments. @end deffn make-rectangular -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4332 @deffn {Scheme Procedure} make-rectangular real imaginary @deffnx {C Function} scm_make_rectangular (real, imaginary) Return a complex number constructed of the given @var{real} and @@ -3051,49 +2767,42 @@ Return a complex number constructed of the given @var{real} and @end deffn make-polar -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4345 @deffn {Scheme Procedure} make-polar x y @deffnx {C Function} scm_make_polar (x, y) Return the complex number @var{x} * e^(i * @var{y}). @end deffn inexact->exact -@c snarfed from /home/ghouston/guile/guile-core/libguile/numbers.c:4480 @deffn {Scheme Procedure} inexact->exact z @deffnx {C Function} scm_inexact_to_exact (z) Return an exact number that is numerically closest to @var{z}. @end deffn class-of -@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:86 @deffn {Scheme Procedure} class-of x @deffnx {C Function} scm_class_of (x) Return the class of @var{x}. @end deffn entity? -@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:360 @deffn {Scheme Procedure} entity? obj @deffnx {C Function} scm_entity_p (obj) Return @code{#t} if @var{obj} is an entity. @end deffn operator? -@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:369 @deffn {Scheme Procedure} operator? obj @deffnx {C Function} scm_operator_p (obj) Return @code{#t} if @var{obj} is an operator. @end deffn valid-object-procedure? -@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:385 @deffn {Scheme Procedure} valid-object-procedure? proc @deffnx {C Function} scm_valid_object_procedure_p (proc) Return @code{#t} iff @var{proc} is a procedure that can be used with @code{set-object-procedure}. It is always valid to use a closure constructed by @code{lambda}. @end deffn set-object-procedure! -@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:407 @deffn {Scheme Procedure} set-object-procedure! obj proc @deffnx {C Function} scm_set_object_procedure_x (obj, proc) Set the object procedure of @var{obj} to @var{proc}. @@ -3101,7 +2810,6 @@ Set the object procedure of @var{obj} to @var{proc}. @end deffn make-class-object -@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:467 @deffn {Scheme Procedure} make-class-object metaclass layout @deffnx {C Function} scm_make_class_object (metaclass, layout) Create a new class object of class @var{metaclass}, with the @@ -3109,7 +2817,6 @@ slot layout specified by @var{layout}. @end deffn make-subclass-object -@c snarfed from /home/ghouston/guile/guile-core/libguile/objects.c:482 @deffn {Scheme Procedure} make-subclass-object class layout @deffnx {C Function} scm_make_subclass_object (class, layout) Create a subclass object of @var{class}, with the slot layout @@ -3117,28 +2824,24 @@ specified by @var{layout}. @end deffn object-properties -@c snarfed from /home/ghouston/guile/guile-core/libguile/objprop.c:59 @deffn {Scheme Procedure} object-properties obj @deffnx {C Function} scm_object_properties (obj) Return @var{obj}'s property list. @end deffn set-object-properties! -@c snarfed from /home/ghouston/guile/guile-core/libguile/objprop.c:69 @deffn {Scheme Procedure} set-object-properties! obj alist @deffnx {C Function} scm_set_object_properties_x (obj, alist) Set @var{obj}'s property list to @var{alist}. @end deffn object-property -@c snarfed from /home/ghouston/guile/guile-core/libguile/objprop.c:80 @deffn {Scheme Procedure} object-property obj key @deffnx {C Function} scm_object_property (obj, key) Return the property of @var{obj} with name @var{key}. @end deffn set-object-property! -@c snarfed from /home/ghouston/guile/guile-core/libguile/objprop.c:92 @deffn {Scheme Procedure} set-object-property! obj key value @deffnx {C Function} scm_set_object_property_x (obj, key, value) In @var{obj}'s property list, set the property named @var{key} @@ -3146,7 +2849,6 @@ to @var{value}. @end deffn cons -@c snarfed from /home/ghouston/guile/guile-core/libguile/pairs.c:80 @deffn {Scheme Procedure} cons x y @deffnx {C Function} scm_cons (x, y) Return a newly allocated pair whose car is @var{x} and whose @@ -3155,7 +2857,6 @@ sense of @code{eq?}) from every previously existing object. @end deffn pair? -@c snarfed from /home/ghouston/guile/guile-core/libguile/pairs.c:98 @deffn {Scheme Procedure} pair? x @deffnx {C Function} scm_pair_p (x) Return @code{#t} if @var{x} is a pair; otherwise return @@ -3163,7 +2864,6 @@ Return @code{#t} if @var{x} is a pair; otherwise return @end deffn set-car! -@c snarfed from /home/ghouston/guile/guile-core/libguile/pairs.c:109 @deffn {Scheme Procedure} set-car! pair value @deffnx {C Function} scm_set_car_x (pair, value) Stores @var{value} in the car field of @var{pair}. The value returned @@ -3171,7 +2871,6 @@ by @code{set-car!} is unspecified. @end deffn set-cdr! -@c snarfed from /home/ghouston/guile/guile-core/libguile/pairs.c:122 @deffn {Scheme Procedure} set-cdr! pair value @deffnx {C Function} scm_set_cdr_x (pair, value) Stores @var{value} in the cdr field of @var{pair}. The value returned @@ -3179,7 +2878,6 @@ by @code{set-cdr!} is unspecified. @end deffn char-ready? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:259 @deffn {Scheme Procedure} char-ready? [port] @deffnx {C Function} scm_char_ready_p (port) Return @code{#t} if a character is ready on input @var{port} @@ -3198,7 +2896,6 @@ interactive port that has no ready characters.} @end deffn drain-input -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:336 @deffn {Scheme Procedure} drain-input port @deffnx {C Function} scm_drain_input (port) This procedure clears a port's input buffers, similar @@ -3218,7 +2915,6 @@ for further input. @end deffn current-input-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:363 @deffn {Scheme Procedure} current-input-port @deffnx {C Function} scm_current_input_port () Return the current input port. This is the default port used @@ -3227,7 +2923,6 @@ returns the @dfn{standard input} in Unix and C terminology. @end deffn current-output-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:375 @deffn {Scheme Procedure} current-output-port @deffnx {C Function} scm_current_output_port () Return the current output port. This is the default port used @@ -3237,7 +2932,6 @@ Unix and C terminology. @end deffn current-error-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:385 @deffn {Scheme Procedure} current-error-port @deffnx {C Function} scm_current_error_port () Return the port to which errors and warnings should be sent (the @@ -3245,7 +2939,6 @@ Return the port to which errors and warnings should be sent (the @end deffn current-load-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:395 @deffn {Scheme Procedure} current-load-port @deffnx {C Function} scm_current_load_port () Return the current-load-port. @@ -3253,7 +2946,6 @@ The load port is used internally by @code{primitive-load}. @end deffn set-current-input-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:408 @deffn {Scheme Procedure} set-current-input-port port @deffnx {Scheme Procedure} set-current-output-port port @deffnx {Scheme Procedure} set-current-error-port port @@ -3264,28 +2956,24 @@ so that they use the supplied @var{port} for input or output. @end deffn set-current-output-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:421 @deffn {Scheme Procedure} set-current-output-port port @deffnx {C Function} scm_set_current_output_port (port) Set the current default output port to @var{port}. @end deffn set-current-error-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:435 @deffn {Scheme Procedure} set-current-error-port port @deffnx {C Function} scm_set_current_error_port (port) Set the current default error port to @var{port}. @end deffn port-revealed -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:571 @deffn {Scheme Procedure} port-revealed port @deffnx {C Function} scm_port_revealed (port) Return the revealed count for @var{port}. @end deffn set-port-revealed! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:584 @deffn {Scheme Procedure} set-port-revealed! port rcount @deffnx {C Function} scm_set_port_revealed_x (port, rcount) Sets the revealed count for a port to a given value. @@ -3293,7 +2981,6 @@ The return value is unspecified. @end deffn port-mode -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:627 @deffn {Scheme Procedure} port-mode port @deffnx {C Function} scm_port_mode (port) Return the port modes associated with the open port @var{port}. @@ -3303,7 +2990,6 @@ used only during port creation are not retained. @end deffn close-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:664 @deffn {Scheme Procedure} close-port port @deffnx {C Function} scm_close_port (port) Close the specified port object. Return @code{#t} if it @@ -3315,7 +3001,6 @@ descriptors. @end deffn close-input-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:692 @deffn {Scheme Procedure} close-input-port port @deffnx {C Function} scm_close_input_port (port) Close the specified input port object. The routine has no effect if @@ -3327,7 +3012,6 @@ which can close file descriptors. @end deffn close-output-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:707 @deffn {Scheme Procedure} close-output-port port @deffnx {C Function} scm_close_output_port (port) Close the specified output port object. The routine has no effect if @@ -3339,7 +3023,6 @@ which can close file descriptors. @end deffn port-for-each -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:724 @deffn {Scheme Procedure} port-for-each proc @deffnx {C Function} scm_port_for_each (proc) Apply @var{proc} to each port in the Guile port table @@ -3351,7 +3034,6 @@ have no effect as far as @var{port-for-each} is concerned. @end deffn input-port? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:765 @deffn {Scheme Procedure} input-port? x @deffnx {C Function} scm_input_port_p (x) Return @code{#t} if @var{x} is an input port, otherwise return @@ -3360,7 +3042,6 @@ Return @code{#t} if @var{x} is an input port, otherwise return @end deffn output-port? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:776 @deffn {Scheme Procedure} output-port? x @deffnx {C Function} scm_output_port_p (x) Return @code{#t} if @var{x} is an output port, otherwise return @@ -3369,7 +3050,6 @@ Return @code{#t} if @var{x} is an output port, otherwise return @end deffn port? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:788 @deffn {Scheme Procedure} port? x @deffnx {C Function} scm_port_p (x) Return a boolean indicating whether @var{x} is a port. @@ -3378,7 +3058,6 @@ Equivalent to @code{(or (input-port? @var{x}) (output-port? @end deffn port-closed? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:798 @deffn {Scheme Procedure} port-closed? port @deffnx {C Function} scm_port_closed_p (port) Return @code{#t} if @var{port} is closed or @code{#f} if it is @@ -3386,7 +3065,6 @@ open. @end deffn eof-object? -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:809 @deffn {Scheme Procedure} eof-object? x @deffnx {C Function} scm_eof_object_p (x) Return @code{#t} if @var{x} is an end-of-file object; otherwise @@ -3394,7 +3072,6 @@ return @code{#f}. @end deffn force-output -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:823 @deffn {Scheme Procedure} force-output [port] @deffnx {C Function} scm_force_output (port) Flush the specified output port, or the current output port if @var{port} @@ -3407,7 +3084,6 @@ The return value is unspecified. @end deffn flush-all-ports -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:841 @deffn {Scheme Procedure} flush-all-ports @deffnx {C Function} scm_flush_all_ports () Equivalent to calling @code{force-output} on @@ -3415,7 +3091,6 @@ all open output ports. The return value is unspecified. @end deffn read-char -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:859 @deffn {Scheme Procedure} read-char [port] @deffnx {C Function} scm_read_char (port) Return the next character available from @var{port}, updating @@ -3424,7 +3099,6 @@ characters are available, the end-of-file object is returned. @end deffn peek-char -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1185 @deffn {Scheme Procedure} peek-char [port] @deffnx {C Function} scm_peek_char (port) Return the next character available from @var{port}, @@ -3442,7 +3116,6 @@ to @code{read-char} would have hung.} @end deffn unread-char -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1206 @deffn {Scheme Procedure} unread-char cobj [port] @deffnx {C Function} scm_unread_char (cobj, port) Place @var{char} in @var{port} so that it will be read by the @@ -3452,7 +3125,6 @@ not supplied, the current input port is used. @end deffn unread-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1229 @deffn {Scheme Procedure} unread-string str port @deffnx {C Function} scm_unread_string (str, port) Place the string @var{str} in @var{port} so that its characters will be @@ -3462,7 +3134,6 @@ unread characters will be read again in last-in first-out order. If @end deffn seek -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1268 @deffn {Scheme Procedure} seek fd_port offset whence @deffnx {C Function} scm_seek (fd_port, offset, whence) Sets the current position of @var{fd/port} to the integer @@ -3491,7 +3162,6 @@ that the current position of a port can be obtained using: @end deffn truncate-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1323 @deffn {Scheme Procedure} truncate-file object [length] @deffnx {C Function} scm_truncate_file (object, length) Truncates the object referred to by @var{object} to at most @@ -3503,21 +3173,18 @@ position. The return value is unspecified. @end deffn port-line -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1376 @deffn {Scheme Procedure} port-line port @deffnx {C Function} scm_port_line (port) Return the current line number for @var{port}. @end deffn set-port-line! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1387 @deffn {Scheme Procedure} set-port-line! port line @deffnx {C Function} scm_set_port_line_x (port, line) Set the current line number for @var{port} to @var{line}. @end deffn port-column -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1408 @deffn {Scheme Procedure} port-column port @deffnx {Scheme Procedure} port-line port @deffnx {C Function} scm_port_column (port) @@ -3532,7 +3199,6 @@ what non-programmers will find most natural.) @end deffn set-port-column! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1421 @deffn {Scheme Procedure} set-port-column! port column @deffnx {Scheme Procedure} set-port-line! port line @deffnx {C Function} scm_set_port_column_x (port, column) @@ -3541,7 +3207,6 @@ current input port if none is specified. @end deffn port-filename -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1436 @deffn {Scheme Procedure} port-filename port @deffnx {C Function} scm_port_filename (port) Return the filename associated with @var{port}. This function returns @@ -3550,7 +3215,6 @@ when called on the current input, output and error ports respectively. @end deffn set-port-filename! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1450 @deffn {Scheme Procedure} set-port-filename! port filename @deffnx {C Function} scm_set_port_filename_x (port, filename) Change the filename associated with @var{port}, using the current input @@ -3560,7 +3224,6 @@ source of data, but only the value that is returned by @end deffn %make-void-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/ports.c:1546 @deffn {Scheme Procedure} %make-void-port mode @deffnx {C Function} scm_sys_make_void_port (mode) Create and return a new void port. A void port acts like @@ -3570,7 +3233,6 @@ documentation for @code{open-file} in @ref{File Ports}. @end deffn print-options-interface -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:142 @deffn {Scheme Procedure} print-options-interface [setting] @deffnx {C Function} scm_print_options (setting) Option interface for the print options. Instead of using @@ -3580,7 +3242,6 @@ and @code{print-options}. @end deffn simple-format -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:920 @deffn {Scheme Procedure} simple-format destination message . args @deffnx {C Function} scm_simple_format (destination, message, args) Write @var{message} to @var{destination}, defaulting to @@ -3597,7 +3258,6 @@ containing the formatted text. Does not add a trailing newline. @end deffn newline -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1008 @deffn {Scheme Procedure} newline [port] @deffnx {C Function} scm_newline (port) Send a newline to @var{port}. @@ -3605,14 +3265,12 @@ If @var{port} is omitted, send to the current output port. @end deffn write-char -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1023 @deffn {Scheme Procedure} write-char chr [port] @deffnx {C Function} scm_write_char (chr, port) Send character @var{chr} to @var{port}. @end deffn port-with-print-state -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1077 @deffn {Scheme Procedure} port-with-print-state port pstate @deffnx {C Function} scm_port_with_print_state (port, pstate) Create a new port which behaves like @var{port}, but with an @@ -3620,7 +3278,6 @@ included print state @var{pstate}. @end deffn get-print-state -@c snarfed from /home/ghouston/guile/guile-core/libguile/print.c:1092 @deffn {Scheme Procedure} get-print-state port @deffnx {C Function} scm_get_print_state (port) Return the print state of the port @var{port}. If @var{port} @@ -3628,28 +3285,24 @@ has no associated print state, @code{#f} is returned. @end deffn procedure-properties -@c snarfed from /home/ghouston/guile/guile-core/libguile/procprop.c:176 @deffn {Scheme Procedure} procedure-properties proc @deffnx {C Function} scm_procedure_properties (proc) Return @var{obj}'s property list. @end deffn set-procedure-properties! -@c snarfed from /home/ghouston/guile/guile-core/libguile/procprop.c:189 @deffn {Scheme Procedure} set-procedure-properties! proc new_val @deffnx {C Function} scm_set_procedure_properties_x (proc, new_val) Set @var{obj}'s property list to @var{alist}. @end deffn procedure-property -@c snarfed from /home/ghouston/guile/guile-core/libguile/procprop.c:202 @deffn {Scheme Procedure} procedure-property p k @deffnx {C Function} scm_procedure_property (p, k) Return the property of @var{obj} with name @var{key}. @end deffn set-procedure-property! -@c snarfed from /home/ghouston/guile/guile-core/libguile/procprop.c:225 @deffn {Scheme Procedure} set-procedure-property! p k v @deffnx {C Function} scm_set_procedure_property_x (p, k, v) In @var{obj}'s property list, set the property named @var{key} to @@ -3657,28 +3310,24 @@ In @var{obj}'s property list, set the property named @var{key} to @end deffn procedure? -@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:186 @deffn {Scheme Procedure} procedure? obj @deffnx {C Function} scm_procedure_p (obj) Return @code{#t} if @var{obj} is a procedure. @end deffn closure? -@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:213 @deffn {Scheme Procedure} closure? obj @deffnx {C Function} scm_closure_p (obj) Return @code{#t} if @var{obj} is a closure. @end deffn thunk? -@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:222 @deffn {Scheme Procedure} thunk? obj @deffnx {C Function} scm_thunk_p (obj) Return @code{#t} if @var{obj} is a thunk. @end deffn procedure-documentation -@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:272 @deffn {Scheme Procedure} procedure-documentation proc @deffnx {C Function} scm_procedure_documentation (proc) Return the documentation string associated with @code{proc}. By @@ -3688,7 +3337,6 @@ documentation for that procedure. @end deffn procedure-with-setter? -@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:308 @deffn {Scheme Procedure} procedure-with-setter? obj @deffnx {C Function} scm_procedure_with_setter_p (obj) Return @code{#t} if @var{obj} is a procedure with an @@ -3696,7 +3344,6 @@ associated setter procedure. @end deffn make-procedure-with-setter -@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:318 @deffn {Scheme Procedure} make-procedure-with-setter procedure setter @deffnx {C Function} scm_make_procedure_with_setter (procedure, setter) Create a new procedure which behaves like @var{procedure}, but @@ -3704,7 +3351,6 @@ with the associated setter @var{setter}. @end deffn procedure -@c snarfed from /home/ghouston/guile/guile-core/libguile/procs.c:332 @deffn {Scheme Procedure} procedure proc @deffnx {C Function} scm_procedure (proc) Return the procedure of @var{proc}, which must be either a @@ -3712,7 +3358,6 @@ procedure with setter, or an operator struct. @end deffn primitive-make-property -@c snarfed from /home/ghouston/guile/guile-core/libguile/properties.c:64 @deffn {Scheme Procedure} primitive-make-property not_found_proc @deffnx {C Function} scm_primitive_make_property (not_found_proc) Create a @dfn{property token} that can be used with @@ -3722,7 +3367,6 @@ See @code{primitive-property-ref} for the significance of @end deffn primitive-property-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/properties.c:82 @deffn {Scheme Procedure} primitive-property-ref prop obj @deffnx {C Function} scm_primitive_property_ref (prop, obj) Return the property @var{prop} of @var{obj}. When no value @@ -3735,21 +3379,18 @@ default value of @var{prop}. @end deffn primitive-property-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/properties.c:113 @deffn {Scheme Procedure} primitive-property-set! prop obj val @deffnx {C Function} scm_primitive_property_set_x (prop, obj, val) Associate @var{code} with @var{prop} and @var{obj}. @end deffn primitive-property-del! -@c snarfed from /home/ghouston/guile/guile-core/libguile/properties.c:134 @deffn {Scheme Procedure} primitive-property-del! prop obj @deffnx {C Function} scm_primitive_property_del_x (prop, obj) Remove any value associated with @var{prop} and @var{obj}. @end deffn random -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:376 @deffn {Scheme Procedure} random n [state] @deffnx {C Function} scm_random (n, state) Return a number in [0, N). @@ -3767,21 +3408,18 @@ as a side effect of the random operation. @end deffn copy-random-state -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:399 @deffn {Scheme Procedure} copy-random-state [state] @deffnx {C Function} scm_copy_random_state (state) Return a copy of the random state @var{state}. @end deffn seed->random-state -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:411 @deffn {Scheme Procedure} seed->random-state seed @deffnx {C Function} scm_seed_to_random_state (seed) Return a new random state using @var{seed}. @end deffn random:uniform -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:425 @deffn {Scheme Procedure} random:uniform [state] @deffnx {C Function} scm_random_uniform (state) Return a uniformly distributed inexact real random number in @@ -3789,7 +3427,6 @@ Return a uniformly distributed inexact real random number in @end deffn random:normal -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:440 @deffn {Scheme Procedure} random:normal [state] @deffnx {C Function} scm_random_normal (state) Return an inexact real in a normal distribution. The @@ -3799,7 +3436,6 @@ normal distribution with mean m and standard deviation d use @end deffn random:solid-sphere! -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:496 @deffn {Scheme Procedure} random:solid-sphere! v [state] @deffnx {C Function} scm_random_solid_sphere_x (v, state) Fills vect with inexact real random numbers @@ -3811,7 +3447,6 @@ The sum of the squares of the numbers is returned. @end deffn random:hollow-sphere! -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:519 @deffn {Scheme Procedure} random:hollow-sphere! v [state] @deffnx {C Function} scm_random_hollow_sphere_x (v, state) Fills vect with inexact real random numbers @@ -3823,7 +3458,6 @@ unit n-sphere. @end deffn random:normal-vector! -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:537 @deffn {Scheme Procedure} random:normal-vector! v [state] @deffnx {C Function} scm_random_normal_vector_x (v, state) Fills vect with inexact real random numbers that are @@ -3832,7 +3466,6 @@ independent and standard normally distributed @end deffn random:exp -@c snarfed from /home/ghouston/guile/guile-core/libguile/random.c:562 @deffn {Scheme Procedure} random:exp [state] @deffnx {C Function} scm_random_exp (state) Return an inexact real in an exponential distribution with mean @@ -3841,7 +3474,6 @@ Return an inexact real in an exponential distribution with mean @end deffn %read-delimited! -@c snarfed from /home/ghouston/guile/guile-core/libguile/rdelim.c:78 @deffn {Scheme Procedure} %read-delimited! delims str gobble [port [start [end]]] @deffnx {C Function} scm_read_delimited_x (delims, str, gobble, port, start, end) Read characters from @var{port} into @var{str} until one of the @@ -3862,7 +3494,6 @@ a delimiter, this value is @code{#f}. @end deffn %read-line -@c snarfed from /home/ghouston/guile/guile-core/libguile/rdelim.c:222 @deffn {Scheme Procedure} %read-line [port] @deffnx {C Function} scm_read_line (port) Read a newline-terminated line from @var{port}, allocating storage as @@ -3874,7 +3505,6 @@ delimiter may be either a newline or the @var{eof-object}; if @end deffn write-line -@c snarfed from /home/ghouston/guile/guile-core/libguile/rdelim.c:275 @deffn {Scheme Procedure} write-line obj [port] @deffnx {C Function} scm_write_line (obj, port) Display @var{obj} and a newline character to @var{port}. If @@ -3887,7 +3517,6 @@ used. This function is equivalent to: @end deffn read-options-interface -@c snarfed from /home/ghouston/guile/guile-core/libguile/read.c:82 @deffn {Scheme Procedure} read-options-interface [setting] @deffnx {C Function} scm_read_options (setting) Option interface for the read options. Instead of using @@ -3896,7 +3525,6 @@ this procedure directly, use the procedures @code{read-enable}, @end deffn read -@c snarfed from /home/ghouston/guile/guile-core/libguile/read.c:102 @deffn {Scheme Procedure} read [port] @deffnx {C Function} scm_read (port) Read an s-expression from the input port @var{port}, or from @@ -3905,7 +3533,6 @@ Any whitespace before the next token is discarded. @end deffn read-hash-extend -@c snarfed from /home/ghouston/guile/guile-core/libguile/read.c:769 @deffn {Scheme Procedure} read-hash-extend chr proc @deffnx {C Function} scm_read_hash_extend (chr, proc) Install the procedure @var{proc} for reading expressions @@ -3916,7 +3543,6 @@ returned will be the return value of @code{read}. @end deffn call-with-dynamic-root -@c snarfed from /home/ghouston/guile/guile-core/libguile/root.c:346 @deffn {Scheme Procedure} call-with-dynamic-root thunk handler @deffnx {C Function} scm_call_with_dynamic_root (thunk, handler) Evaluate @code{(thunk)} in a new dynamic context, returning its value. @@ -3964,7 +3590,6 @@ be under a new dynamic root.) @end deffn dynamic-root -@c snarfed from /home/ghouston/guile/guile-core/libguile/root.c:359 @deffn {Scheme Procedure} dynamic-root @deffnx {C Function} scm_dynamic_root () Return an object representing the current dynamic root. @@ -3975,7 +3600,6 @@ in no way depend on this. @end deffn read-string!/partial -@c snarfed from /home/ghouston/guile/guile-core/libguile/rw.c:121 @deffn {Scheme Procedure} read-string!/partial str [port_or_fdes [start [end]]] @deffnx {C Function} scm_read_string_x_partial (str, port_or_fdes, start, end) Read characters from a port or file descriptor into a @@ -4018,7 +3642,6 @@ end-of-file check. @end deffn write-string/partial -@c snarfed from /home/ghouston/guile/guile-core/libguile/rw.c:215 @deffn {Scheme Procedure} write-string/partial str [port_or_fdes [start [end]]] @deffnx {C Function} scm_write_string_partial (str, port_or_fdes, start, end) Write characters from a string @var{str} to a port or file @@ -4065,27 +3688,29 @@ return 0 immediately if the request size is 0 bytes. @end deffn sigaction -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:182 -@deffn {Scheme Procedure} sigaction signum [handler [flags]] -@deffnx {C Function} scm_sigaction (signum, handler, flags) +@deffn {Scheme Procedure} sigaction signum [handler [flags [thread]]] +@deffnx {C Function} scm_sigaction_for_thread (signum, handler, flags, thread) Install or report the signal handler for a specified signal. @var{signum} is the signal number, which can be specified using the value of variables such as @code{SIGINT}. -If @var{action} is omitted, @code{sigaction} returns a pair: the +If @var{handler} is omitted, @code{sigaction} returns a pair: the CAR is the current signal hander, which will be either an integer with the value @code{SIG_DFL} (default action) or @code{SIG_IGN} (ignore), or the Scheme procedure which handles the signal, or @code{#f} if a non-Scheme procedure handles the signal. The CDR contains the current @code{sigaction} flags for the handler. -If @var{action} is provided, it is installed as the new handler for -@var{signum}. @var{action} can be a Scheme procedure taking one +If @var{handler} is provided, it is installed as the new handler for +@var{signum}. @var{handler} can be a Scheme procedure taking one argument, or the value of @code{SIG_DFL} (default action) or @code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler -was installed before @code{sigaction} was first used. Flags can -optionally be specified for the new handler (@code{SA_RESTART} will +was installed before @code{sigaction} was first used. When +a scheme procedure has been specified, that procedure will run +in the given @var{thread}. When no thread has been given, the +thread that made this call to @code{sigaction} is used. +Flags can optionally be specified for the new handler (@code{SA_RESTART} will always be added if it's available and the system is using restartable system calls.) The return value is a pair with information about the old handler as described above. @@ -4097,7 +3722,6 @@ structures. @end deffn restore-signals -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:346 @deffn {Scheme Procedure} restore-signals @deffnx {C Function} scm_restore_signals () Return all signal handlers to the values they had before any call to @@ -4105,7 +3729,6 @@ Return all signal handlers to the values they had before any call to @end deffn alarm -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:383 @deffn {Scheme Procedure} alarm i @deffnx {C Function} scm_alarm (i) Set a timer to raise a @code{SIGALRM} signal after the specified @@ -4120,7 +3743,6 @@ no previous alarm, the return value is zero. @end deffn setitimer -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:413 @deffn {Scheme Procedure} setitimer which_timer interval_seconds interval_microseconds value_seconds value_microseconds @deffnx {C Function} scm_setitimer (which_timer, interval_seconds, interval_microseconds, value_seconds, value_microseconds) Set the timer specified by @var{which_timer} according to the given @@ -4141,7 +3763,6 @@ the seconds and microseconds of the timer @code{it_value}. @end deffn getitimer -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:454 @deffn {Scheme Procedure} getitimer which_timer @deffnx {C Function} scm_getitimer (which_timer) Return information about the timer specified by @var{which_timer} @@ -4158,7 +3779,6 @@ the seconds and microseconds of the timer @code{it_value}. @end deffn pause -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:481 @deffn {Scheme Procedure} pause @deffnx {C Function} scm_pause () Pause the current process (thread?) until a signal arrives whose @@ -4167,7 +3787,6 @@ handler procedure. The return value is unspecified. @end deffn sleep -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:494 @deffn {Scheme Procedure} sleep i @deffnx {C Function} scm_sleep (i) Wait for the given number of seconds (an integer) or until a signal @@ -4176,7 +3795,6 @@ of seconds remaining otherwise. @end deffn usleep -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:512 @deffn {Scheme Procedure} usleep i @deffnx {C Function} scm_usleep (i) Sleep for I microseconds. @code{usleep} is not available on @@ -4184,7 +3802,6 @@ all platforms. @end deffn raise -@c snarfed from /home/ghouston/guile/guile-core/libguile/scmsigs.c:541 @deffn {Scheme Procedure} raise sig @deffnx {C Function} scm_raise (sig) Sends a specified signal @var{sig} to the current process, where @@ -4192,7 +3809,6 @@ Sends a specified signal @var{sig} to the current process, where @end deffn system -@c snarfed from /home/ghouston/guile/guile-core/libguile/simpos.c:76 @deffn {Scheme Procedure} system [cmd] @deffnx {C Function} scm_system (cmd) Execute @var{cmd} using the operating system's "command @@ -4206,7 +3822,6 @@ indicating whether the command processor is available. @end deffn getenv -@c snarfed from /home/ghouston/guile/guile-core/libguile/simpos.c:103 @deffn {Scheme Procedure} getenv nam @deffnx {C Function} scm_getenv (nam) Looks up the string @var{name} in the current environment. The return @@ -4215,7 +3830,6 @@ found, in which case the string @code{VALUE} is returned. @end deffn primitive-exit -@c snarfed from /home/ghouston/guile/guile-core/libguile/simpos.c:118 @deffn {Scheme Procedure} primitive-exit [status] @deffnx {C Function} scm_primitive_exit (status) Terminate the current process without unwinding the Scheme stack. @@ -4224,7 +3838,6 @@ is @var{status} if supplied, otherwise zero. @end deffn restricted-vector-sort! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:422 @deffn {Scheme Procedure} restricted-vector-sort! vec less startpos endpos @deffnx {C Function} scm_restricted_vector_sort_x (vec, less, startpos, endpos) Sort the vector @var{vec}, using @var{less} for comparing @@ -4234,7 +3847,6 @@ is not specified. @end deffn sorted? -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:454 @deffn {Scheme Procedure} sorted? items less @deffnx {C Function} scm_sorted_p (items, less) Return @code{#t} iff @var{items} is a list or a vector such that @@ -4243,7 +3855,6 @@ applied to all elements i - 1 and i @end deffn merge -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:527 @deffn {Scheme Procedure} merge alist blist less @deffnx {C Function} scm_merge (alist, blist, less) Merge two already sorted lists into one. @@ -4256,7 +3867,6 @@ Note: this does _not_ accept vectors. @end deffn merge! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:640 @deffn {Scheme Procedure} merge! alist blist less @deffnx {C Function} scm_merge_x (alist, blist, less) Takes two lists @var{alist} and @var{blist} such that @@ -4269,7 +3879,6 @@ Note: this does _not_ accept vectors. @end deffn sort! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:716 @deffn {Scheme Procedure} sort! items less @deffnx {C Function} scm_sort_x (items, less) Sort the sequence @var{items}, which may be a list or a @@ -4280,7 +3889,6 @@ This is not a stable sort. @end deffn sort -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:750 @deffn {Scheme Procedure} sort items less @deffnx {C Function} scm_sort (items, less) Sort the sequence @var{items}, which may be a list or a @@ -4289,7 +3897,6 @@ elements. This is not a stable sort. @end deffn stable-sort! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:858 @deffn {Scheme Procedure} stable-sort! items less @deffnx {C Function} scm_stable_sort_x (items, less) Sort the sequence @var{items}, which may be a list or a @@ -4300,7 +3907,6 @@ This is a stable sort. @end deffn stable-sort -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:902 @deffn {Scheme Procedure} stable-sort items less @deffnx {C Function} scm_stable_sort (items, less) Sort the sequence @var{items}, which may be a list or a @@ -4309,7 +3915,6 @@ This is a stable sort. @end deffn sort-list! -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:947 @deffn {Scheme Procedure} sort-list! items less @deffnx {C Function} scm_sort_list_x (items, less) Sort the list @var{items}, using @var{less} for comparing the @@ -4319,7 +3924,6 @@ This is a stable sort. @end deffn sort-list -@c snarfed from /home/ghouston/guile/guile-core/libguile/sort.c:961 @deffn {Scheme Procedure} sort-list items less @deffnx {C Function} scm_sort_list (items, less) Sort the list @var{items}, using @var{less} for comparing the @@ -4327,14 +3931,12 @@ list elements. This is a stable sort. @end deffn source-properties -@c snarfed from /home/ghouston/guile/guile-core/libguile/srcprop.c:178 @deffn {Scheme Procedure} source-properties obj @deffnx {C Function} scm_source_properties (obj) Return the source property association list of @var{obj}. @end deffn set-source-properties! -@c snarfed from /home/ghouston/guile/guile-core/libguile/srcprop.c:199 @deffn {Scheme Procedure} set-source-properties! obj plist @deffnx {C Function} scm_set_source_properties_x (obj, plist) Install the association list @var{plist} as the source property @@ -4342,7 +3944,6 @@ list for @var{obj}. @end deffn source-property -@c snarfed from /home/ghouston/guile/guile-core/libguile/srcprop.c:217 @deffn {Scheme Procedure} source-property obj key @deffnx {C Function} scm_source_property (obj, key) Return the source property specified by @var{key} from @@ -4350,7 +3951,6 @@ Return the source property specified by @var{key} from @end deffn set-source-property! -@c snarfed from /home/ghouston/guile/guile-core/libguile/srcprop.c:248 @deffn {Scheme Procedure} set-source-property! obj key datum @deffnx {C Function} scm_set_source_property_x (obj, key, datum) Set the source property of object @var{obj}, which is specified by @@ -4358,14 +3958,12 @@ Set the source property of object @var{obj}, which is specified by @end deffn stack? -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:411 @deffn {Scheme Procedure} stack? obj @deffnx {C Function} scm_stack_p (obj) Return @code{#t} if @var{obj} is a calling stack. @end deffn make-stack -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:442 @deffn {Scheme Procedure} make-stack obj . args @deffnx {C Function} scm_make_stack (obj, args) Create a new stack. If @var{obj} is @code{#t}, the current @@ -4399,35 +3997,30 @@ taken as 0. @end deffn stack-id -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:534 @deffn {Scheme Procedure} stack-id stack @deffnx {C Function} scm_stack_id (stack) Return the identifier given to @var{stack} by @code{start-stack}. @end deffn stack-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:575 @deffn {Scheme Procedure} stack-ref stack index @deffnx {C Function} scm_stack_ref (stack, index) Return the @var{index}'th frame from @var{stack}. @end deffn stack-length -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:591 @deffn {Scheme Procedure} stack-length stack @deffnx {C Function} scm_stack_length (stack) Return the length of @var{stack}. @end deffn frame? -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:604 @deffn {Scheme Procedure} frame? obj @deffnx {C Function} scm_frame_p (obj) Return @code{#t} if @var{obj} is a stack frame. @end deffn last-stack-frame -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:615 @deffn {Scheme Procedure} last-stack-frame obj @deffnx {C Function} scm_last_stack_frame (obj) Return a stack which consists of a single frame, which is the @@ -4436,21 +4029,18 @@ debug object or a continuation. @end deffn frame-number -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:657 @deffn {Scheme Procedure} frame-number frame @deffnx {C Function} scm_frame_number (frame) Return the frame number of @var{frame}. @end deffn frame-source -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:667 @deffn {Scheme Procedure} frame-source frame @deffnx {C Function} scm_frame_source (frame) Return the source of @var{frame}. @end deffn frame-procedure -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:678 @deffn {Scheme Procedure} frame-procedure frame @deffnx {C Function} scm_frame_procedure (frame) Return the procedure for @var{frame}, or @code{#f} if no @@ -4458,14 +4048,12 @@ procedure is associated with @var{frame}. @end deffn frame-arguments -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:690 @deffn {Scheme Procedure} frame-arguments frame @deffnx {C Function} scm_frame_arguments (frame) Return the arguments of @var{frame}. @end deffn frame-previous -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:701 @deffn {Scheme Procedure} frame-previous frame @deffnx {C Function} scm_frame_previous (frame) Return the previous frame of @var{frame}, or @code{#f} if @@ -4473,7 +4061,6 @@ Return the previous frame of @var{frame}, or @code{#f} if @end deffn frame-next -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:717 @deffn {Scheme Procedure} frame-next frame @deffnx {C Function} scm_frame_next (frame) Return the next frame of @var{frame}, or @code{#f} if @@ -4481,35 +4068,30 @@ Return the next frame of @var{frame}, or @code{#f} if @end deffn frame-real? -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:732 @deffn {Scheme Procedure} frame-real? frame @deffnx {C Function} scm_frame_real_p (frame) Return @code{#t} if @var{frame} is a real frame. @end deffn frame-procedure? -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:742 @deffn {Scheme Procedure} frame-procedure? frame @deffnx {C Function} scm_frame_procedure_p (frame) Return @code{#t} if a procedure is associated with @var{frame}. @end deffn frame-evaluating-args? -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:752 @deffn {Scheme Procedure} frame-evaluating-args? frame @deffnx {C Function} scm_frame_evaluating_args_p (frame) Return @code{#t} if @var{frame} contains evaluated arguments. @end deffn frame-overflow? -@c snarfed from /home/ghouston/guile/guile-core/libguile/stacks.c:762 @deffn {Scheme Procedure} frame-overflow? frame @deffnx {C Function} scm_frame_overflow_p (frame) Return @code{#t} if @var{frame} is an overflow frame. @end deffn get-internal-real-time -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:143 @deffn {Scheme Procedure} get-internal-real-time @deffnx {C Function} scm_get_internal_real_time () Return the number of time units since the interpreter was @@ -4517,7 +4099,6 @@ started. @end deffn times -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:188 @deffn {Scheme Procedure} times @deffnx {C Function} scm_times () Return an object with information about real and processor @@ -4544,7 +4125,6 @@ terminated child processes. @end deffn get-internal-run-time -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:220 @deffn {Scheme Procedure} get-internal-run-time @deffnx {C Function} scm_get_internal_run_time () Return the number of time units of processor time used by the @@ -4553,7 +4133,6 @@ included but subprocesses are not. @end deffn current-time -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:230 @deffn {Scheme Procedure} current-time @deffnx {C Function} scm_current_time () Return the number of seconds since 1970-01-01 00:00:00 UTC, @@ -4561,7 +4140,6 @@ excluding leap seconds. @end deffn gettimeofday -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:248 @deffn {Scheme Procedure} gettimeofday @deffnx {C Function} scm_gettimeofday () Return a pair containing the number of seconds and microseconds @@ -4571,7 +4149,6 @@ operating system. @end deffn localtime -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:347 @deffn {Scheme Procedure} localtime time [zone] @deffnx {C Function} scm_localtime (time, zone) Return an object representing the broken down components of @@ -4582,7 +4159,6 @@ optionally specified by @var{zone} (a string), otherwise the @end deffn gmtime -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:420 @deffn {Scheme Procedure} gmtime time @deffnx {C Function} scm_gmtime (time) Return an object representing the broken down components of @@ -4591,7 +4167,6 @@ Return an object representing the broken down components of @end deffn mktime -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:482 @deffn {Scheme Procedure} mktime sbd_time [zone] @deffnx {C Function} scm_mktime (sbd_time, zone) @var{bd-time} is an object representing broken down time and @code{zone} @@ -4605,7 +4180,6 @@ as @var{bd-time} but with normalized values. @end deffn tzset -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:556 @deffn {Scheme Procedure} tzset @deffnx {C Function} scm_tzset () Initialize the timezone from the TZ environment variable @@ -4615,7 +4189,6 @@ timezone. @end deffn strftime -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:573 @deffn {Scheme Procedure} strftime format stime @deffnx {C Function} scm_strftime (format, stime) Formats a time specification @var{time} using @var{template}. @var{time} @@ -4628,7 +4201,6 @@ is the formatted string. @end deffn strptime -@c snarfed from /home/ghouston/guile/guile-core/libguile/stime.c:670 @deffn {Scheme Procedure} strptime format string @deffnx {C Function} scm_strptime (format, string) Performs the reverse action to @code{strftime}, parsing @@ -4644,20 +4216,17 @@ which were used for the conversion. @end deffn string? -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:61 @deffn {Scheme Procedure} string? obj @deffnx {C Function} scm_string_p (obj) Return @code{#t} if @var{obj} is a string, else @code{#f}. @end deffn list->string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:69 @deffn {Scheme Procedure} list->string implemented by the C function "scm_string" @end deffn string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:75 @deffn {Scheme Procedure} string . chrs @deffnx {Scheme Procedure} list->string chrs @deffnx {C Function} scm_string (chrs) @@ -4666,7 +4235,6 @@ Return a newly allocated string composed of the arguments, @end deffn make-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:209 @deffn {Scheme Procedure} make-string k [chr] @deffnx {C Function} scm_make_string (k, chr) Return a newly allocated string of @@ -4676,14 +4244,12 @@ of the @var{string} are unspecified. @end deffn string-length -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:242 @deffn {Scheme Procedure} string-length string @deffnx {C Function} scm_string_length (string) Return the number of characters in @var{string}. @end deffn string-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:253 @deffn {Scheme Procedure} string-ref str k @deffnx {C Function} scm_string_ref (str, k) Return character @var{k} of @var{str} using zero-origin @@ -4691,7 +4257,6 @@ indexing. @var{k} must be a valid index of @var{str}. @end deffn string-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:270 @deffn {Scheme Procedure} string-set! str k chr @deffnx {C Function} scm_string_set_x (str, k, chr) Store @var{chr} in element @var{k} of @var{str} and return @@ -4700,7 +4265,6 @@ an unspecified value. @var{k} must be a valid index of @end deffn substring -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:289 @deffn {Scheme Procedure} substring str start [end] @deffnx {C Function} scm_substring (str, start, end) Return a newly allocated string formed from the characters @@ -4713,7 +4277,6 @@ exact integers satisfying: @end deffn string-append -@c snarfed from /home/ghouston/guile/guile-core/libguile/strings.c:315 @deffn {Scheme Procedure} string-append . args @deffnx {C Function} scm_string_append (args) Return a newly allocated string whose characters form the @@ -4721,7 +4284,6 @@ concatenation of the given strings, @var{args}. @end deffn string-index -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:138 @deffn {Scheme Procedure} string-index str chr [frm [to]] @deffnx {C Function} scm_string_index (str, chr, frm, to) Return the index of the first occurrence of @var{chr} in @@ -4743,7 +4305,6 @@ procedure essentially implements the @code{index} or @end deffn string-rindex -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:168 @deffn {Scheme Procedure} string-rindex str chr [frm [to]] @deffnx {C Function} scm_string_rindex (str, chr, frm, to) Like @code{string-index}, but search from the right of the @@ -4764,7 +4325,6 @@ the C library. @end deffn substring-move! -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:188 @deffn {Scheme Procedure} substring-move! str1 start1 end1 str2 start2 @deffnx {C Function} scm_substring_move_x (str1, start1, end1, str2, start2) Copy the substring of @var{str1} bounded by @var{start1} and @var{end1} @@ -4773,7 +4333,6 @@ into @var{str2} beginning at position @var{start2}. @end deffn substring-fill! -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:224 @deffn {Scheme Procedure} substring-fill! str start end fill @deffnx {C Function} scm_substring_fill_x (str, start, end, fill) Change every character in @var{str} between @var{start} and @@ -4788,7 +4347,6 @@ y @end deffn string-null? -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:249 @deffn {Scheme Procedure} string-null? str @deffnx {C Function} scm_string_null_p (str) Return @code{#t} if @var{str}'s length is zero, and @@ -4801,7 +4359,6 @@ y @result{} "foo" @end deffn string->list -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:263 @deffn {Scheme Procedure} string->list str @deffnx {C Function} scm_string_to_list (str) Return a newly allocated list of the characters that make up @@ -4811,14 +4368,12 @@ concerned. @end deffn string-copy -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:292 @deffn {Scheme Procedure} string-copy str @deffnx {C Function} scm_string_copy (str) Return a newly allocated copy of the given @var{string}. @end deffn string-fill! -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:305 @deffn {Scheme Procedure} string-fill! str chr @deffnx {C Function} scm_string_fill_x (str, chr) Store @var{char} in every element of the given @var{string} and @@ -4826,7 +4381,6 @@ return an unspecified value. @end deffn string-upcase! -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:340 @deffn {Scheme Procedure} string-upcase! str @deffnx {C Function} scm_string_upcase_x (str) Destructively upcase every character in @var{str} and return @@ -4839,7 +4393,6 @@ y @result{} "ARRDEFG" @end deffn string-upcase -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:353 @deffn {Scheme Procedure} string-upcase str @deffnx {C Function} scm_string_upcase (str) Return a freshly allocated string containing the characters of @@ -4847,7 +4400,6 @@ Return a freshly allocated string containing the characters of @end deffn string-downcase! -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:385 @deffn {Scheme Procedure} string-downcase! str @deffnx {C Function} scm_string_downcase_x (str) Destructively downcase every character in @var{str} and return @@ -4860,7 +4412,6 @@ y @result{} "arrdefg" @end deffn string-downcase -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:398 @deffn {Scheme Procedure} string-downcase str @deffnx {C Function} scm_string_downcase (str) Return a freshly allocation string containing the characters in @@ -4868,7 +4419,6 @@ Return a freshly allocation string containing the characters in @end deffn string-capitalize! -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:443 @deffn {Scheme Procedure} string-capitalize! str @deffnx {C Function} scm_string_capitalize_x (str) Upcase the first character of every word in @var{str} @@ -4882,7 +4432,6 @@ y @result{} "Hello World" @end deffn string-capitalize -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:457 @deffn {Scheme Procedure} string-capitalize str @deffnx {C Function} scm_string_capitalize (str) Return a freshly allocated string with the characters in @@ -4891,7 +4440,6 @@ capitalized. @end deffn string-split -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:486 @deffn {Scheme Procedure} string-split str chr @deffnx {C Function} scm_string_split (str, chr) Split the string @var{str} into the a list of the substrings delimited @@ -4915,7 +4463,6 @@ result list. @end deffn string-ci->symbol -@c snarfed from /home/ghouston/guile/guile-core/libguile/strop.c:521 @deffn {Scheme Procedure} string-ci->symbol str @deffnx {C Function} scm_string_ci_to_symbol (str) Return the symbol whose name is @var{str}. @var{str} is @@ -4924,7 +4471,6 @@ is currently reading symbols case-insensitively. @end deffn string=? -@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:62 @deffn {Scheme Procedure} string=? s1 s2 Lexicographic equality predicate; return @code{#t} if the two strings are the same length and contain the same characters in @@ -4937,7 +4483,6 @@ characters. @end deffn string-ci=? -@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:97 @deffn {Scheme Procedure} string-ci=? s1 s2 Case-insensitive string equality predicate; return @code{#t} if the two strings are the same length and their component @@ -4946,35 +4491,30 @@ return @code{#f}. @end deffn string? -@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:182 @deffn {Scheme Procedure} string>? s1 s2 Lexicographic ordering predicate; return @code{#t} if @var{s1} is lexicographically greater than @var{s2}. @end deffn string>=? -@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:196 @deffn {Scheme Procedure} string>=? s1 s2 Lexicographic ordering predicate; return @code{#t} if @var{s1} is lexicographically greater than or equal to @var{s2}. @end deffn string-ci? -@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:265 @deffn {Scheme Procedure} string-ci>? s1 s2 Case insensitive lexicographic ordering predicate; return @code{#t} if @var{s1} is lexicographically greater than @@ -4998,7 +4536,6 @@ Case insensitive lexicographic ordering predicate; return @end deffn string-ci>=? -@c snarfed from /home/ghouston/guile/guile-core/libguile/strorder.c:280 @deffn {Scheme Procedure} string-ci>=? s1 s2 Case insensitive lexicographic ordering predicate; return @code{#t} if @var{s1} is lexicographically greater than or @@ -5006,7 +4543,6 @@ equal to @var{s2} regardless of case. @end deffn object->string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:325 @deffn {Scheme Procedure} object->string obj [printer] @deffnx {C Function} scm_object_to_string (obj, printer) Return a Scheme string obtained by printing @var{obj}. @@ -5015,7 +4551,6 @@ argument @var{printer} (default: @code{write}). @end deffn call-with-output-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:349 @deffn {Scheme Procedure} call-with-output-string proc @deffnx {C Function} scm_call_with_output_string (proc) Calls the one-argument procedure @var{proc} with a newly created output @@ -5024,7 +4559,6 @@ written into the port is returned. @end deffn call-with-input-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:368 @deffn {Scheme Procedure} call-with-input-string string proc @deffnx {C Function} scm_call_with_input_string (string, proc) Calls the one-argument procedure @var{proc} with a newly @@ -5033,7 +4567,6 @@ read. The value yielded by the @var{proc} is returned. @end deffn open-input-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:381 @deffn {Scheme Procedure} open-input-string str @deffnx {C Function} scm_open_input_string (str) Take a string and return an input port that delivers characters @@ -5043,7 +4576,6 @@ by the garbage collector if it becomes inaccessible. @end deffn open-output-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:395 @deffn {Scheme Procedure} open-output-string @deffnx {C Function} scm_open_output_string () Return an output port that will accumulate characters for @@ -5054,7 +4586,6 @@ inaccessible. @end deffn get-output-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:412 @deffn {Scheme Procedure} get-output-string port @deffnx {C Function} scm_get_output_string (port) Given an output port created by @code{open-output-string}, @@ -5063,17 +4594,18 @@ output to the port so far. @end deffn eval-string -@c snarfed from /home/ghouston/guile/guile-core/libguile/strports.c:471 -@deffn {Scheme Procedure} eval-string string -@deffnx {C Function} scm_eval_string (string) +@deffn {Scheme Procedure} eval-string string [module] +@deffnx {C Function} scm_eval_string_in_module (string, module) Evaluate @var{string} as the text representation of a Scheme form or forms, and return whatever value they produce. -Evaluation takes place in the environment returned by the -procedure @code{interaction-environment}. +Evaluation takes place in the given module, or the current +module when no module is given. +While the code is evaluated, the given module is made the +current one. The current module is restored when this +procedure returns. @end deffn make-struct-layout -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:77 @deffn {Scheme Procedure} make-struct-layout fields @deffnx {C Function} scm_make_struct_layout (fields) Return a new structure layout object. @@ -5089,7 +4621,6 @@ indicate that the field is a tail-array. @end deffn struct? -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:244 @deffn {Scheme Procedure} struct? x @deffnx {C Function} scm_struct_p (x) Return @code{#t} iff @var{x} is a structure object, else @@ -5097,14 +4628,12 @@ Return @code{#t} iff @var{x} is a structure object, else @end deffn struct-vtable? -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:253 @deffn {Scheme Procedure} struct-vtable? x @deffnx {C Function} scm_struct_vtable_p (x) Return @code{#t} iff @var{x} is a vtable structure. @end deffn make-struct -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:434 @deffn {Scheme Procedure} make-struct vtable tail_array_size . init @deffnx {C Function} scm_make_struct (vtable, tail_array_size, init) Create a new structure. @@ -5135,7 +4664,6 @@ For more information, see the documentation for @code{make-vtable-vtable}. @end deffn make-vtable-vtable -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:519 @deffn {Scheme Procedure} make-vtable-vtable user_fields tail_array_size . init @deffnx {C Function} scm_make_vtable_vtable (user_fields, tail_array_size, init) Return a new, self-describing vtable structure. @@ -5197,7 +4725,6 @@ ball @result{} # @end deffn struct-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:560 @deffn {Scheme Procedure} struct-ref handle pos @deffnx {Scheme Procedure} struct-set! struct n value @deffnx {C Function} scm_struct_ref (handle, pos) @@ -5210,7 +4737,6 @@ integer value small enough to fit in one machine word. @end deffn struct-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:638 @deffn {Scheme Procedure} struct-set! handle pos val @deffnx {C Function} scm_struct_set_x (handle, pos, val) Set the slot of the structure @var{handle} with index @var{pos} @@ -5219,35 +4745,30 @@ to. @end deffn struct-vtable -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:708 @deffn {Scheme Procedure} struct-vtable handle @deffnx {C Function} scm_struct_vtable (handle) Return the vtable structure that describes the type of @var{struct}. @end deffn struct-vtable-tag -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:719 @deffn {Scheme Procedure} struct-vtable-tag handle @deffnx {C Function} scm_struct_vtable_tag (handle) Return the vtable tag of the structure @var{handle}. @end deffn struct-vtable-name -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:758 @deffn {Scheme Procedure} struct-vtable-name vtable @deffnx {C Function} scm_struct_vtable_name (vtable) Return the name of the vtable @var{vtable}. @end deffn set-struct-vtable-name! -@c snarfed from /home/ghouston/guile/guile-core/libguile/struct.c:768 @deffn {Scheme Procedure} set-struct-vtable-name! vtable name @deffnx {C Function} scm_set_struct_vtable_name_x (vtable, name) Set the name of the vtable @var{vtable} to @var{name}. @end deffn symbol? -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:159 @deffn {Scheme Procedure} symbol? obj @deffnx {C Function} scm_symbol_p (obj) Return @code{#t} if @var{obj} is a symbol, otherwise return @@ -5255,7 +4776,6 @@ Return @code{#t} if @var{obj} is a symbol, otherwise return @end deffn symbol-interned? -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:169 @deffn {Scheme Procedure} symbol-interned? symbol @deffnx {C Function} scm_symbol_interned_p (symbol) Return @code{#t} if @var{symbol} is interned, otherwise return @@ -5263,14 +4783,12 @@ Return @code{#t} if @var{symbol} is interned, otherwise return @end deffn make-symbol -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:181 @deffn {Scheme Procedure} make-symbol name @deffnx {C Function} scm_make_symbol (name) Return a new uninterned symbol with the name @var{name}. The returned symbol is guaranteed to be unique and future calls to @code{string->symbol} will not return it. @end deffn symbol->string -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:217 @deffn {Scheme Procedure} symbol->string s @deffnx {C Function} scm_symbol_to_string (s) Return the name of @var{symbol} as a string. If the symbol was @@ -5299,7 +4817,6 @@ standard case is lower case: @end deffn string->symbol -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:250 @deffn {Scheme Procedure} string->symbol string @deffnx {C Function} scm_string_to_symbol (string) Return the symbol whose name is @var{string}. This procedure @@ -5325,7 +4842,6 @@ standard case is lower case: @end deffn gensym -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:272 @deffn {Scheme Procedure} gensym [prefix] @deffnx {C Function} scm_gensym (prefix) Create a new symbol with a name constructed from a prefix and @@ -5336,42 +4852,36 @@ resetting the counter. @end deffn symbol-hash -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:304 @deffn {Scheme Procedure} symbol-hash symbol @deffnx {C Function} scm_symbol_hash (symbol) Return a hash value for @var{symbol}. @end deffn symbol-fref -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:314 @deffn {Scheme Procedure} symbol-fref s @deffnx {C Function} scm_symbol_fref (s) Return the contents of @var{symbol}'s @dfn{function slot}. @end deffn symbol-pref -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:325 @deffn {Scheme Procedure} symbol-pref s @deffnx {C Function} scm_symbol_pref (s) Return the @dfn{property list} currently associated with @var{symbol}. @end deffn symbol-fset! -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:336 @deffn {Scheme Procedure} symbol-fset! s val @deffnx {C Function} scm_symbol_fset_x (s, val) Change the binding of @var{symbol}'s function slot. @end deffn symbol-pset! -@c snarfed from /home/ghouston/guile/guile-core/libguile/symbols.c:348 @deffn {Scheme Procedure} symbol-pset! s val @deffnx {C Function} scm_symbol_pset_x (s, val) Change the binding of @var{symbol}'s property slot. @end deffn catch -@c snarfed from /home/ghouston/guile/guile-core/libguile/throw.c:534 @deffn {Scheme Procedure} catch key thunk handler @deffnx {C Function} scm_catch (key, thunk, handler) Invoke @var{thunk} in the dynamic context of @var{handler} for @@ -5395,7 +4905,6 @@ match this call to @code{catch}. @end deffn lazy-catch -@c snarfed from /home/ghouston/guile/guile-core/libguile/throw.c:562 @deffn {Scheme Procedure} lazy-catch key thunk handler @deffnx {C Function} scm_lazy_catch (key, thunk, handler) This behaves exactly like @code{catch}, except that it does @@ -5405,7 +4914,6 @@ it must throw to another catch, or otherwise exit non-locally. @end deffn throw -@c snarfed from /home/ghouston/guile/guile-core/libguile/throw.c:595 @deffn {Scheme Procedure} throw key . args @deffnx {C Function} scm_throw (key, args) Invoke the catch form matching @var{key}, passing @var{args} to the @@ -5418,7 +4926,6 @@ If there is no handler at all, Guile prints an error and then exits. @end deffn values -@c snarfed from /home/ghouston/guile/guile-core/libguile/values.c:77 @deffn {Scheme Procedure} values . args @deffnx {C Function} scm_values (args) Delivers all of its arguments to its continuation. Except for @@ -5429,21 +4936,18 @@ were not created by @code{call-with-values} is unspecified. @end deffn make-variable -@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:76 @deffn {Scheme Procedure} make-variable init @deffnx {C Function} scm_make_variable (init) Return a variable initialized to value @var{init}. @end deffn make-undefined-variable -@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:86 @deffn {Scheme Procedure} make-undefined-variable @deffnx {C Function} scm_make_undefined_variable () Return a variable that is initially unbound. @end deffn variable? -@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:97 @deffn {Scheme Procedure} variable? obj @deffnx {C Function} scm_variable_p (obj) Return @code{#t} iff @var{obj} is a variable object, else @@ -5451,7 +4955,6 @@ return @code{#f}. @end deffn variable-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:109 @deffn {Scheme Procedure} variable-ref var @deffnx {C Function} scm_variable_ref (var) Dereference @var{var} and return its value. @@ -5460,7 +4963,6 @@ and @code{make-undefined-variable}. @end deffn variable-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:125 @deffn {Scheme Procedure} variable-set! var val @deffnx {C Function} scm_variable_set_x (var, val) Set the value of the variable @var{var} to @var{val}. @@ -5469,7 +4971,6 @@ value. Return an unspecified value. @end deffn variable-bound? -@c snarfed from /home/ghouston/guile/guile-core/libguile/variable.c:137 @deffn {Scheme Procedure} variable-bound? var @deffnx {C Function} scm_variable_bound_p (var) Return @code{#t} iff @var{var} is bound to a value. @@ -5477,7 +4978,6 @@ Throws an error if @var{var} is not a variable object. @end deffn vector? -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:59 @deffn {Scheme Procedure} vector? obj @deffnx {C Function} scm_vector_p (obj) Return @code{#t} if @var{obj} is a vector, otherwise return @@ -5485,13 +4985,11 @@ Return @code{#t} if @var{obj} is a vector, otherwise return @end deffn list->vector -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:76 @deffn {Scheme Procedure} list->vector implemented by the C function "scm_vector" @end deffn vector -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:93 @deffn {Scheme Procedure} vector . l @deffnx {Scheme Procedure} list->vector l @deffnx {C Function} scm_vector (l) @@ -5504,7 +5002,6 @@ given arguments. Analogous to @code{list}. @end deffn make-vector -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:183 @deffn {Scheme Procedure} make-vector k [fill] @deffnx {C Function} scm_make_vector (k, fill) Return a newly allocated vector of @var{k} elements. If a @@ -5514,7 +5011,6 @@ unspecified. @end deffn vector->list -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:237 @deffn {Scheme Procedure} vector->list v @deffnx {C Function} scm_vector_to_list (v) Return a newly allocated list composed of the elements of @var{v}. @@ -5526,7 +5022,6 @@ Return a newly allocated list composed of the elements of @var{v}. @end deffn vector-fill! -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:254 @deffn {Scheme Procedure} vector-fill! v fill @deffnx {C Function} scm_vector_fill_x (v, fill) Store @var{fill} in every position of @var{vector}. The value @@ -5534,7 +5029,6 @@ returned by @code{vector-fill!} is unspecified. @end deffn vector-move-left! -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:286 @deffn {Scheme Procedure} vector-move-left! vec1 start1 end1 vec2 start2 @deffnx {C Function} scm_vector_move_left_x (vec1, start1, end1, vec2, start2) Copy elements from @var{vec1}, positions @var{start1} to @var{end1}, @@ -5548,7 +5042,6 @@ same vector, @code{vector-move-left!} is usually appropriate when @end deffn vector-move-right! -@c snarfed from /home/ghouston/guile/guile-core/libguile/vectors.c:322 @deffn {Scheme Procedure} vector-move-right! vec1 start1 end1 vec2 start2 @deffnx {C Function} scm_vector_move_right_x (vec1, start1, end1, vec2, start2) Copy elements from @var{vec1}, positions @var{start1} to @var{end1}, @@ -5562,7 +5055,6 @@ same vector, @code{vector-move-right!} is usually appropriate when @end deffn major-version -@c snarfed from /home/ghouston/guile/guile-core/libguile/version.c:59 @deffn {Scheme Procedure} major-version @deffnx {C Function} scm_major_version () Return a string containing Guile's major version number. @@ -5570,7 +5062,6 @@ E.g., the 1 in "1.6.5". @end deffn minor-version -@c snarfed from /home/ghouston/guile/guile-core/libguile/version.c:72 @deffn {Scheme Procedure} minor-version @deffnx {C Function} scm_minor_version () Return a string containing Guile's minor version number. @@ -5578,7 +5069,6 @@ E.g., the 6 in "1.6.5". @end deffn micro-version -@c snarfed from /home/ghouston/guile/guile-core/libguile/version.c:85 @deffn {Scheme Procedure} micro-version @deffnx {C Function} scm_micro_version () Return a string containing Guile's micro version number. @@ -5586,7 +5076,6 @@ E.g., the 5 in "1.6.5". @end deffn version -@c snarfed from /home/ghouston/guile/guile-core/libguile/version.c:107 @deffn {Scheme Procedure} version @deffnx {Scheme Procedure} major-version @deffnx {Scheme Procedure} minor-version @@ -5604,12 +5093,11 @@ or micro version number, respectively. @end deffn make-soft-port -@c snarfed from /home/ghouston/guile/guile-core/libguile/vports.c:185 @deffn {Scheme Procedure} make-soft-port pv modes @deffnx {C Function} scm_make_soft_port (pv, modes) Return a port capable of receiving or delivering characters as specified by the @var{modes} string (@pxref{File Ports, -open-file}). @var{pv} must be a vector of length 5. Its +open-file}). @var{pv} must be a vector of length 5 or 6. Its components are as follows: @enumerate 0 @@ -5623,6 +5111,9 @@ thunk for flushing output thunk for getting one character @item thunk for closing port (not by garbage collection) +@item +(if present and not @code{#f}) thunk for computing the number of +characters that can be read from the port without blocking. @end enumerate For an output-only port only elements 0, 1, 2, and 4 need be @@ -5651,7 +5142,6 @@ For example: @end deffn make-weak-vector -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:116 @deffn {Scheme Procedure} make-weak-vector size [fill] @deffnx {C Function} scm_make_weak_vector (size, fill) Return a weak vector with @var{size} elements. If the optional @@ -5661,13 +5151,11 @@ empty list. @end deffn list->weak-vector -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:124 @deffn {Scheme Procedure} list->weak-vector implemented by the C function "scm_weak_vector" @end deffn weak-vector -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:132 @deffn {Scheme Procedure} weak-vector . l @deffnx {Scheme Procedure} list->weak-vector l @deffnx {C Function} scm_weak_vector (l) @@ -5678,7 +5166,6 @@ the same way @code{list->vector} would. @end deffn weak-vector? -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:163 @deffn {Scheme Procedure} weak-vector? obj @deffnx {C Function} scm_weak_vector_p (obj) Return @code{#t} if @var{obj} is a weak vector. Note that all @@ -5686,7 +5173,6 @@ weak hashes are also weak vectors. @end deffn make-weak-key-hash-table -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:181 @deffn {Scheme Procedure} make-weak-key-hash-table size @deffnx {Scheme Procedure} make-weak-value-hash-table size @deffnx {Scheme Procedure} make-doubly-weak-hash-table size @@ -5700,7 +5186,6 @@ would modify regular hash tables. (@pxref{Hash Tables}) @end deffn make-weak-value-hash-table -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:192 @deffn {Scheme Procedure} make-weak-value-hash-table size @deffnx {C Function} scm_make_weak_value_hash_table (size) Return a hash table with weak values with @var{size} buckets. @@ -5708,7 +5193,6 @@ Return a hash table with weak values with @var{size} buckets. @end deffn make-doubly-weak-hash-table -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:203 @deffn {Scheme Procedure} make-doubly-weak-hash-table size @deffnx {C Function} scm_make_doubly_weak_hash_table (size) Return a hash table with weak keys and values with @var{size} @@ -5716,7 +5200,6 @@ buckets. (@pxref{Hash Tables}) @end deffn weak-key-hash-table? -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:217 @deffn {Scheme Procedure} weak-key-hash-table? obj @deffnx {Scheme Procedure} weak-value-hash-table? obj @deffnx {Scheme Procedure} doubly-weak-hash-table? obj @@ -5727,21 +5210,18 @@ nor a weak value hash table. @end deffn weak-value-hash-table? -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:227 @deffn {Scheme Procedure} weak-value-hash-table? obj @deffnx {C Function} scm_weak_value_hash_table_p (obj) Return @code{#t} if @var{obj} is a weak value hash table. @end deffn doubly-weak-hash-table? -@c snarfed from /home/ghouston/guile/guile-core/libguile/weaks.c:237 @deffn {Scheme Procedure} doubly-weak-hash-table? obj @deffnx {C Function} scm_doubly_weak_hash_table_p (obj) Return @code{#t} if @var{obj} is a doubly weak hash table. @end deffn dynamic-link -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:171 @deffn {Scheme Procedure} dynamic-link filename @deffnx {C Function} scm_dynamic_link (filename) Find the shared object (shared library) denoted by @@ -5757,7 +5237,6 @@ such as @file{/usr/lib} and @file{/usr/local/lib}. @end deffn dynamic-object? -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:186 @deffn {Scheme Procedure} dynamic-object? obj @deffnx {C Function} scm_dynamic_object_p (obj) Return @code{#t} if @var{obj} is a dynamic object handle, @@ -5765,7 +5244,6 @@ or @code{#f} otherwise. @end deffn dynamic-unlink -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:200 @deffn {Scheme Procedure} dynamic-unlink dobj @deffnx {C Function} scm_dynamic_unlink (dobj) Unlink a dynamic object from the application, if possible. The @@ -5776,7 +5254,6 @@ object. @end deffn dynamic-func -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:225 @deffn {Scheme Procedure} dynamic-func name dobj @deffnx {C Function} scm_dynamic_func (name, dobj) Return a ``handle'' for the function @var{name} in the @@ -5791,7 +5268,6 @@ since it will be added automatically when necessary. @end deffn dynamic-call -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:267 @deffn {Scheme Procedure} dynamic-call func dobj @deffnx {C Function} scm_dynamic_call (func, dobj) Call a C function in a dynamic object. Two styles of @@ -5816,7 +5292,6 @@ and its return value is ignored. @end deffn dynamic-args-call -@c snarfed from /home/ghouston/guile/guile-core/libguile/dynl.c:322 @deffn {Scheme Procedure} dynamic-args-call func dobj args @deffnx {C Function} scm_dynamic_args_call (func, dobj, args) Call the C function indicated by @var{func} and @var{dobj}, @@ -5835,7 +5310,6 @@ converted to a Scheme number and returned from the call to @end deffn array-fill! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:462 @deffn {Scheme Procedure} array-fill! ra fill @deffnx {C Function} scm_array_fill_x (ra, fill) Store @var{fill} in every element of @var{array}. The value returned @@ -5843,13 +5317,11 @@ is unspecified. @end deffn array-copy-in-order! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:827 @deffn {Scheme Procedure} array-copy-in-order! implemented by the C function "scm_array_copy_x" @end deffn array-copy! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:836 @deffn {Scheme Procedure} array-copy! src dst @deffnx {Scheme Procedure} array-copy-in-order! src dst @deffnx {C Function} scm_array_copy_x (src, dst) @@ -5860,13 +5332,11 @@ dimension. The order is unspecified. @end deffn array-map-in-order! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1512 @deffn {Scheme Procedure} array-map-in-order! implemented by the C function "scm_array_map_x" @end deffn array-map! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1523 @deffn {Scheme Procedure} array-map! ra0 proc . lra @deffnx {Scheme Procedure} array-map-in-order! ra0 proc . lra @deffnx {C Function} scm_array_map_x (ra0, proc, lra) @@ -5879,7 +5349,6 @@ unspecified. The order of application is unspecified. @end deffn array-for-each -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1671 @deffn {Scheme Procedure} array-for-each proc ra0 . lra @deffnx {C Function} scm_array_for_each (proc, ra0, lra) Apply @var{proc} to each tuple of elements of @var{array0} @dots{} @@ -5887,7 +5356,6 @@ in row-major order. The value returned is unspecified. @end deffn array-index-map! -@c snarfed from /home/ghouston/guile/guile-core/libguile/ramap.c:1699 @deffn {Scheme Procedure} array-index-map! ra proc @deffnx {C Function} scm_array_index_map_x (ra, proc) Apply @var{proc} to the indices of each element of @var{array} in @@ -5911,14 +5379,12 @@ Another example: @end deffn uniform-vector-length -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:250 @deffn {Scheme Procedure} uniform-vector-length v @deffnx {C Function} scm_uniform_vector_length (v) Return the number of elements in @var{uve}. @end deffn array? -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:284 @deffn {Scheme Procedure} array? v [prot] @deffnx {C Function} scm_array_p (v, prot) Return @code{#t} if the @var{obj} is an array, and @code{#f} if @@ -5927,7 +5393,6 @@ and is described elsewhere. @end deffn array-rank -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:355 @deffn {Scheme Procedure} array-rank ra @deffnx {C Function} scm_array_rank (ra) Return the number of dimensions of @var{obj}. If @var{obj} is @@ -5935,7 +5400,6 @@ not an array, @code{0} is returned. @end deffn array-dimensions -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:393 @deffn {Scheme Procedure} array-dimensions ra @deffnx {C Function} scm_array_dimensions (ra) @code{Array-dimensions} is similar to @code{array-shape} but replaces @@ -5946,28 +5410,24 @@ elements with a @code{0} minimum with one greater than the maximum. So: @end deffn shared-array-root -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:440 @deffn {Scheme Procedure} shared-array-root ra @deffnx {C Function} scm_shared_array_root (ra) Return the root vector of a shared array. @end deffn shared-array-offset -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:451 @deffn {Scheme Procedure} shared-array-offset ra @deffnx {C Function} scm_shared_array_offset (ra) Return the root vector index of the first element in the array. @end deffn shared-array-increments -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:462 @deffn {Scheme Procedure} shared-array-increments ra @deffnx {C Function} scm_shared_array_increments (ra) For each dimension, return the distance between elements in the root vector. @end deffn dimensions->uniform-array -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:581 @deffn {Scheme Procedure} dimensions->uniform-array dims prot [fill] @deffnx {Scheme Procedure} make-uniform-vector length prototype [fill] @deffnx {C Function} scm_dimensions_to_uniform_array (dims, prot, fill) @@ -5978,7 +5438,6 @@ fill the array, otherwise @var{prototype} is used. @end deffn make-shared-array -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:670 @deffn {Scheme Procedure} make-shared-array oldra mapfunc . dims @deffnx {C Function} scm_make_shared_array (oldra, mapfunc, dims) @code{make-shared-array} can be used to create shared subarrays of other @@ -5999,7 +5458,6 @@ it can be otherwise arbitrary. A simple example: @end deffn transpose-array -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:802 @deffn {Scheme Procedure} transpose-array ra . args @deffnx {C Function} scm_transpose_array (ra, args) Return an array sharing contents with @var{array}, but with @@ -6024,7 +5482,6 @@ have smaller rank than @var{array}. @end deffn enclose-array -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:912 @deffn {Scheme Procedure} enclose-array ra . axes @deffnx {C Function} scm_enclose_array (ra, axes) @var{dim0}, @var{dim1} @dots{} should be nonnegative integers less than @@ -6051,7 +5508,6 @@ examples: @end deffn array-in-bounds? -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:996 @deffn {Scheme Procedure} array-in-bounds? v . args @deffnx {C Function} scm_array_in_bounds_p (v, args) Return @code{#t} if its arguments would be acceptable to @@ -6059,13 +5515,11 @@ Return @code{#t} if its arguments would be acceptable to @end deffn array-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1075 @deffn {Scheme Procedure} array-ref implemented by the C function "scm_uniform_vector_ref" @end deffn uniform-vector-ref -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1082 @deffn {Scheme Procedure} uniform-vector-ref v args @deffnx {Scheme Procedure} array-ref v . args @deffnx {C Function} scm_uniform_vector_ref (v, args) @@ -6074,13 +5528,11 @@ Return the element at the @code{(index1, index2)} element in @end deffn uniform-array-set1! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1251 @deffn {Scheme Procedure} uniform-array-set1! implemented by the C function "scm_array_set_x" @end deffn array-set! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1260 @deffn {Scheme Procedure} array-set! v obj . args @deffnx {Scheme Procedure} uniform-array-set1! v obj args @deffnx {C Function} scm_array_set_x (v, obj, args) @@ -6089,7 +5541,6 @@ Set the element at the @code{(index1, index2)} element in @var{array} to @end deffn array-contents -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1375 @deffn {Scheme Procedure} array-contents ra [strict] @deffnx {C Function} scm_array_contents (ra, strict) If @var{array} may be @dfn{unrolled} into a one dimensional shared array @@ -6105,7 +5556,6 @@ memory. @end deffn uniform-array-read! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1489 @deffn {Scheme Procedure} uniform-array-read! ra [port_or_fd [start [end]]] @deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] [start] [end] @deffnx {C Function} scm_uniform_array_read_x (ra, port_or_fd, start, end) @@ -6126,7 +5576,6 @@ returned by @code{(current-input-port)}. @end deffn uniform-array-write -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1654 @deffn {Scheme Procedure} uniform-array-write v [port_or_fd [start [end]]] @deffnx {Scheme Procedure} uniform-vector-write uve [port-or-fdes] [start] [end] @deffnx {C Function} scm_uniform_array_write (v, port_or_fd, start, end) @@ -6144,7 +5593,6 @@ omitted, in which case it defaults to the value returned by @end deffn bit-count -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1781 @deffn {Scheme Procedure} bit-count b bitvector @deffnx {C Function} scm_bit_count (b, bitvector) Return the number of occurrences of the boolean @var{b} in @@ -6152,7 +5600,6 @@ Return the number of occurrences of the boolean @var{b} in @end deffn bit-position -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1820 @deffn {Scheme Procedure} bit-position item v k @deffnx {C Function} scm_bit_position (item, v, k) Return the minimum index of an occurrence of @var{bool} in @@ -6161,7 +5608,6 @@ within the specified range @code{#f} is returned. @end deffn bit-set*! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1888 @deffn {Scheme Procedure} bit-set*! v kv obj @deffnx {C Function} scm_bit_set_star_x (v, kv, obj) If uve is a bit-vector @var{bv} and uve must be of the same @@ -6176,7 +5622,6 @@ of @var{bv} corresponding to the indexes in uve are set to @end deffn bit-count* -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:1942 @deffn {Scheme Procedure} bit-count* v kv obj @deffnx {C Function} scm_bit_count_star (v, kv, obj) Return @@ -6187,14 +5632,12 @@ Return @end deffn bit-invert! -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2006 @deffn {Scheme Procedure} bit-invert! v @deffnx {C Function} scm_bit_invert_x (v) Modify @var{bv} by replacing each element with its negation. @end deffn array->list -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2085 @deffn {Scheme Procedure} array->list v @deffnx {C Function} scm_array_to_list (v) Return a list consisting of all the elements, in order, of @@ -6202,7 +5645,6 @@ Return a list consisting of all the elements, in order, of @end deffn list->uniform-array -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2186 @deffn {Scheme Procedure} list->uniform-array ndim prot lst @deffnx {Scheme Procedure} list->uniform-vector prot lst @deffnx {C Function} scm_list_to_uniform_array (ndim, prot, lst) @@ -6213,7 +5655,6 @@ done. @end deffn array-prototype -@c snarfed from /home/ghouston/guile/guile-core/libguile/unif.c:2537 @deffn {Scheme Procedure} array-prototype ra @deffnx {C Function} scm_array_prototype (ra) Return an object that would produce an array of the same type @@ -6222,7 +5663,6 @@ as @var{array}, if used as the @var{prototype} for @end deffn chown -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:214 @deffn {Scheme Procedure} chown object owner group @deffnx {C Function} scm_chown (object, owner, group) Change the ownership and group of the file referred to by @var{object} to @@ -6240,7 +5680,6 @@ as @code{-1}, then that ID is not changed. @end deffn chmod -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:254 @deffn {Scheme Procedure} chmod object mode @deffnx {C Function} scm_chmod (object, mode) Changes the permissions of the file referred to by @var{obj}. @@ -6253,7 +5692,6 @@ The return value is unspecified. @end deffn umask -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:287 @deffn {Scheme Procedure} umask [mode] @deffnx {C Function} scm_umask (mode) If @var{mode} is omitted, returns a decimal number representing the current @@ -6264,7 +5702,6 @@ E.g., @code{(umask #o022)} sets the mask to octal 22, decimal 18. @end deffn open-fdes -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:310 @deffn {Scheme Procedure} open-fdes path flags [mode] @deffnx {C Function} scm_open_fdes (path, flags, mode) Similar to @code{open} but return a file descriptor instead of @@ -6272,7 +5709,6 @@ a port. @end deffn open -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:352 @deffn {Scheme Procedure} open path flags [mode] @deffnx {C Function} scm_open (path, flags, mode) Open the file named by @var{path} for reading and/or writing. @@ -6305,7 +5741,6 @@ for additional flags. @end deffn close -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:390 @deffn {Scheme Procedure} close fd_or_port @deffnx {C Function} scm_close (fd_or_port) Similar to close-port (@pxref{Closing, close-port}), @@ -6316,7 +5751,6 @@ their revealed counts set to zero. @end deffn close-fdes -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:418 @deffn {Scheme Procedure} close-fdes fd @deffnx {C Function} scm_close_fdes (fd) A simple wrapper for the @code{close} system call. @@ -6327,7 +5761,6 @@ The return value is unspecified. @end deffn stat -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:620 @deffn {Scheme Procedure} stat object @deffnx {C Function} scm_stat (object) Return an object containing various information about the file @@ -6389,7 +5822,6 @@ An integer representing the access permission bits. @end deffn link -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:683 @deffn {Scheme Procedure} link oldpath newpath @deffnx {C Function} scm_link (oldpath, newpath) Creates a new name @var{newpath} in the file system for the @@ -6399,7 +5831,6 @@ system. @end deffn rename-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:704 @deffn {Scheme Procedure} rename-file oldname newname @deffnx {C Function} scm_rename (oldname, newname) Renames the file specified by @var{oldname} to @var{newname}. @@ -6407,14 +5838,12 @@ The return value is unspecified. @end deffn delete-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:731 @deffn {Scheme Procedure} delete-file str @deffnx {C Function} scm_delete_file (str) Deletes (or "unlinks") the file specified by @var{path}. @end deffn mkdir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:749 @deffn {Scheme Procedure} mkdir path [mode] @deffnx {C Function} scm_mkdir (path, mode) Create a new directory named by @var{path}. If @var{mode} is omitted @@ -6424,7 +5853,6 @@ umask. Otherwise they are set to the decimal value specified with @end deffn rmdir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:777 @deffn {Scheme Procedure} rmdir path @deffnx {C Function} scm_rmdir (path) Remove the existing directory named by @var{path}. The directory must @@ -6432,7 +5860,6 @@ be empty for this to succeed. The return value is unspecified. @end deffn directory-stream? -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:802 @deffn {Scheme Procedure} directory-stream? obj @deffnx {C Function} scm_directory_stream_p (obj) Return a boolean indicating whether @var{object} is a directory @@ -6440,7 +5867,6 @@ stream as returned by @code{opendir}. @end deffn opendir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:813 @deffn {Scheme Procedure} opendir dirname @deffnx {C Function} scm_opendir (dirname) Open the directory specified by @var{path} and return a directory @@ -6448,7 +5874,6 @@ stream. @end deffn readdir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:830 @deffn {Scheme Procedure} readdir port @deffnx {C Function} scm_readdir (port) Return (as a string) the next directory entry from the directory stream @@ -6457,7 +5882,6 @@ end of file object is returned. @end deffn rewinddir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:853 @deffn {Scheme Procedure} rewinddir port @deffnx {C Function} scm_rewinddir (port) Reset the directory port @var{stream} so that the next call to @@ -6465,7 +5889,6 @@ Reset the directory port @var{stream} so that the next call to @end deffn closedir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:870 @deffn {Scheme Procedure} closedir port @deffnx {C Function} scm_closedir (port) Close the directory stream @var{stream}. @@ -6473,7 +5896,6 @@ The return value is unspecified. @end deffn chdir -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:920 @deffn {Scheme Procedure} chdir str @deffnx {C Function} scm_chdir (str) Change the current working directory to @var{path}. @@ -6481,14 +5903,12 @@ The return value is unspecified. @end deffn getcwd -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:936 @deffn {Scheme Procedure} getcwd @deffnx {C Function} scm_getcwd () Return the name of the current working directory. @end deffn select -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1132 @deffn {Scheme Procedure} select reads writes excepts [secs [usecs]] @deffnx {C Function} scm_select (reads, writes, excepts, secs, usecs) This procedure has a variety of uses: waiting for the ability @@ -6523,7 +5943,6 @@ An additional @code{select!} interface is provided. @end deffn fcntl -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1278 @deffn {Scheme Procedure} fcntl object cmd [value] @deffnx {C Function} scm_fcntl (object, cmd, value) Apply @var{command} to the specified file descriptor or the underlying @@ -6554,7 +5973,6 @@ The value used to indicate the "close on exec" flag with @code{F_GETFL} or @end deffn fsync -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1315 @deffn {Scheme Procedure} fsync object @deffnx {C Function} scm_fsync (object) Copies any unwritten data for the specified output file descriptor to disk. @@ -6564,7 +5982,6 @@ The return value is unspecified. @end deffn symlink -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1342 @deffn {Scheme Procedure} symlink oldpath newpath @deffnx {C Function} scm_symlink (oldpath, newpath) Create a symbolic link named @var{path-to} with the value (i.e., pointing to) @@ -6572,7 +5989,6 @@ Create a symbolic link named @var{path-to} with the value (i.e., pointing to) @end deffn readlink -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1361 @deffn {Scheme Procedure} readlink path @deffnx {C Function} scm_readlink (path) Return the value of the symbolic link named by @var{path} (a @@ -6580,7 +5996,6 @@ string), i.e., the file that the link points to. @end deffn lstat -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1390 @deffn {Scheme Procedure} lstat str @deffnx {C Function} scm_lstat (str) Similar to @code{stat}, but does not follow symbolic links, i.e., @@ -6589,7 +6004,6 @@ file it points to. @var{path} must be a string. @end deffn copy-file -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1414 @deffn {Scheme Procedure} copy-file oldfile newfile @deffnx {C Function} scm_copy_file (oldfile, newfile) Copy the file specified by @var{path-from} to @var{path-to}. @@ -6597,7 +6011,6 @@ The return value is unspecified. @end deffn dirname -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1459 @deffn {Scheme Procedure} dirname filename @deffnx {C Function} scm_dirname (filename) Return the directory name component of the file name @@ -6606,7 +6019,6 @@ component, @code{.} is returned. @end deffn basename -@c snarfed from /home/ghouston/guile/guile-core/libguile/filesys.c:1502 @deffn {Scheme Procedure} basename filename [suffix] @deffnx {C Function} scm_basename (filename, suffix) Return the base name of the file name @var{filename}. The @@ -6616,7 +6028,6 @@ If @var{suffix} is provided, and is equal to the end of @end deffn pipe -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:201 @deffn {Scheme Procedure} pipe @deffnx {C Function} scm_pipe () Return a newly created pipe: a pair of ports which are linked @@ -6635,7 +6046,6 @@ from the input port. @end deffn getgroups -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:222 @deffn {Scheme Procedure} getgroups @deffnx {C Function} scm_getgroups () Return a vector of integers representing the current @@ -6643,7 +6053,6 @@ supplementary group IDs. @end deffn getpw -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:257 @deffn {Scheme Procedure} getpw [user] @deffnx {C Function} scm_getpwuid (user) Look up an entry in the user database. @var{obj} can be an integer, @@ -6652,7 +6061,6 @@ or getpwent respectively. @end deffn setpw -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:307 @deffn {Scheme Procedure} setpw [arg] @deffnx {C Function} scm_setpwent (arg) If called with a true argument, initialize or reset the password data @@ -6661,7 +6069,6 @@ stream. Otherwise, close the stream. The @code{setpwent} and @end deffn getgr -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:326 @deffn {Scheme Procedure} getgr [name] @deffnx {C Function} scm_getgrgid (name) Look up an entry in the group database. @var{obj} can be an integer, @@ -6670,7 +6077,6 @@ or getgrent respectively. @end deffn setgr -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:364 @deffn {Scheme Procedure} setgr [arg] @deffnx {C Function} scm_setgrent (arg) If called with a true argument, initialize or reset the group data @@ -6679,7 +6085,6 @@ stream. Otherwise, close the stream. The @code{setgrent} and @end deffn kill -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:400 @deffn {Scheme Procedure} kill pid sig @deffnx {C Function} scm_kill (pid, sig) Sends a signal to the specified process or group of processes. @@ -6712,7 +6117,6 @@ Interrupt signal. @end deffn waitpid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:453 @deffn {Scheme Procedure} waitpid pid [options] @deffnx {C Function} scm_waitpid (pid, options) This procedure collects status information from a child process which @@ -6759,7 +6163,6 @@ The integer status value. @end deffn status:exit-val -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:481 @deffn {Scheme Procedure} status:exit-val status @deffnx {C Function} scm_status_exit_val (status) Return the exit status value, as would be set if a process @@ -6768,7 +6171,6 @@ if any, otherwise @code{#f}. @end deffn status:term-sig -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:501 @deffn {Scheme Procedure} status:term-sig status @deffnx {C Function} scm_status_term_sig (status) Return the signal number which terminated the process, if any, @@ -6776,7 +6178,6 @@ otherwise @code{#f}. @end deffn status:stop-sig -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:519 @deffn {Scheme Procedure} status:stop-sig status @deffnx {C Function} scm_status_stop_sig (status) Return the signal number which stopped the process, if any, @@ -6784,7 +6185,6 @@ otherwise @code{#f}. @end deffn getppid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:539 @deffn {Scheme Procedure} getppid @deffnx {C Function} scm_getppid () Return an integer representing the process ID of the parent @@ -6792,41 +6192,36 @@ process. @end deffn getuid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:551 @deffn {Scheme Procedure} getuid @deffnx {C Function} scm_getuid () Return an integer representing the current real user ID. @end deffn getgid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:562 @deffn {Scheme Procedure} getgid @deffnx {C Function} scm_getgid () Return an integer representing the current real group ID. @end deffn geteuid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:576 @deffn {Scheme Procedure} geteuid @deffnx {C Function} scm_geteuid () Return an integer representing the current effective user ID. If the system does not support effective IDs, then the real ID -is returned. @code{(feature? 'EIDs)} reports whether the +is returned. @code{(provided? 'EIDs)} reports whether the system supports effective IDs. @end deffn getegid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:593 @deffn {Scheme Procedure} getegid @deffnx {C Function} scm_getegid () Return an integer representing the current effective group ID. If the system does not support effective IDs, then the real ID -is returned. @code{(feature? 'EIDs)} reports whether the +is returned. @code{(provided? 'EIDs)} reports whether the system supports effective IDs. @end deffn setuid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:609 @deffn {Scheme Procedure} setuid id @deffnx {C Function} scm_setuid (id) Sets both the real and effective user IDs to the integer @var{id}, provided @@ -6835,7 +6230,6 @@ The return value is unspecified. @end deffn setgid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:623 @deffn {Scheme Procedure} setgid id @deffnx {C Function} scm_setgid (id) Sets both the real and effective group IDs to the integer @var{id}, provided @@ -6844,29 +6238,26 @@ The return value is unspecified. @end deffn seteuid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:639 @deffn {Scheme Procedure} seteuid id @deffnx {C Function} scm_seteuid (id) Sets the effective user ID to the integer @var{id}, provided the process has appropriate privileges. If effective IDs are not supported, the -real ID is set instead -- @code{(feature? 'EIDs)} reports whether the +real ID is set instead -- @code{(provided? 'EIDs)} reports whether the system supports effective IDs. The return value is unspecified. @end deffn setegid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:665 @deffn {Scheme Procedure} setegid id @deffnx {C Function} scm_setegid (id) Sets the effective group ID to the integer @var{id}, provided the process has appropriate privileges. If effective IDs are not supported, the -real ID is set instead -- @code{(feature? 'EIDs)} reports whether the +real ID is set instead -- @code{(provided? 'EIDs)} reports whether the system supports effective IDs. The return value is unspecified. @end deffn getpgrp -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:689 @deffn {Scheme Procedure} getpgrp @deffnx {C Function} scm_getpgrp () Return an integer representing the current process group ID. @@ -6874,7 +6265,6 @@ This is the POSIX definition, not BSD. @end deffn setpgid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:707 @deffn {Scheme Procedure} setpgid pid pgid @deffnx {C Function} scm_setpgid (pid, pgid) Move the process @var{pid} into the process group @var{pgid}. @var{pid} or @@ -6885,7 +6275,6 @@ The return value is unspecified. @end deffn setsid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:726 @deffn {Scheme Procedure} setsid @deffnx {C Function} scm_setsid () Creates a new session. The current process becomes the session leader @@ -6895,7 +6284,6 @@ The return value is an integer representing the new process group ID. @end deffn ttyname -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:741 @deffn {Scheme Procedure} ttyname port @deffnx {C Function} scm_ttyname (port) Return a string with the name of the serial terminal device @@ -6903,7 +6291,6 @@ underlying @var{port}. @end deffn ctermid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:765 @deffn {Scheme Procedure} ctermid @deffnx {C Function} scm_ctermid () Return a string containing the file name of the controlling @@ -6911,7 +6298,6 @@ terminal for the current process. @end deffn tcgetpgrp -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:788 @deffn {Scheme Procedure} tcgetpgrp port @deffnx {C Function} scm_tcgetpgrp (port) Return the process group ID of the foreground process group @@ -6927,7 +6313,6 @@ foreground. @end deffn tcsetpgrp -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:812 @deffn {Scheme Procedure} tcsetpgrp port pgid @deffnx {C Function} scm_tcsetpgrp (port, pgid) Set the foreground process group ID for the terminal used by the file @@ -6938,7 +6323,6 @@ controlling terminal. The return value is unspecified. @end deffn execl -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:867 @deffn {Scheme Procedure} execl filename . args @deffnx {C Function} scm_execl (filename, args) Executes the file named by @var{path} as a new process image. @@ -6955,7 +6339,6 @@ call, but we call it @code{execl} because of its Scheme calling interface. @end deffn execlp -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:887 @deffn {Scheme Procedure} execlp filename . args @deffnx {C Function} scm_execlp (filename, args) Similar to @code{execl}, however if @@ -6968,7 +6351,6 @@ call, but we call it @code{execlp} because of its Scheme calling interface. @end deffn execle -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:937 @deffn {Scheme Procedure} execle filename env . args @deffnx {C Function} scm_execle (filename, env, args) Similar to @code{execl}, but the environment of the new process is @@ -6980,7 +6362,6 @@ call, but we call it @code{execle} because of its Scheme calling interface. @end deffn primitive-fork -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:961 @deffn {Scheme Procedure} primitive-fork @deffnx {C Function} scm_fork () Creates a new "child" process by duplicating the current "parent" process. @@ -6992,7 +6373,6 @@ with the scsh fork. @end deffn uname -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:981 @deffn {Scheme Procedure} uname @deffnx {C Function} scm_uname () Return an object with some information about the computer @@ -7000,7 +6380,6 @@ system the program is running on. @end deffn environ -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1010 @deffn {Scheme Procedure} environ [env] @deffnx {C Function} scm_environ (env) If @var{env} is omitted, return the current environment (in the @@ -7013,7 +6392,6 @@ then the return value is unspecified. @end deffn tmpnam -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1048 @deffn {Scheme Procedure} tmpnam @deffnx {C Function} scm_tmpnam () Return a name in the file system that does not match any @@ -7024,7 +6402,6 @@ Care should be taken if opening the file, e.g., use the @end deffn mkstemp! -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1074 @deffn {Scheme Procedure} mkstemp! tmpl @deffnx {C Function} scm_mkstemp (tmpl) Create a new unique file in the file system and returns a new @@ -7035,7 +6412,6 @@ place to return the name of the temporary file. @end deffn utime -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1099 @deffn {Scheme Procedure} utime pathname [actime [modtime]] @deffnx {C Function} scm_utime (pathname, actime, modtime) @code{utime} sets the access and modification times for the @@ -7051,7 +6427,6 @@ modification time to the current time. @end deffn access? -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1147 @deffn {Scheme Procedure} access? path how @deffnx {C Function} scm_access (path, how) Return @code{#t} if @var{path} corresponds to an existing file @@ -7080,14 +6455,12 @@ test for existence of the file. @end deffn getpid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1161 @deffn {Scheme Procedure} getpid @deffnx {C Function} scm_getpid () Return an integer representing the current process ID. @end deffn putenv -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1178 @deffn {Scheme Procedure} putenv str @deffnx {C Function} scm_putenv (str) Modifies the environment of the current process, which is @@ -7104,7 +6477,6 @@ The return value is unspecified. @end deffn setlocale -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1220 @deffn {Scheme Procedure} setlocale category [locale] @deffnx {C Function} scm_setlocale (category, locale) If @var{locale} is omitted, return the current value of the @@ -7119,7 +6491,6 @@ the locale will be set using environment variables. @end deffn mknod -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1260 @deffn {Scheme Procedure} mknod path type perms dev @deffnx {C Function} scm_mknod (path, type, perms, dev) Creates a new special file, such as a file corresponding to a device. @@ -7140,7 +6511,6 @@ The return value is unspecified. @end deffn nice -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1306 @deffn {Scheme Procedure} nice incr @deffnx {C Function} scm_nice (incr) Increment the priority of the current process by @var{incr}. A higher @@ -7149,7 +6519,6 @@ The return value is unspecified. @end deffn sync -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1321 @deffn {Scheme Procedure} sync @deffnx {C Function} scm_sync () Flush the operating system disk buffers. @@ -7157,7 +6526,6 @@ The return value is unspecified. @end deffn crypt -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1334 @deffn {Scheme Procedure} crypt key salt @deffnx {C Function} scm_crypt (key, salt) Encrypt @var{key} using @var{salt} as the salt value to the @@ -7165,7 +6533,6 @@ crypt(3) library call. @end deffn chroot -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1355 @deffn {Scheme Procedure} chroot path @deffnx {C Function} scm_chroot (path) Change the root directory to that specified in @var{path}. @@ -7176,7 +6543,6 @@ root directory. @end deffn getlogin -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1387 @deffn {Scheme Procedure} getlogin @deffnx {C Function} scm_getlogin () Return a string containing the name of the user logged in on @@ -7185,7 +6551,6 @@ information cannot be obtained. @end deffn cuserid -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1405 @deffn {Scheme Procedure} cuserid @deffnx {C Function} scm_cuserid () Return a string containing a user name associated with the @@ -7194,7 +6559,6 @@ information cannot be obtained. @end deffn getpriority -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1430 @deffn {Scheme Procedure} getpriority which who @deffnx {C Function} scm_getpriority (which, who) Return the scheduling priority of the process, process group @@ -7210,7 +6574,6 @@ specified processes. @end deffn setpriority -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1464 @deffn {Scheme Procedure} setpriority which who prio @deffnx {C Function} scm_setpriority (which, who, prio) Set the scheduling priority of the process, process group @@ -7229,7 +6592,6 @@ The return value is not specified. @end deffn getpass -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1489 @deffn {Scheme Procedure} getpass prompt @deffnx {C Function} scm_getpass (prompt) Display @var{prompt} to the standard error output and read @@ -7242,7 +6604,6 @@ characters is disabled. @end deffn flock -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1593 @deffn {Scheme Procedure} flock file operation @deffnx {C Function} scm_flock (file, operation) Apply or remove an advisory lock on an open file. @@ -7265,7 +6626,6 @@ file descriptor or an open file descriptor port. @end deffn sethostname -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1619 @deffn {Scheme Procedure} sethostname name @deffnx {C Function} scm_sethostname (name) Set the host name of the current processor to @var{name}. May @@ -7274,14 +6634,12 @@ specified. @end deffn gethostname -@c snarfed from /home/ghouston/guile/guile-core/libguile/posix.c:1634 @deffn {Scheme Procedure} gethostname @deffnx {C Function} scm_gethostname () Return the host name of the current processor. @end deffn gethost -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:153 @deffn {Scheme Procedure} gethost [host] @deffnx {Scheme Procedure} gethostbyname hostname @deffnx {Scheme Procedure} gethostbyaddr address @@ -7298,7 +6656,6 @@ Unusual conditions may result in errors thrown to the @end deffn getnet -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:231 @deffn {Scheme Procedure} getnet [net] @deffnx {Scheme Procedure} getnetbyname net-name @deffnx {Scheme Procedure} getnetbyaddr net-number @@ -7311,7 +6668,6 @@ given. @end deffn getproto -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:277 @deffn {Scheme Procedure} getproto [protocol] @deffnx {Scheme Procedure} getprotobyname name @deffnx {Scheme Procedure} getprotobynumber number @@ -7323,7 +6679,6 @@ argument. @code{getproto} will accept either type, behaving like @end deffn getserv -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:337 @deffn {Scheme Procedure} getserv [name [protocol]] @deffnx {Scheme Procedure} getservbyname name protocol @deffnx {Scheme Procedure} getservbyport port protocol @@ -7339,7 +6694,6 @@ as its first argument; if given no arguments, it behaves like @end deffn sethost -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:374 @deffn {Scheme Procedure} sethost [stayopen] @deffnx {C Function} scm_sethost (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endhostent}. @@ -7347,7 +6701,6 @@ Otherwise it is equivalent to @code{sethostent stayopen}. @end deffn setnet -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:390 @deffn {Scheme Procedure} setnet [stayopen] @deffnx {C Function} scm_setnet (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endnetent}. @@ -7355,7 +6708,6 @@ Otherwise it is equivalent to @code{setnetent stayopen}. @end deffn setproto -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:406 @deffn {Scheme Procedure} setproto [stayopen] @deffnx {C Function} scm_setproto (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endprotoent}. @@ -7363,7 +6715,6 @@ Otherwise it is equivalent to @code{setprotoent stayopen}. @end deffn setserv -@c snarfed from /home/ghouston/guile/guile-core/libguile/net_db.c:422 @deffn {Scheme Procedure} setserv [stayopen] @deffnx {C Function} scm_setserv (stayopen) If @var{stayopen} is omitted, this is equivalent to @code{endservent}. @@ -7371,7 +6722,6 @@ Otherwise it is equivalent to @code{setservent stayopen}. @end deffn htons -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:108 @deffn {Scheme Procedure} htons value @deffnx {C Function} scm_htons (value) Convert a 16 bit quantity from host to network byte ordering. @@ -7380,7 +6730,6 @@ and returned as a new integer. @end deffn ntohs -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:125 @deffn {Scheme Procedure} ntohs value @deffnx {C Function} scm_ntohs (value) Convert a 16 bit quantity from network to host byte ordering. @@ -7389,7 +6738,6 @@ and returned as a new integer. @end deffn htonl -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:142 @deffn {Scheme Procedure} htonl value @deffnx {C Function} scm_htonl (value) Convert a 32 bit quantity from host to network byte ordering. @@ -7398,7 +6746,6 @@ and returned as a new integer. @end deffn ntohl -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:155 @deffn {Scheme Procedure} ntohl value @deffnx {C Function} scm_ntohl (value) Convert a 32 bit quantity from network to host byte ordering. @@ -7407,7 +6754,6 @@ and returned as a new integer. @end deffn inet-aton -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:175 @deffn {Scheme Procedure} inet-aton address @deffnx {C Function} scm_inet_aton (address) Convert an IPv4 Internet address from printable string @@ -7419,7 +6765,6 @@ Convert an IPv4 Internet address from printable string @end deffn inet-ntoa -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:194 @deffn {Scheme Procedure} inet-ntoa inetid @deffnx {C Function} scm_inet_ntoa (inetid) Convert an IPv4 Internet address to a printable @@ -7431,7 +6776,6 @@ Convert an IPv4 Internet address to a printable @end deffn inet-netof -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:214 @deffn {Scheme Procedure} inet-netof address @deffnx {C Function} scm_inet_netof (address) Return the network number part of the given IPv4 @@ -7443,7 +6787,6 @@ Internet address. E.g., @end deffn inet-lnaof -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:232 @deffn {Scheme Procedure} inet-lnaof address @deffnx {C Function} scm_lnaof (address) Return the local-address-with-network part of the given @@ -7456,7 +6799,6 @@ E.g., @end deffn inet-makeaddr -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:250 @deffn {Scheme Procedure} inet-makeaddr net lna @deffnx {C Function} scm_inet_makeaddr (net, lna) Make an IPv4 Internet address by combining the network number @@ -7469,7 +6811,6 @@ Make an IPv4 Internet address by combining the network number @end deffn inet-pton -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:368 @deffn {Scheme Procedure} inet-pton family address @deffnx {C Function} scm_inet_pton (family, address) Convert a string containing a printable network address to @@ -7485,7 +6826,6 @@ the result is an integer with normal host byte ordering. @end deffn inet-ntop -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:403 @deffn {Scheme Procedure} inet-ntop family address @deffnx {C Function} scm_inet_ntop (family, address) Convert a network address into a printable string. @@ -7501,7 +6841,6 @@ ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff @end deffn socket -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:448 @deffn {Scheme Procedure} socket family style proto @deffnx {C Function} scm_socket (family, style, proto) Return a new socket port of the type specified by @var{family}, @@ -7520,7 +6859,6 @@ has been connected to another socket. @end deffn socketpair -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:470 @deffn {Scheme Procedure} socketpair family style proto @deffnx {C Function} scm_socketpair (family, style, proto) Return a pair of connected (but unnamed) socket ports of the @@ -7531,7 +6869,6 @@ family. Zero is likely to be the only meaningful value for @end deffn getsockopt -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:499 @deffn {Scheme Procedure} getsockopt sock level optname @deffnx {C Function} scm_getsockopt (sock, level, optname) Return the value of a particular socket option for the socket @@ -7546,7 +6883,6 @@ returns a pair of integers. @end deffn setsockopt -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:567 @deffn {Scheme Procedure} setsockopt sock level optname value @deffnx {C Function} scm_setsockopt (sock, level, optname, value) Set the value of a particular socket option for the socket @@ -7563,7 +6899,6 @@ The return value is unspecified. @end deffn shutdown -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:671 @deffn {Scheme Procedure} shutdown sock how @deffnx {C Function} scm_shutdown (sock, how) Sockets can be closed simply by using @code{close-port}. The @@ -7586,7 +6921,6 @@ The return value is unspecified. @end deffn connect -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:815 @deffn {Scheme Procedure} connect sock fam address . args @deffnx {C Function} scm_connect (sock, fam, address, args) Initiate a connection from a socket using a specified address @@ -7613,7 +6947,6 @@ The return value is unspecified. @end deffn bind -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:875 @deffn {Scheme Procedure} bind sock fam address . args @deffnx {C Function} scm_bind (sock, fam, address, args) Assign an address to the socket port @var{sock}. @@ -7662,7 +6995,6 @@ The return value is unspecified. @end deffn listen -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:909 @deffn {Scheme Procedure} listen sock backlog @deffnx {C Function} scm_listen (sock, backlog) Enable @var{sock} to accept connection @@ -7676,7 +7008,6 @@ The return value is unspecified. @end deffn accept -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1013 @deffn {Scheme Procedure} accept sock @deffnx {C Function} scm_accept (sock) Accept a connection on a bound, listening socket. @@ -7696,7 +7027,6 @@ connection and will continue to accept new requests. @end deffn getsockname -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1040 @deffn {Scheme Procedure} getsockname sock @deffnx {C Function} scm_getsockname (sock) Return the address of @var{sock}, in the same form as the @@ -7705,7 +7035,6 @@ of a socket in the @code{AF_FILE} namespace cannot be read. @end deffn getpeername -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1062 @deffn {Scheme Procedure} getpeername sock @deffnx {C Function} scm_getpeername (sock) Return the address that @var{sock} @@ -7715,7 +7044,6 @@ is connected to, in the same form as the object returned by @end deffn recv! -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1097 @deffn {Scheme Procedure} recv! sock buf [flags] @deffnx {C Function} scm_recv (sock, buf, flags) Receive data from a socket port. @@ -7741,7 +7069,6 @@ any unread buffered port data is ignored. @end deffn send -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1130 @deffn {Scheme Procedure} send sock message [flags] @deffnx {C Function} scm_send (sock, message, flags) Transmit the string @var{message} on a socket port @var{sock}. @@ -7760,7 +7087,6 @@ any unflushed buffered port data is ignored. @end deffn recvfrom! -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1170 @deffn {Scheme Procedure} recvfrom! sock str [flags [start [end]]] @deffnx {C Function} scm_recvfrom (sock, str, flags, start, end) Return data from the socket port @var{sock} and also @@ -7789,7 +7115,6 @@ descriptor: any unread buffered port data is ignored. @end deffn sendto -@c snarfed from /home/ghouston/guile/guile-core/libguile/socket.c:1228 @deffn {Scheme Procedure} sendto sock message fam address . args_and_flags @deffnx {C Function} scm_sendto (sock, message, fam, address, args_and_flags) Transmit the string @var{message} on the socket port @@ -7813,7 +7138,6 @@ any unflushed buffered port data is ignored. @end deffn regexp? -@c snarfed from /home/ghouston/guile/guile-core/libguile/regex-posix.c:137 @deffn {Scheme Procedure} regexp? obj @deffnx {C Function} scm_regexp_p (obj) Return @code{#t} if @var{obj} is a compiled regular expression, @@ -7821,7 +7145,6 @@ or @code{#f} otherwise. @end deffn make-regexp -@c snarfed from /home/ghouston/guile/guile-core/libguile/regex-posix.c:182 @deffn {Scheme Procedure} make-regexp pat . flags @deffnx {C Function} scm_make_regexp (pat, flags) Compile the regular expression described by @var{pat}, and @@ -7864,7 +7187,6 @@ one which comes last will override the earlier one. @end deffn regexp-exec -@c snarfed from /home/ghouston/guile/guile-core/libguile/regex-posix.c:243 @deffn {Scheme Procedure} regexp-exec rx str [start [flags]] @deffnx {C Function} scm_regexp_exec (rx, str, start, flags) Match the compiled regular expression @var{rx} against @@ -7889,61 +7211,61 @@ considered the end of a line. @end deffn single-active-thread? -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:79 @deffn {Scheme Procedure} single-active-thread? implemented by the C function "scm_single_thread_p" @end deffn yield -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:85 @deffn {Scheme Procedure} yield implemented by the C function "scm_yield" @end deffn call-with-new-thread -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:90 @deffn {Scheme Procedure} call-with-new-thread implemented by the C function "scm_call_with_new_thread" @end deffn + current-thread +@deffn {Scheme Procedure} current-thread +implemented by the C function "scm_current_thread" +@end deffn + + all-threads +@deffn {Scheme Procedure} all-threads +implemented by the C function "scm_all_threads" +@end deffn + join-thread -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:104 @deffn {Scheme Procedure} join-thread implemented by the C function "scm_join_thread" @end deffn make-mutex -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:109 @deffn {Scheme Procedure} make-mutex implemented by the C function "scm_make_mutex" @end deffn lock-mutex -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:112 @deffn {Scheme Procedure} lock-mutex implemented by the C function "scm_lock_mutex" @end deffn unlock-mutex -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:117 @deffn {Scheme Procedure} unlock-mutex implemented by the C function "scm_unlock_mutex" @end deffn make-condition-variable -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:123 @deffn {Scheme Procedure} make-condition-variable implemented by the C function "scm_make_condition_variable" @end deffn wait-condition-variable -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:125 @deffn {Scheme Procedure} wait-condition-variable implemented by the C function "scm_wait_condition_variable" @end deffn signal-condition-variable -@c snarfed from /home/ghouston/guile/guile-core/libguile/threads.c:127 @deffn {Scheme Procedure} signal-condition-variable implemented by the C function "scm_signal_condition_variable" @end deffn diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index dec70e82e..2dc49db4f 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2002-10-19 Neil Jerram + + * new-docstrings.texi, scheme-binding.texi, scheme-io.texi, + scheme-scheduling.texi, posix.texi: Automatic docstring updates. + 2002-10-14 Marius Vollmer * intro.texi (Whirlwind Tour): Added pointer to examples diff --git a/doc/ref/new-docstrings.texi b/doc/ref/new-docstrings.texi index 0bfbbcb85..79d45148c 100644 --- a/doc/ref/new-docstrings.texi +++ b/doc/ref/new-docstrings.texi @@ -705,3 +705,39 @@ Return Inf. This function is used to turn on checking for a debug version of GUILE. This version does not support this functionality @end deffn + +@deffn {Scheme Procedure} all-threads +implemented by the C function "scm_all_threads" +@end deffn + +@deffn {Scheme Procedure} current-thread +implemented by the C function "scm_current_thread" +@end deffn + +@deffn {Scheme Procedure} standard-eval-closure module +@deffnx {C Function} scm_standard_eval_closure (module) +Return an eval closure for the module @var{module}. +@end deffn + +@deffn {Scheme Procedure} mask-signals +@deffnx {C Function} scm_mask_signals () +Mask signals. The returned value is not specified. +@end deffn + +@deffn {Scheme Procedure} unmask-signals +@deffnx {C Function} scm_unmask_signals () +Unmask signals. The returned value is not specified. +@end deffn + +@deffn {Scheme Procedure} noop . args +@deffnx {C Function} scm_noop (args) +Do nothing. When called without arguments, return @code{#f}, +otherwise return the first argument. +@end deffn + +@deffn {Scheme Procedure} system-async thunk +@deffnx {C Function} scm_system_async (thunk) +This function is deprecated. You can use @var{thunk} directly +instead of explicitely creating an async object. + +@end deffn diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index f372c6e48..5ecceaf89 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -1526,8 +1526,8 @@ handles the signal, or @code{#f} if a non-Scheme procedure handles the signal. The CDR contains the current @code{sigaction} flags for the handler. If @var{handler} is provided, it is installed as the new handler for -@var{signum}. The parameter @var{handler} can be a Scheme procedure -taking one argument, or the value of @code{SIG_DFL} (default action) or +@var{signum}. @var{handler} can be a Scheme procedure taking one +argument, or the value of @code{SIG_DFL} (default action) or @code{SIG_IGN} (ignore), or @code{#f} to restore whatever signal handler was installed before @code{sigaction} was first used. When a scheme procedure has been specified, that procedure will run in the given diff --git a/doc/ref/scheme-binding.texi b/doc/ref/scheme-binding.texi index 987779c22..e9b891871 100644 --- a/doc/ref/scheme-binding.texi +++ b/doc/ref/scheme-binding.texi @@ -267,7 +267,7 @@ top level environment. @c NJFIXME explain [env] @deffn {Scheme Procedure} defined? sym [env] -@deffnx {C Function} scm_definedp (sym, env) +@deffnx {C Function} scm_defined_p (sym, env) Return @code{#t} if @var{sym} is defined in the lexical environment @var{env}. When @var{env} is not specified, look in the top-level environment as defined by the current module. @end deffn diff --git a/doc/ref/scheme-io.texi b/doc/ref/scheme-io.texi index 3df790051..b4a288fbc 100644 --- a/doc/ref/scheme-io.texi +++ b/doc/ref/scheme-io.texi @@ -839,7 +839,7 @@ accepting or delivering characters. It allows emulation of I/O ports. @deffnx {C Function} scm_make_soft_port (pv, modes) Return a port capable of receiving or delivering characters as specified by the @var{modes} string (@pxref{File Ports, -open-file}). @var{pv} must be a vector of length 5. Its +open-file}). @var{pv} must be a vector of length 5 or 6. Its components are as follows: @enumerate 0 @@ -853,6 +853,9 @@ thunk for flushing output thunk for getting one character @item thunk for closing port (not by garbage collection) +@item +(if present and not @code{#f}) thunk for computing the number of +characters that can be read from the port without blocking. @end enumerate For an output-only port only elements 0, 1, 2, and 4 need be diff --git a/doc/ref/scheme-scheduling.texi b/doc/ref/scheme-scheduling.texi index da5db4e8a..5f0bda05a 100644 --- a/doc/ref/scheme-scheduling.texi +++ b/doc/ref/scheme-scheduling.texi @@ -99,7 +99,7 @@ temporarily decrease the blocking level of the current thread. You can use it when you want to disable asyncs by default and only allow them temporarily. -@deffn {Scheme procedure} system-async-mark proc [thread] +@deffn {Scheme Procedure} system-async-mark proc [thread] @deffnx {C Function} scm_system_async_mark (proc) @deffnx {C Function} scm_system_async_mark_for_thread (proc, thread) Mark @var{proc} (a procedure with zero arguments) for future execution @@ -115,7 +115,7 @@ signal handlers. @deffn {Scheme Procedure} call-with-blocked-asyncs proc @deffnx {C Function} scm_call_with_blocked_asyncs (proc) -@deffnx {C Function} void *scm_c_call_with_blocked_asyncs (void *(*p) (void *d), void *d) +@deffnx {C Function} void *scm_c_call_with_blocked_asyncs (void * (*proc) (void *data), void *data) Call @var{proc} and block the execution of system asyncs by one level for the current thread while it is running. Return the value returned by @var{proc}. For the first two variants, call @var{proc} with no diff --git a/libguile/async.c b/libguile/async.c index 9a11a9e11..7db38d936 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -228,9 +228,14 @@ scm_i_queue_async_cell (SCM c, scm_root_state *root) SCM_DEFINE (scm_system_async_mark_for_thread, "system-async-mark", 1, 1, 0, (SCM proc, SCM thread), - "Register the procedure @var{proc} for future execution\n" - "in @var{thread}. When @var{thread} is not specified,\n" - "use the current thread.") + "Mark @var{proc} (a procedure with zero arguments) for future execution\n" + "in @var{thread}. If @var{proc} has already been marked for\n" + "@var{thread} but has not been executed yet, this call has no effect.\n" + "If @var{thread} is omitted, the thread that called\n" + "@code{system-async-mark} is used.\n\n" + "This procedure is not safe to be called from C signal handlers. Use\n" + "@code{scm_sigaction} or @code{scm_sigaction_for_thread} to install\n" + "signal handlers.") #define FUNC_NAME s_scm_system_async_mark_for_thread { #ifdef USE_THREADS From 454b82f41f23a75d2d696b24f8f41f1629b02e52 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sun, 20 Oct 2002 21:51:16 +0000 Subject: [PATCH 293/306] * boot-9.scm (top-repl): Look for use-emacs-interface in guile-user-module (should it be there?) instead of the-root-module. --- ice-9/boot-9.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index f3d50b744..c3ef7f6f2 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2832,8 +2832,8 @@ (let ((guile-user-module (resolve-module '(guile-user)))) ;; Load emacs interface support if emacs option is given. - (if (and (module-defined? the-root-module 'use-emacs-interface) - (module-ref the-root-module 'use-emacs-interface)) + (if (and (module-defined? guile-user-module 'use-emacs-interface) + (module-ref guile-user-module 'use-emacs-interface)) (load-emacs-interface)) ;; Use some convenient modules (in reverse order) From a7785f36d42d15b146f1f2fdf1547fd58d44c1a9 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sun, 20 Oct 2002 21:51:53 +0000 Subject: [PATCH 294/306] *** empty log message *** --- ice-9/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index f99793a1a..8b67d6662 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,9 @@ +2002-10-20 Mikael Djurfeldt + + * boot-9.scm (top-repl): Look for use-emacs-interface in + guile-user-module (should it be there?) instead of + the-root-module. + 2002-10-10 Marius Vollmer * boot-9.scm (top-repl): Use 2 as the limit when saving the stack. From 6182ceacb46a4892d00402cf2e3f0e8aa03bbb92 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 20 Oct 2002 22:59:01 +0000 Subject: [PATCH 295/306] (SCM_MAKE_VALIDATE_MSG): New. Use it instead of SCM_MAKE_VALIDATE in lots of places to gove better error messages. Thanks to Bill Schottstaedt! --- libguile/async.c | 2 +- libguile/goops.h | 14 ++++---- libguile/modules.h | 4 +-- libguile/validate.h | 79 ++++++++++++++++++++++++--------------------- 4 files changed, 52 insertions(+), 47 deletions(-) diff --git a/libguile/async.c b/libguile/async.c index 7db38d936..48f54c59b 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -106,7 +106,7 @@ static scm_t_bits tc16_async; /* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it. this is ugly. */ #define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X) -#define VALIDATE_ASYNC(pos, a) SCM_MAKE_VALIDATE(pos, a, ASYNCP) +#define VALIDATE_ASYNC(pos, a) SCM_MAKE_VALIDATE_MSG(pos, a, ASYNCP, "user async") #define ASYNC_GOT_IT(X) (SCM_CELL_WORD_0 (X) >> 16) #define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) << 16))) diff --git a/libguile/goops.h b/libguile/goops.h index 655b727cf..9c733ba42 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -3,7 +3,7 @@ #ifndef SCM_GOOPS_H #define SCM_GOOPS_H -/* Copyright (C) 1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1998,1999,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -128,19 +128,19 @@ typedef struct scm_t_method { #define SCM_CLASSP(x) \ (SCM_STRUCTP (x) && SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_METACLASS) -#define SCM_VALIDATE_CLASS(pos, x) SCM_MAKE_VALIDATE (pos, x, CLASSP) +#define SCM_VALIDATE_CLASS(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, CLASSP, "class") #define SCM_INSTANCEP(x) \ (SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_GOOPS)) -#define SCM_VALIDATE_INSTANCE(pos, x) SCM_MAKE_VALIDATE (pos, x, INSTANCEP) +#define SCM_VALIDATE_INSTANCE(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, INSTANCEP, "instance") #define SCM_PUREGENERICP(x) \ (SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_PURE_GENERIC)) -#define SCM_VALIDATE_PUREGENERIC(pos, x) SCM_MAKE_VALIDATE (pos, x, PUREGENERICP) +#define SCM_VALIDATE_PUREGENERIC(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, PUREGENERICP, "pure generic function") #define SCM_ACCESSORP(x) \ (SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_ACCESSOR_METHOD)) -#define SCM_VALIDATE_ACCESSOR(pos, x) SCM_MAKE_VALIDATE (pos, x, ACCESSORP) +#define SCM_VALIDATE_ACCESSOR(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, ACCESSORP, "accessor") #define SCM_SLOT(x, i) (SCM_PACK (SCM_INST (x) [i])) #define SCM_SET_SLOT(x, i, v) (SCM_INST (x) [i] = SCM_UNPACK (v)) @@ -153,11 +153,11 @@ typedef struct scm_t_method { #define SCM_GENERICP(x) \ (SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), scm_class_generic)) -#define SCM_VALIDATE_GENERIC(pos, x) SCM_MAKE_VALIDATE (pos, x, GENERICP) +#define SCM_VALIDATE_GENERIC(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, GENERICP, "generic function") #define SCM_METHODP(x) \ (SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), scm_class_method)) -#define SCM_VALIDATE_METHOD(pos, x) SCM_MAKE_VALIDATE (pos, x, METHODP) +#define SCM_VALIDATE_METHOD(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, METHODP, "method") #define SCM_MCACHE_N_SPECIALIZED(C) SCM_CADDR (C) #define SCM_SET_MCACHE_N_SPECIALIZED(C, X) SCM_SETCAR (SCM_CDDR (C), X) diff --git a/libguile/modules.h b/libguile/modules.h index 32d74efeb..db3d789be 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -3,7 +3,7 @@ #ifndef SCM_MODULES_H #define SCM_MODULES_H -/* Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2000, 2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -58,7 +58,7 @@ SCM_API scm_t_bits scm_module_tag; #define SCM_MODULEP(OBJ) \ (!SCM_IMP (OBJ) && SCM_CELL_TYPE (OBJ) == scm_module_tag) -#define SCM_VALIDATE_MODULE(pos, scm) SCM_MAKE_VALIDATE (pos, scm, MODULEP) +#define SCM_VALIDATE_MODULE(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, MODULEP, "module") /* NOTE: Indexes of module fields are dependent upon the definition of * module-type in boot-9.scm. diff --git a/libguile/validate.h b/libguile/validate.h index 2a2c83b52..7c77f0496 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -3,7 +3,7 @@ #ifndef SCM_VALIDATE_H #define SCM_VALIDATE_H -/* Copyright (C) 1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -141,6 +141,11 @@ SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, #pred); \ } while (0) +#define SCM_MAKE_VALIDATE_MSG(pos, var, pred, msg) \ + do { \ + SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, msg); \ + } while (0) + #define SCM_VALIDATE_REST_ARGUMENT(x) \ @@ -152,9 +157,9 @@ } \ } while (0) -#define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE (pos, scm, NIMP) +#define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate") -#define SCM_VALIDATE_BOOL(pos, flag) SCM_MAKE_VALIDATE(pos, flag, BOOLP) +#define SCM_VALIDATE_BOOL(pos, flag) SCM_MAKE_VALIDATE_MSG(pos, flag, BOOLP, "boolean") #define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \ do { \ @@ -162,7 +167,7 @@ cvar = SCM_EQ_P (flag, SCM_BOOL_T) ? 1 : 0; \ } while (0) -#define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE (pos, scm, CHARP) +#define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character") #define SCM_VALIDATE_CHAR_COPY(pos, scm, cvar) \ do { \ @@ -170,7 +175,7 @@ cvar = SCM_CHAR (scm); \ } while (0) -#define SCM_VALIDATE_STRING(pos, str) SCM_MAKE_VALIDATE (pos, str, STRINGP) +#define SCM_VALIDATE_STRING(pos, str) SCM_MAKE_VALIDATE_MSG (pos, str, STRINGP, "string") #define SCM_VALIDATE_STRING_COPY(pos, str, cvar) \ do { \ @@ -196,11 +201,11 @@ && (size_t) c_end <= SCM_STRING_LENGTH (str));\ } while (0) -#define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE (pos, z, REALP) +#define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, REALP, "real") -#define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE (pos, z, NUMBERP) +#define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, NUMBERP, "number") -#define SCM_VALIDATE_INUM(pos, k) SCM_MAKE_VALIDATE (pos, k, INUMP) +#define SCM_VALIDATE_INUM(pos, k) SCM_MAKE_VALIDATE_MSG (pos, k, INUMP, "exact integer") #define SCM_VALIDATE_INUM_COPY(pos, k, cvar) \ do { \ @@ -248,7 +253,7 @@ cvar = SCM_NUM2DOUBLE (pos, k); \ } while (0) -#define SCM_VALIDATE_BIGINT(pos, k) SCM_MAKE_VALIDATE (pos, k, BIGP) +#define SCM_VALIDATE_BIGINT(pos, k) SCM_MAKE_VALIDATE_MSG (pos, k, BIGP, "bignum") #define SCM_VALIDATE_INUM_MIN(pos, k, min) \ do { \ @@ -321,11 +326,11 @@ cvar = SCM_INUM (k); \ } while (0) -#define SCM_VALIDATE_NULL(pos, scm) SCM_MAKE_VALIDATE (pos, scm, NULLP) +#define SCM_VALIDATE_NULL(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NULLP, "null") -#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) SCM_MAKE_VALIDATE (pos, scm, NULL_OR_NIL_P) +#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NULL_OR_NIL_P, "null") -#define SCM_VALIDATE_CONS(pos, scm) SCM_MAKE_VALIDATE (pos, scm, CONSP) +#define SCM_VALIDATE_CONS(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CONSP, "pair") #define SCM_VALIDATE_LIST(pos, lst) \ do { \ @@ -367,7 +372,7 @@ SCM_ASSERT (scm_valid_oport_value_p (port), port, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_PRINTSTATE(pos, a) SCM_MAKE_VALIDATE(pos, a, PRINT_STATE_P) +#define SCM_VALIDATE_PRINTSTATE(pos, a) SCM_MAKE_VALIDATE_MSG(pos, a, PRINT_STATE_P, "print-state") #define SCM_VALIDATE_SMOB(pos, obj, type) \ do { \ @@ -375,20 +380,20 @@ obj, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_THREAD(pos, a) SCM_MAKE_VALIDATE (pos, a, THREADP) +#define SCM_VALIDATE_THREAD(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, THREADP, "thread") #define SCM_VALIDATE_THUNK(pos, thunk) \ do { \ SCM_ASSERT (!SCM_FALSEP (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_SYMBOL(pos, sym) SCM_MAKE_VALIDATE (pos, sym, SYMBOLP) +#define SCM_VALIDATE_SYMBOL(pos, sym) SCM_MAKE_VALIDATE_MSG (pos, sym, SYMBOLP, "symbol") -#define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE (pos, var, VARIABLEP) +#define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable") -#define SCM_VALIDATE_MEMOIZED(pos, obj) SCM_MAKE_VALIDATE (pos, obj, MEMOIZEDP) +#define SCM_VALIDATE_MEMOIZED(pos, obj) SCM_MAKE_VALIDATE_MSG (pos, obj, MEMOIZEDP, "memoized code") -#define SCM_VALIDATE_CLOSURE(pos, obj) SCM_MAKE_VALIDATE (pos, obj, CLOSUREP) +#define SCM_VALIDATE_CLOSURE(pos, obj) SCM_MAKE_VALIDATE_MSG (pos, obj, CLOSUREP, "closure") #define SCM_VALIDATE_PROC(pos, proc) \ do { \ @@ -400,26 +405,26 @@ SCM_ASSERT (SCM_NULLP (env) || SCM_CONSP (env), env, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE (pos, a, HOOKP) +#define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, HOOKP, "hook") -#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE (pos, a, RGXP) +#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, RGXP, "regexp") -#define SCM_VALIDATE_DIR(pos, port) SCM_MAKE_VALIDATE (pos, port, DIRP) +#define SCM_VALIDATE_DIR(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, DIRP, "directory port") -#define SCM_VALIDATE_PORT(pos, port) SCM_MAKE_VALIDATE (pos, port, PORTP) +#define SCM_VALIDATE_PORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, PORTP, "port") #define SCM_VALIDATE_INPUT_PORT(pos, port) \ - SCM_MAKE_VALIDATE (pos, port, INPUT_PORT_P) + SCM_MAKE_VALIDATE_MSG (pos, port, INPUT_PORT_P, "input port") #define SCM_VALIDATE_OUTPUT_PORT(pos, port) \ - SCM_MAKE_VALIDATE (pos, port, OUTPUT_PORT_P) + SCM_MAKE_VALIDATE_MSG (pos, port, OUTPUT_PORT_P, "output port") -#define SCM_VALIDATE_FPORT(pos, port) SCM_MAKE_VALIDATE (pos, port, FPORTP) +#define SCM_VALIDATE_FPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, FPORTP, "file port") -#define SCM_VALIDATE_OPFPORT(pos, port) SCM_MAKE_VALIDATE (pos, port, OPFPORTP) +#define SCM_VALIDATE_OPFPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, OPFPORTP, "open file port") #define SCM_VALIDATE_OPINPORT(pos, port) \ - SCM_MAKE_VALIDATE (pos, port, OPINPORTP) + SCM_MAKE_VALIDATE_MSG (pos, port, OPINPORTP, "open input port") #define SCM_VALIDATE_OPENPORT(pos, port) \ do { \ @@ -427,23 +432,23 @@ port, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_OPPORT(pos, port) SCM_MAKE_VALIDATE (pos, port, OPPORTP) +#define SCM_VALIDATE_OPPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, OPPORTP, "open port") #define SCM_VALIDATE_OPOUTPORT(pos, port) \ - SCM_MAKE_VALIDATE (pos, port, OPOUTPORTP) + SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTPORTP, "open output port") #define SCM_VALIDATE_OPOUTSTRPORT(pos, port) \ - SCM_MAKE_VALIDATE (pos, port, OPOUTSTRPORTP) + SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTSTRPORTP, "open output string port") -#define SCM_VALIDATE_FLUID(pos, fluid) SCM_MAKE_VALIDATE (pos, fluid, FLUIDP) +#define SCM_VALIDATE_FLUID(pos, fluid) SCM_MAKE_VALIDATE_MSG (pos, fluid, FLUIDP, "fluid") -#define SCM_VALIDATE_KEYWORD(pos, v) SCM_MAKE_VALIDATE (pos, v, KEYWORDP) +#define SCM_VALIDATE_KEYWORD(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, KEYWORDP, "keyword") -#define SCM_VALIDATE_STACK(pos, v) SCM_MAKE_VALIDATE (pos, v, STACKP) +#define SCM_VALIDATE_STACK(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, STACKP, "stack") -#define SCM_VALIDATE_FRAME(pos, v) SCM_MAKE_VALIDATE (pos, v, FRAMEP) +#define SCM_VALIDATE_FRAME(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, FRAMEP, "frame") -#define SCM_VALIDATE_RSTATE(pos, v) SCM_MAKE_VALIDATE (pos, v, RSTATEP) +#define SCM_VALIDATE_RSTATE(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, RSTATEP, "random-generator-state") #define SCM_VALIDATE_ARRAY(pos, v) \ do { \ @@ -452,7 +457,7 @@ v, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_VECTOR(pos, v) SCM_MAKE_VALIDATE (pos, v, VECTORP) +#define SCM_VALIDATE_VECTOR(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, VECTORP, "vector") #define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \ do { \ @@ -461,7 +466,7 @@ v, pos, FUNC_NAME); \ } while (0) -#define SCM_VALIDATE_STRUCT(pos, v) SCM_MAKE_VALIDATE (pos, v, STRUCTP) +#define SCM_VALIDATE_STRUCT(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, STRUCTP, "struct") #define SCM_VALIDATE_VTABLE(pos, v) \ do { \ From 087ed40df2ae84a0bca3fdb2d4e27ce429ee2bbf Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 20 Oct 2002 22:59:32 +0000 Subject: [PATCH 296/306] *** empty log message *** --- libguile/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index e9bb2eb37..0f7ca0437 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-10-21 Marius Vollmer + + * async.c, goops.h, modules.h, validate.h (SCM_MAKE_VALIDATE_MSG): + New. Use it instead of SCM_MAKE_VALIDATE in lots of places to + gove better error messages. Thanks to Bill Schottstaedt! + 2002-10-19 Dirk Herrmann * evalext.h, evalext.c (scm_definedp, scm_defined_p): Renamed From c2015a4f537e9037d1f715b0e8421c1312225dcb Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Mon, 21 Oct 2002 11:22:04 +0000 Subject: [PATCH 297/306] * readline.scm (activate-readline): Look for use-emacs-interface option in the guile-user module instead of the-root-module. --- guile-readline/ChangeLog | 5 + guile-readline/readline.scm | 217 ------------------------------------ 2 files changed, 5 insertions(+), 217 deletions(-) diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index 8f568e200..6584e820c 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,8 @@ +2002-10-21 Mikael Djurfeldt + + * readline.scm (activate-readline): Look for use-emacs-interface + option in the guile-user module instead of the-root-module. + 2002-04-30 Marius Vollmer * autogen.sh: Invoke plain aclocal instead of guile-aclocal.sh. diff --git a/guile-readline/readline.scm b/guile-readline/readline.scm index cae45e30b..e69de29bb 100644 --- a/guile-readline/readline.scm +++ b/guile-readline/readline.scm @@ -1,217 +0,0 @@ -;;;; readline.scm --- support functions for command-line editing -;;;; -;;;; Copyright (C) 1997, 1999, 2000, 2001 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; -;;;; Contributed by Daniel Risacher . -;;;; Extensions based upon code by -;;;; Andrew Archibald . - - - -(define-module (ice-9 readline) - :use-module (ice-9 session) - :use-module (ice-9 regex) - :use-module (ice-9 buffered-input) - :no-backtrace) - - - -;;; Dynamically link the glue code for accessing the readline library, -;;; but only when it isn't already present. - -(if (not (provided? 'readline)) - (load-extension "libguilereadline" "scm_init_readline")) - -(if (not (provided? 'readline)) - (scm-error 'misc-error - #f - "readline is not provided in this Guile installation" - '() - '())) - - - -;;; Run-time options - -(export - readline-options - readline-enable - readline-disable) -(export-syntax - readline-set!) - -(define-option-interface - (readline-options-interface - (readline-options readline-enable readline-disable) - (readline-set!))) - - - -;;; MDJ 980513 : -;;; There should probably be low-level support instead of this code. - -;;; Dirk:FIXME:: If the-readline-port, input-port or output-port are closed, -;;; guile will enter an endless loop or crash. - -(define prompt "") -(define prompt2 "") -(define input-port (current-input-port)) -(define output-port (current-output-port)) -(define read-hook #f) - -(define (make-readline-port) - (make-line-buffered-input-port (lambda (continuation?) - (let* ((prompt (if continuation? - prompt2 - prompt)) - (str (%readline (if (string? prompt) - prompt - (prompt)) - input-port - output-port - read-hook))) - (or (eof-object? str) - (string=? str "") - (add-history str)) - str)))) - -;;; We only create one readline port. There's no point in having -;;; more, since they would all share the tty and history --- -;;; everything except the prompt. And don't forget the -;;; compile/load/run phase distinctions. Also, the readline library -;;; isn't reentrant. -(define the-readline-port #f) - -(define history-variable "GUILE_HISTORY") -(define history-file (string-append (getenv "HOME") "/.guile_history")) - -(define-public readline-port - (let ((do (lambda (r/w) - (if (memq 'history-file (readline-options-interface)) - (r/w (or (getenv history-variable) - history-file)))))) - (lambda () - (if (not the-readline-port) - (begin - (do read-history) - (set! the-readline-port (make-readline-port)) - (add-hook! exit-hook (lambda () - (do write-history) - (clear-history))))) - the-readline-port))) - -;;; The user might try to use readline in his programs. It then -;;; becomes very uncomfortable that the current-input-port is the -;;; readline port... -;;; -;;; Here, we detect this situation and replace it with the -;;; underlying port. -;;; -;;; %readline is the low-level readline procedure. - -(define-public (readline . args) - (let ((prompt prompt) - (inp input-port)) - (cond ((not (null? args)) - (set! prompt (car args)) - (set! args (cdr args)) - (cond ((not (null? args)) - (set! inp (car args)) - (set! args (cdr args)))))) - (apply %readline - prompt - (if (eq? inp the-readline-port) - input-port - inp) - args))) - -(define-public (set-readline-prompt! p . rest) - (set! prompt p) - (if (not (null? rest)) - (set! prompt2 (car rest)))) - -(define-public (set-readline-input-port! p) - (cond ((or (not (file-port? p)) (not (input-port? p))) - (scm-error 'wrong-type-arg "set-readline-input-port!" - "Not a file input port: ~S" (list p) #f)) - ((port-closed? p) - (scm-error 'misc-error "set-readline-input-port!" - "Port not open: ~S" (list p) #f)) - (else - (set! input-port p)))) - -(define-public (set-readline-output-port! p) - (cond ((or (not (file-port? p)) (not (output-port? p))) - (scm-error 'wrong-type-arg "set-readline-input-port!" - "Not a file output port: ~S" (list p) #f)) - ((port-closed? p) - (scm-error 'misc-error "set-readline-output-port!" - "Port not open: ~S" (list p) #f)) - (else - (set! output-port p)))) - -(define-public (set-readline-read-hook! h) - (set! read-hook h)) - -(if (provided? 'regex) - (begin - (define-public apropos-completion-function - (let ((completions '())) - (lambda (text cont?) - (if (not cont?) - (set! completions - (map symbol->string - (apropos-internal - (string-append "^" (regexp-quote text)))))) - (if (null? completions) - #f - (let ((retval (car completions))) - (begin (set! completions (cdr completions)) - retval)))))) - - (set! *readline-completion-function* apropos-completion-function) - )) - -(define-public (with-readline-completion-function completer thunk) - "With @var{completer} as readline completion function, call @var{thunk}." - (let ((old-completer *readline-completion-function*)) - (dynamic-wind - (lambda () - (set! *readline-completion-function* completer)) - thunk - (lambda () - (set! *readline-completion-function* old-completer))))) - -(define-public (activate-readline) - (if (and (isatty? (current-input-port)) - (not (and (module-defined? the-root-module 'use-emacs-interface) - (module-ref the-root-module 'use-emacs-interface)))) - (let ((read-hook (lambda () (run-hook before-read-hook)))) - (set-current-input-port (readline-port)) - (set! repl-reader - (lambda (prompt) - (dynamic-wind - (lambda () - (set-buffered-input-continuation?! (readline-port) #f) - (set-readline-prompt! prompt "... ") - (set-readline-read-hook! read-hook)) - (lambda () (read)) - (lambda () - (set-readline-prompt! "" "") - (set-readline-read-hook! #f))))) - (set! (using-readline?) #t)))) From 29b6ae074808dfabac9159cf7beb3df018fc04b7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 21 Oct 2002 12:03:30 +0000 Subject: [PATCH 298/306] (%thread-handler): Do not call unmask-signals, that should be unnecessary now. --- ice-9/threads.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ice-9/threads.scm b/ice-9/threads.scm index 586bae368..42dc38d96 100644 --- a/ice-9/threads.scm +++ b/ice-9/threads.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1996, 1998, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1996, 1998, 2001, 2002 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -67,7 +67,6 @@ (define (%thread-handler tag . args) (fluid-set! the-last-stack #f) - (unmask-signals) (let ((n (length args)) (p (current-error-port))) (display "In thread:" p) From 03453b05f3e836caaa57f4ca372a7de13de6f1b5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 21 Oct 2002 12:03:46 +0000 Subject: [PATCH 299/306] *** empty log message *** --- ice-9/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 8b67d6662..79ecdeb24 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2002-10-21 Marius Vollmer + + * threads.scm (%thread-handler): Do not call unmask-signals, that + should be unnecessary now. + 2002-10-20 Mikael Djurfeldt * boot-9.scm (top-repl): Look for use-emacs-interface in From 64e00566db6979144b3d151111e1128d4db15750 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 21 Oct 2002 12:03:54 +0000 Subject: [PATCH 300/306] Include . Also, use <...> for inclusion of system headers. --- libguile/null-threads.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/libguile/null-threads.c b/libguile/null-threads.c index ac1a135e1..41842a1b8 100644 --- a/libguile/null-threads.c +++ b/libguile/null-threads.c @@ -46,8 +46,9 @@ #include "libguile/root.h" #include "libguile/stackchk.h" #include "libguile/async.h" -#include "sys/time.h" -#include "sys/types.h" +#include +#include +#include void *scm_null_threads_data; From 585356dcbd04da4274ab83fb9456f3c6c4c04e4b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 21 Oct 2002 12:16:25 +0000 Subject: [PATCH 301/306] Changed logic in thread support configuration such that --with-threads=no is equivalent to --with-threads=null. On platforms that are not supported by QuickThreads, we also use the null-threads. Thus, USE_THREADS is always defined now. --- configure.in | 76 ++++++++++++++++++++++++---------------------------- 1 file changed, 35 insertions(+), 41 deletions(-) diff --git a/configure.in b/configure.in index 4ececda57..d5ecf5f93 100644 --- a/configure.in +++ b/configure.in @@ -638,14 +638,13 @@ AC_ARG_WITH(threads, [ --with-threads thread interface], ### Turn $with_threads into either the name of a threads package, like ### `qt', or `no', meaning that threads should not be supported. -AC_MSG_CHECKING(whether to support threads) +AC_MSG_CHECKING(what kind of threads to support) case "$with_threads" in "yes" | "qt" | "coop" | "") with_threads=qt ;; - "null" ) - ;; - "no" ) + "no" | "null") + with_threads=null ;; * ) AC_MSG_ERROR(invalid value for --with-threads: $with_threads) @@ -659,7 +658,7 @@ case "${with_threads}" in "qt" ) ## This configures the QuickThreads package, and sets or clears ## the THREAD_PACKAGE variable if qthreads don't configure - ## correctly. + ## correctly. In that case, we fall back on null-threads. QTHREADS_CONFIGURE ;; "null" ) @@ -667,49 +666,44 @@ case "${with_threads}" in ;; esac +## We always provide the thread API now and thus, USE_THREADS is +## always defined and threads.o is always included. -## If we're using threads, bring in some other parts of Guile which -## work with them. -if test "${THREAD_PACKAGE}" != "" ; then - AC_DEFINE(USE_THREADS, 1, [Define if providing the thread API.]) +AC_DEFINE(USE_THREADS, 1, [Define if providing the thread API.]) +AC_LIBOBJ([threads]) - ## Include the Guile thread interface in the library... - AC_LIBOBJ([threads]) +case "${THREAD_PACKAGE}" in + "QT" ) + AC_DEFINE(USE_COOP_THREADS, 1, + [Define if using cooperative multithreading.]) - ## ... and tell it which package to talk to. - case "${THREAD_PACKAGE}" in - "QT" ) - AC_DEFINE(USE_COOP_THREADS, 1, - [Define if using cooperative multithreading.]) + AC_ARG_ENABLE(linuxthreads, + [ --disable-linuxthreads disable linuxthreads workaround],, + enable_linuxthreads=yes) - AC_ARG_ENABLE(linuxthreads, - [ --disable-linuxthreads disable linuxthreads workaround],, - enable_linuxthreads=yes) + ## Workaround for linuxthreads (optionally disabled) + if test $host_os = linux-gnu -a "$enable_linuxthreads" = yes; then + AC_DEFINE(GUILE_PTHREAD_COMPAT, 1, + [Define to enable workaround for COOP-linuxthreads compatibility.]) + AC_CHECK_LIB(pthread, main) + fi - ## Workaround for linuxthreads (optionally disabled) - if test $host_os = linux-gnu -a "$enable_linuxthreads" = yes; then - AC_DEFINE(GUILE_PTHREAD_COMPAT, 1, - [Define to enable workaround for COOP-linuxthreads compatibility.]) - AC_CHECK_LIB(pthread, main) - fi + ## Bring in scm_internal_select, if appropriate. + if test $ac_cv_func_gettimeofday = yes && + test $ac_cv_func_select = yes; then + AC_DEFINE(GUILE_ISELECT, 1, [Define to implement scm_internal_select.]) + fi - ## Bring in scm_internal_select, if appropriate. - if test $ac_cv_func_gettimeofday = yes && - test $ac_cv_func_select = yes; then - AC_DEFINE(GUILE_ISELECT, 1, [Define to implement scm_internal_select.]) - fi + ;; + "null" | "" ) + AC_DEFINE(USE_NULL_THREADS, 1, + [Define if using one-thread 'multi'threading.]) + ;; + * ) + AC_MSG_ERROR(invalid value for THREAD_PACKAGE: ${THREAD_PACKAGE}) + ;; +esac - ;; - "null" ) - AC_DEFINE(USE_NULL_THREADS, 1, - [Define if using one-thread 'multi'threading.]) - ;; - * ) - AC_MSG_ERROR(invalid value for THREAD_PACKAGE: ${THREAD_PACKAGE}) - ;; - esac - -fi ## Cross building if test "$cross_compiling" = "yes"; then From 65a23095abd464eb5ac4bd94b100c0205dedeca1 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 21 Oct 2002 12:19:08 +0000 Subject: [PATCH 302/306] *** empty log message *** --- ChangeLog | 7 +++++++ libguile/ChangeLog | 3 +++ 2 files changed, 10 insertions(+) diff --git a/ChangeLog b/ChangeLog index 15ec725cc..350f3f4fe 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2002-10-21 Marius Vollmer + + * configure.in: Changed logic in thread support configuration such + that --with-threads=no is equivalent to --with-threads=null. On + platforms that are not supported by QuickThreads, we also use the + null-threads. Thus, USE_THREADS is always defined now. + 2002-10-16 Marius Vollmer * configure.in: Shuffled around and extended the thread diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 0f7ca0437..51efb7caf 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,8 @@ 2002-10-21 Marius Vollmer + * null-threads.c: Include . Also, use <...> for inclusion + of system headers. + * async.c, goops.h, modules.h, validate.h (SCM_MAKE_VALIDATE_MSG): New. Use it instead of SCM_MAKE_VALIDATE in lots of places to gove better error messages. Thanks to Bill Schottstaedt! From 429d88d4e7518b668dc305c2cb389d632c66c66b Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 21 Oct 2002 12:20:01 +0000 Subject: [PATCH 303/306] New stuff about the thread support. --- NEWS | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index ee7227d85..a111bff55 100644 --- a/NEWS +++ b/NEWS @@ -12,12 +12,13 @@ Changes since the stable branch: When you configure "--with-threads=null", you will get the usual threading API (call-with-new-thread, make-mutex, etc), but you can't -actually create new threads. +actually create new threads. Also, "--with-threads=no" is now +equivalent to "--with-threads=null". This means that the thread API +is always present, although you might not be able to create new +threads. -The short term plan is to remove the support for --with-threads=no -completely so that one doesn't need to special case as much when -writing code that needs to be thread-aware but should also work -without threads. +When cooperative threading is not supported on your platform, you will +get the "null" threads. The long term plan is to make the selection of a thread implementation a run-time option, not a configure time option. From fc41ba03f3b6ccda612de0deb91bba94e872ed0f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 21 Oct 2002 12:53:29 +0000 Subject: [PATCH 304/306] *** empty log message *** --- NEWS | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index a111bff55..eb7b86193 100644 --- a/NEWS +++ b/NEWS @@ -8,7 +8,8 @@ Changes since the stable branch: * Changes to the distribution -** There is a new thread implementation option: "null". +** There is a new thread implementation option "null", which is also + the default now. When you configure "--with-threads=null", you will get the usual threading API (call-with-new-thread, make-mutex, etc), but you can't @@ -18,7 +19,7 @@ is always present, although you might not be able to create new threads. When cooperative threading is not supported on your platform, you will -get the "null" threads. +get the "null" threads instead. The long term plan is to make the selection of a thread implementation a run-time option, not a configure time option. From f5d6f0fcabca62f119e85967ed1809722eca9162 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 25 Oct 2002 15:02:46 +0000 Subject: [PATCH 305/306] * upstream/ltdl.c: New copy from libtool 1.4.3. * raw-ltdl.c: Merged in changes from libtool 1.4.3. --- libguile-ltdl/raw-ltdl.c | 341 ++++++++++++++++++--------------- libguile-ltdl/upstream/ltdl.c | 346 ++++++++++++++++++---------------- 2 files changed, 374 insertions(+), 313 deletions(-) diff --git a/libguile-ltdl/raw-ltdl.c b/libguile-ltdl/raw-ltdl.c index 6341758a1..eafef27a7 100644 --- a/libguile-ltdl/raw-ltdl.c +++ b/libguile-ltdl/raw-ltdl.c @@ -94,6 +94,11 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA #include "raw-ltdl.h" +#if WITH_DMALLOC +# include +#endif + + /* Saves on those hard to debug '\0' typos.... */ #define LT_EOS_CHAR '\0' @@ -167,6 +172,18 @@ SCMLTSTATIC LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) /* The following macros reduce the amount of typing needed to cast assigned memory. */ +#if WITH_DMALLOC + +#define LT_DLMALLOC(tp, n) ((tp *) xmalloc ((n) * sizeof(tp))) +#define LT_DLREALLOC(tp, p, n) ((tp *) xrealloc ((p), (n) * sizeof(tp))) +#define LT_DLFREE(p) \ + LT_STMT_START { if (p) (p) = (xfree (p), (lt_ptr) 0); } LT_STMT_END + +#define LT_EMALLOC(tp, n) ((tp *) xmalloc ((n) * sizeof(tp))) +#define LT_EREALLOC(tp, p, n) ((tp *) xrealloc ((p), (n) * sizeof(tp))) + +#else + #define LT_DLMALLOC(tp, n) ((tp *) lt_dlmalloc ((n) * sizeof(tp))) #define LT_DLREALLOC(tp, p, n) ((tp *) rpl_realloc ((p), (n) * sizeof(tp))) #define LT_DLFREE(p) \ @@ -175,8 +192,10 @@ SCMLTSTATIC LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) #define LT_EMALLOC(tp, n) ((tp *) lt_emalloc ((n) * sizeof(tp))) #define LT_EREALLOC(tp, p, n) ((tp *) lt_erealloc ((p), (n) * sizeof(tp))) +#endif + #define LT_DLMEM_REASSIGN(p, q) LT_STMT_START { \ - if ((p) != (q)) { lt_dlfree (p); (p) = (q); (q) = 0; } \ + if ((p) != (q)) { if (p) lt_dlfree (p); (p) = (q); (q) = 0; } \ } LT_STMT_END @@ -188,11 +207,11 @@ SCMLTSTATIC LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) static char *strdup LT_PARAMS((const char *str)); -char * +static char * strdup(str) const char *str; { - char *tmp = 0; + char *tmp = NULL; if (str) { @@ -214,16 +233,16 @@ strdup(str) static int strcmp LT_PARAMS((const char *str1, const char *str2)); -int +static int strcmp (str1, str2) const char *str1; const char *str2; { if (str1 == str2) return 0; - if (str1 == 0) + if (str1 == NULL) return -1; - if (str2 == 0) + if (str2 == NULL) return 1; for (;*str1 && *str2; ++str1, ++str2) @@ -246,7 +265,7 @@ strcmp (str1, str2) static const char *strchr LT_PARAMS((const char *str, int ch)); -const char* +static const char* strchr(str, ch) const char *str; int ch; @@ -272,12 +291,12 @@ strchr(str, ch) static const char *strrchr LT_PARAMS((const char *str, int ch)); -const char* +static const char* strrchr(str, ch) const char *str; int ch; { - const char *p, *q = 0; + const char *p, *q = NULL; for (p = str; *p != LT_EOS_CHAR; ++p) { @@ -306,7 +325,7 @@ strrchr(str, ch) static lt_ptr memcpy LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); -lt_ptr +static lt_ptr memcpy (dest, src, size) lt_ptr dest; const lt_ptr src; @@ -330,7 +349,7 @@ memcpy (dest, src, size) static lt_ptr memmove LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); -lt_ptr +static lt_ptr memmove (dest, src, size) lt_ptr dest; const lt_ptr src; @@ -371,22 +390,22 @@ memmove (dest, src, size) of the source unless you know enough about, or wrote malloc. So this code is disabled... */ -lt_ptr +static lt_ptr realloc (ptr, size) lt_ptr ptr; size_t size; { - if (size <= 0) + if (size == 0) { /* For zero or less bytes, free the original memory */ - if (ptr != 0) + if (ptr != NULL) { lt_dlfree (ptr); } return (lt_ptr) 0; } - else if (ptr == 0) + else if (ptr == NULL) { /* Allow reallocation of a NULL pointer. */ return lt_dlmalloc (size); @@ -417,7 +436,7 @@ realloc (ptr, size) static error_t argz_append LT_PARAMS((char **pargz, size_t *pargz_len, const char *buf, size_t buf_len)); -error_t +static error_t argz_append (pargz, pargz_len, buf, buf_len) char **pargz; size_t *pargz_len; @@ -459,7 +478,7 @@ argz_append (pargz, pargz_len, buf, buf_len) static error_t argz_create_sep LT_PARAMS((const char *str, int delim, char **pargz, size_t *pargz_len)); -error_t +static error_t argz_create_sep (str, delim, pargz, pargz_len) const char *str; int delim; @@ -467,7 +486,7 @@ argz_create_sep (str, delim, pargz, pargz_len) size_t *pargz_len; { size_t argz_len; - char *argz = 0; + char *argz = NULL; assert (str); assert (pargz); @@ -522,7 +541,7 @@ argz_create_sep (str, delim, pargz, pargz_len) static error_t argz_insert LT_PARAMS((char **pargz, size_t *pargz_len, char *before, const char *entry)); -error_t +static error_t argz_insert (pargz, pargz_len, before, entry) char **pargz; size_t *pargz_len; @@ -533,11 +552,6 @@ argz_insert (pargz, pargz_len, before, entry) assert (pargz_len); assert (entry && *entry); - /* Either PARGZ/PARGZ_LEN is empty and BEFORE is NULL, - or BEFORE points into an address within the ARGZ vector. */ - assert ((!*pargz && !*pargz_len && !before) - || ((*pargz <= before) && (before < (*pargz + *pargz_len)))); - /* No BEFORE address indicates ENTRY should be inserted after the current last element. */ if (!before) @@ -584,7 +598,7 @@ argz_insert (pargz, pargz_len, before, entry) static char *argz_next LT_PARAMS((char *argz, size_t argz_len, const char *entry)); -char * +static char * argz_next (argz, argz_len, entry) char *argz; size_t argz_len; @@ -629,7 +643,7 @@ argz_next (argz, argz_len, entry) static void argz_stringify LT_PARAMS((char *argz, size_t argz_len, int sep)); -void +static void argz_stringify (argz, argz_len, sep) char *argz; size_t argz_len; @@ -753,11 +767,11 @@ static const char sys_search_path[] = LTDL_SYSSEARCHPATH; /* The mutex functions stored here are global, and are necessarily the same for all threads that wish to share access to libltdl. */ -static lt_dlmutex_lock *lt_dlmutex_lock_func = 0; -static lt_dlmutex_unlock *lt_dlmutex_unlock_func = 0; -static lt_dlmutex_seterror *lt_dlmutex_seterror_func = 0; -static lt_dlmutex_geterror *lt_dlmutex_geterror_func = 0; -static const char *lt_dllast_error = 0; +static lt_dlmutex_lock *lt_dlmutex_lock_func = NULL; +static lt_dlmutex_unlock *lt_dlmutex_unlock_func = NULL; +static lt_dlmutex_seterror *lt_dlmutex_seterror_func = NULL; +static lt_dlmutex_geterror *lt_dlmutex_geterror_func = NULL; +static const char *lt_dllast_error = NULL; /* Either set or reset the mutex functions. Either all the arguments must @@ -805,7 +819,7 @@ lt_dlmutex_register (lock, unlock, seterror, geterror) /* --- ERROR HANDLING --- */ -static const char **user_error_strings = 0; +static const char **user_error_strings = NULL; static int errorcount = LT_ERROR_MAX; int @@ -814,7 +828,7 @@ lt_dladderror (diagnostic) { int errindex = 0; int result = -1; - const char **temp = (const char **) 0; + const char **temp = NULL; assert (diagnostic); @@ -864,7 +878,7 @@ lt_dlseterror (errindex) return errors; } -lt_ptr +static lt_ptr lt_emalloc (size) size_t size; { @@ -874,7 +888,7 @@ lt_emalloc (size) return mem; } -lt_ptr +static lt_ptr lt_erealloc (addr, size) lt_ptr addr; size_t size; @@ -885,14 +899,14 @@ lt_erealloc (addr, size) return mem; } -char * +static char * lt_estrdup (str) const char *str; { - char *dup = strdup (str); - if (LT_STRLEN (str) && !dup) + char *copy = strdup (str); + if (LT_STRLEN (str) && !copy) LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - return dup; + return copy; } @@ -1126,7 +1140,7 @@ sys_shl_sym (loader_data, module, symbol) lt_module module; const char *symbol; { - lt_ptr address = 0; + lt_ptr address = NULL; /* sys_shl_open should never return a NULL module handle */ if (module == (lt_module) 0) @@ -1170,16 +1184,16 @@ sys_wll_open (loader_data, filename) const char *filename; { lt_dlhandle cur; - lt_module module = 0; - const char *errormsg = 0; - char *searchname = 0; + lt_module module = NULL; + const char *errormsg = NULL; + char *searchname = NULL; char *ext; char self_name_buf[MAX_PATH]; if (!filename) { /* Get the name of main module */ - *self_name_buf = 0; + *self_name_buf = '\0'; GetModuleFileName (NULL, self_name_buf, sizeof (self_name_buf)); filename = ext = self_name_buf; } @@ -1229,7 +1243,7 @@ sys_wll_open (loader_data, filename) { if (!cur->module) { - cur = 0; + cur = NULL; break; } @@ -1245,7 +1259,7 @@ sys_wll_open (loader_data, filename) if (cur || !module) { LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - module = 0; + module = NULL; } return module; @@ -1351,13 +1365,13 @@ sys_bedl_sym (loader_data, module, symbol) lt_module module; const char *symbol; { - lt_ptr address = 0; + lt_ptr address = NULL; image_id image = (image_id) module; if (get_image_symbol (image, symbol, B_SYMBOL_TYPE_ANY, address) != B_OK) { LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - address = 0; + address = NULL; } return address; @@ -1394,7 +1408,7 @@ sys_dld_open (loader_data, filename) { LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); LT_DLFREE (module); - module = 0; + module = NULL; } return module; @@ -1456,8 +1470,8 @@ typedef struct lt_dlsymlists_t const lt_dlsymlist *syms; } lt_dlsymlists_t; -static const lt_dlsymlist *default_preloaded_symbols = 0; -static lt_dlsymlists_t *preloaded_symbols = 0; +static const lt_dlsymlist *default_preloaded_symbols = NULL; +static lt_dlsymlists_t *preloaded_symbols = NULL; static int presym_init (loader_data) @@ -1467,7 +1481,7 @@ presym_init (loader_data) LT_DLMUTEX_LOCK (); - preloaded_symbols = 0; + preloaded_symbols = NULL; if (default_preloaded_symbols) { errors = lt_dlpreload (default_preloaded_symbols); @@ -1493,7 +1507,7 @@ presym_free_symlists () lists = lists->next; LT_DLFREE (tmp); } - preloaded_symbols = 0; + preloaded_symbols = NULL; LT_DLMUTEX_UNLOCK (); @@ -1602,7 +1616,7 @@ presym_close (loader_data, module) lt_module module; { /* Just to silence gcc -Wall */ - module = 0; + module = NULL; return 0; } @@ -1693,13 +1707,21 @@ static int lt_argz_insert LT_PARAMS((char **pargz, static int lt_argz_insertinorder LT_PARAMS((char **pargz, size_t *pargz_len, const char *entry)); +static int lt_argz_insertdir LT_PARAMS((char **pargz, + size_t *pargz_len, + const char *dirnam, + struct dirent *dp)); static int lt_dlpath_insertdir LT_PARAMS((char **ppath, char *before, const char *dir)); +static int list_files_by_dir LT_PARAMS((const char *dirnam, + char **pargz, + size_t *pargz_len)); +static int file_not_found LT_PARAMS((void)); -static char *user_search_path= 0; -static lt_dlloader *loaders = 0; -static lt_dlhandle handles = 0; +static char *user_search_path= NULL; +static lt_dlloader *loaders = NULL; +static lt_dlhandle handles = NULL; static int initialized = 0; /* Initialize libltdl. */ @@ -1713,8 +1735,8 @@ lt_dlinit () /* Initialize only at first call. */ if (++initialized == 1) { - handles = 0; - user_search_path = 0; /* empty search path */ + handles = NULL; + user_search_path = NULL; /* empty search path */ #if HAVE_LIBDL && !defined(__CYGWIN__) errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dl, "dlopen"); @@ -1849,7 +1871,7 @@ lt_dlexit () LT_DLMEM_REASSIGN (loader, next); } - loaders = 0; + loaders = NULL; } done: @@ -1910,7 +1932,7 @@ tryall_dlopen (handle, filename) } else { - cur->info.filename = 0; + cur->info.filename = NULL; } while (loader) @@ -1919,7 +1941,7 @@ tryall_dlopen (handle, filename) cur->module = loader->module_open (data, filename); - if (cur->module != 0) + if (cur->module != NULL) { break; } @@ -1950,7 +1972,7 @@ tryall_dlopen_module (handle, prefix, dirname, dlname) const char *dlname; { int error = 0; - char *filename = 0; + char *filename = NULL; size_t filename_len = 0; size_t dirname_len = LT_STRLEN (dirname); @@ -1960,7 +1982,7 @@ tryall_dlopen_module (handle, prefix, dirname, dlname) #ifdef LT_DIRSEP_CHAR /* Only canonicalized names (i.e. with DIRSEP chars already converted) should make it into this function: */ - assert (strchr (dirname, LT_DIRSEP_CHAR) == 0); + assert (strchr (dirname, LT_DIRSEP_CHAR) == NULL); #endif if (dirname_len > 0) @@ -2045,7 +2067,7 @@ canonicalize_path (path, pcanonical) const char *path; char **pcanonical; { - char *canonical = 0; + char *canonical = NULL; assert (path && *path); assert (pcanonical); @@ -2147,11 +2169,11 @@ foreach_dirinpath (search_path, base_name, func, data1, data2) { int result = 0; int filenamesize = 0; - int lenbase = LT_STRLEN (base_name); + size_t lenbase = LT_STRLEN (base_name); size_t argz_len = 0; - char * argz = 0; - char * filename = 0; - char * canonical = 0; + char *argz = NULL; + char *filename = NULL; + char *canonical = NULL; LT_DLMUTEX_LOCK (); @@ -2168,10 +2190,10 @@ foreach_dirinpath (search_path, base_name, func, data1, data2) goto cleanup; { - char *dir_name = 0; + char *dir_name = NULL; while ((dir_name = argz_next (argz, argz_len, dir_name))) { - int lendir = LT_STRLEN (dir_name); + size_t lendir = LT_STRLEN (dir_name); if (lendir +1 +lenbase >= filenamesize) { @@ -2182,7 +2204,9 @@ foreach_dirinpath (search_path, base_name, func, data1, data2) goto cleanup; } - strncpy (filename, dir_name, lendir); + assert (filenamesize > lendir); + strcpy (filename, dir_name); + if (base_name && *base_name) { if (filename[lendir -1] != '/') @@ -2233,7 +2257,7 @@ find_file_callback (filename, data1, data2) LT_DLFREE (*pdir); *pdir = lt_estrdup (filename); - is_done = (*pdir == 0) ? -1 : 1; + is_done = (*pdir == NULL) ? -1 : 1; } return is_done; @@ -2245,7 +2269,7 @@ find_file (search_path, base_name, pdir) const char *base_name; char **pdir; { - FILE *file = 0; + FILE *file = NULL; foreach_dirinpath (search_path, base_name, find_file_callback, pdir, &file); @@ -2258,17 +2282,17 @@ find_handle_callback (filename, data, ignored) lt_ptr data; lt_ptr ignored; { - lt_dlhandle *handle = (lt_dlhandle *) data; - int found = !access (filename, F_OK); + lt_dlhandle *handle = (lt_dlhandle *) data; + int notfound = access (filename, R_OK); /* Bail out if file cannot be read... */ - if (!found) + if (notfound) return 0; /* Try to dlopen the file, but do not continue searching in any case. */ if (tryall_dlopen (handle, filename) != 0) - *handle = 0; + *handle = NULL; return 1; } @@ -2297,10 +2321,10 @@ load_deplibs (handle, deplibs) char *deplibs; { #if LTDL_DLOPEN_DEPLIBS - char *p, *save_search_path = 0; + char *p, *save_search_path = NULL; int depcount = 0; int i; - char **names = 0; + char **names = NULL; #endif int errors = 0; @@ -2336,7 +2360,7 @@ load_deplibs (handle, deplibs) if (strncmp(p, "-L", 2) == 0 || strncmp(p, "-R", 2) == 0) { char save = *end; - *end = 0; /* set a temporary string terminator */ + *end = '\0'; /* set a temporary string terminator */ if (lt_dladdsearchdir(p+2)) { goto cleanup; @@ -2393,7 +2417,7 @@ load_deplibs (handle, deplibs) { char *name; char save = *end; - *end = 0; /* set a temporary string terminator */ + *end = '\0'; /* set a temporary string terminator */ if (strncmp(p, "-l", 2) == 0) { size_t name_len = 3+ /* "lib" */ LT_STRLEN (p + 2); @@ -2482,7 +2506,7 @@ trim (dest, str) /* remove the leading and trailing "'" from str and store the result in dest */ const char *end = strrchr (str, '\''); - int len = LT_STRLEN (str); + size_t len = LT_STRLEN (str); char *tmp; LT_DLFREE (*dest); @@ -2499,7 +2523,7 @@ trim (dest, str) } else { - *dest = 0; + *dest = NULL; } return 0; @@ -2520,22 +2544,22 @@ free_vars (dlname, oldname, libdir, deplibs) return 0; } -int +static int try_dlopen (phandle, filename) lt_dlhandle *phandle; const char *filename; { - const char * ext = 0; - const char * saved_error = 0; - char * canonical = 0; - char * base_name = 0; - char * dir = 0; - char * name = 0; + const char * ext = NULL; + const char * saved_error = NULL; + char * canonical = NULL; + char * base_name = NULL; + char * dir = NULL; + char * name = NULL; int errors = 0; lt_dlhandle newhandle; assert (phandle); - assert (*phandle == 0); + assert (*phandle == NULL); LT_DLMUTEX_GETERROR (saved_error); @@ -2543,7 +2567,7 @@ try_dlopen (phandle, filename) if (!filename) { *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == 0) + if (*phandle == NULL) return 1; memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); @@ -2600,14 +2624,13 @@ try_dlopen (phandle, filename) if (ext && strcmp (ext, archive_ext) == 0) { /* this seems to be a libtool module */ - FILE * file = 0; - char * dlname = 0; - char * old_name = 0; - char * libdir = 0; - char * deplibs = 0; - char * line = 0; + FILE * file = NULL; + char * dlname = NULL; + char * old_name = NULL; + char * libdir = NULL; + char * deplibs = NULL; + char * line = NULL; size_t line_len; - int i; /* if we can't find the installed flag, it is probably an installed libtool archive, produced with an old version @@ -2623,23 +2646,26 @@ try_dlopen (phandle, filename) } /* canonicalize the module name */ - for (i = 0; i < ext - base_name; ++i) - { - if (isalnum ((int)(base_name[i]))) - { - name[i] = base_name[i]; - } - else - { - name[i] = '_'; - } - } - name[ext - base_name] = LT_EOS_CHAR; + { + size_t i; + for (i = 0; i < ext - base_name; ++i) + { + if (isalnum ((int)(base_name[i]))) + { + name[i] = base_name[i]; + } + else + { + name[i] = '_'; + } + } + name[ext - base_name] = LT_EOS_CHAR; + } - /* Now try to open the .la file. If there is no directory name - component, try to find it first in user_search_path and then other - prescribed paths. Otherwise (or in any case if the module was not - yet found) try opening just the module name as passed. */ + /* Now try to open the .la file. If there is no directory name + component, try to find it first in user_search_path and then other + prescribed paths. Otherwise (or in any case if the module was not + yet found) try opening just the module name as passed. */ if (!dir) { const char *search_path; @@ -2698,7 +2724,7 @@ try_dlopen (phandle, filename) /* read the .la file */ while (!feof (file)) { - if (!fgets (line, line_len, file)) + if (!fgets (line, (int) line_len, file)) { break; } @@ -2708,7 +2734,7 @@ try_dlopen (phandle, filename) while ((line[LT_STRLEN(line) -1] != '\n') && (!feof (file))) { line = LT_DLREALLOC (char, line, line_len *2); - if (!fgets (&line[line_len -1], line_len +1, file)) + if (!fgets (&line[line_len -1], (int) line_len +1, file)) { break; } @@ -2766,7 +2792,7 @@ try_dlopen (phandle, filename) errors += trim (&dlname, &line[sizeof (STR_LIBRARY_NAMES) - 1]); if (!errors && dlname - && (last_libname = strrchr (dlname, ' ')) != 0) + && (last_libname = strrchr (dlname, ' ')) != NULL) { last_libname = lt_estrdup (last_libname + 1); if (!last_libname) @@ -2787,7 +2813,7 @@ try_dlopen (phandle, filename) /* allocate the handle */ *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == 0) + if (*phandle == NULL) ++errors; if (errors) @@ -2831,7 +2857,7 @@ try_dlopen (phandle, filename) { /* not a libtool module */ *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == 0) + if (*phandle == NULL) { ++errors; goto cleanup; @@ -2856,8 +2882,10 @@ try_dlopen (phandle, filename) #endif ))) { - if (tryall_dlopen (&newhandle, filename) != 0) - newhandle = 0; + if (tryall_dlopen (&newhandle, filename) != 0) + { + newhandle = NULL; + } } if (!newhandle) @@ -2896,7 +2924,7 @@ lt_dlhandle lt_dlopen (filename) const char *filename; { - lt_dlhandle handle = 0; + lt_dlhandle handle = NULL; /* Just incase we missed a code path in try_dlopen() that reports an error, but forgets to reset handle... */ @@ -2911,7 +2939,7 @@ lt_dlopen (filename) static int file_not_found () { - const char *error = 0; + const char *error = NULL; LT_DLMUTEX_GETERROR (error); if (error == LT_DLSTRERROR (FILE_NOT_FOUND)) @@ -2928,10 +2956,10 @@ lt_dlhandle lt_dlopenext (filename) const char *filename; { - lt_dlhandle handle = 0; - char * tmp = 0; - char * ext = 0; - int len; + lt_dlhandle handle = NULL; + char * tmp = NULL; + char * ext = NULL; + size_t len; int errors = 0; if (!filename) @@ -3011,7 +3039,7 @@ lt_dlopenext (filename) } -int +static int lt_argz_insert (pargz, pargz_len, before, entry) char **pargz; size_t *pargz_len; @@ -3037,13 +3065,13 @@ lt_argz_insert (pargz, pargz_len, before, entry) return 0; } -int +static int lt_argz_insertinorder (pargz, pargz_len, entry) char **pargz; size_t *pargz_len; const char *entry; { - char *before = 0; + char *before = NULL; assert (pargz); assert (pargz_len); @@ -3068,9 +3096,9 @@ lt_argz_insertdir (pargz, pargz_len, dirnam, dp) const char *dirnam; struct dirent *dp; { - char *buf = 0; + char *buf = NULL; size_t buf_len = 0; - char *end = 0; + char *end = NULL; size_t end_offset = 0; size_t dir_len = 0; int errors = 0; @@ -3133,7 +3161,7 @@ list_files_by_dir (dirnam, pargz, pargz_len) char **pargz; size_t *pargz_len; { - DIR *dirp = 0; + DIR *dirp = NULL; int errors = 0; assert (dirnam && *dirnam); @@ -3144,7 +3172,7 @@ list_files_by_dir (dirnam, pargz, pargz_len) dirp = opendir (dirnam); if (dirp) { - struct dirent *dp = 0; + struct dirent *dp = NULL; while ((dp = readdir (dirp))) if (dp->d_name[0] != '.') @@ -3175,7 +3203,7 @@ foreachfile_callback (dirname, data1, data2) = (int (*) LT_PARAMS((const char *filename, lt_ptr data))) data1; int is_done = 0; - char *argz = 0; + char *argz = NULL; size_t argz_len = 0; if (list_files_by_dir (dirname, &argz, &argz_len) != 0) @@ -3184,7 +3212,7 @@ foreachfile_callback (dirname, data1, data2) goto cleanup; { - char *filename = 0; + char *filename = NULL; while ((filename = argz_next (argz, argz_len, filename))) if ((is_done = (*func) (filename, data2))) break; @@ -3294,6 +3322,9 @@ lt_dlclose (handle) errors += handle->loader->module_close (data, handle->module); errors += unload_deplibs(handle); + /* It is up to the callers to free the data itself. */ + LT_DLFREE (handle->caller_data); + LT_DLFREE (handle->info.filename); LT_DLFREE (handle->info.name); LT_DLFREE (handle); @@ -3318,7 +3349,7 @@ lt_dlsym (handle, symbol) lt_dlhandle handle; const char *symbol; { - int lensym; + size_t lensym; char lsym[LT_SYMBOL_LENGTH]; char *sym; lt_ptr address; @@ -3418,15 +3449,15 @@ lt_dlerror () return error ? error : LT_DLSTRERROR (UNKNOWN); } -int +static int lt_dlpath_insertdir (ppath, before, dir) char **ppath; char *before; const char *dir; { int errors = 0; - char *canonical = 0; - char *argz = 0; + char *canonical = NULL; + char *argz = NULL; size_t argz_len = 0; assert (ppath); @@ -3441,13 +3472,13 @@ lt_dlpath_insertdir (ppath, before, dir) assert (canonical && *canonical); /* If *PPATH is empty, set it to DIR. */ - if (*ppath == 0) + if (*ppath == NULL) { assert (!before); /* BEFORE cannot be set without PPATH. */ assert (dir); /* Without DIR, don't call this function! */ *ppath = lt_estrdup (dir); - if (*ppath == 0) + if (*ppath == NULL) ++errors; return errors; @@ -3681,7 +3712,7 @@ lt_dlcaller_set_data (key, handle, data) lt_ptr data; { int n_elements = 0; - lt_ptr stale = (lt_ptr) 0; + lt_ptr stale = NULL; int i; /* This needs to be locked so that the caller data can be updated @@ -3710,7 +3741,7 @@ lt_dlcaller_set_data (key, handle, data) if (!temp) { - stale = 0; + stale = NULL; goto done; } @@ -3770,12 +3801,12 @@ lt_dlloader_add (place, dlloader, loader_name) const char *loader_name; { int errors = 0; - lt_dlloader *node = 0, *ptr = 0; + lt_dlloader *node = NULL, *ptr = NULL; - if ((dlloader == 0) /* diagnose null parameters */ - || (dlloader->module_open == 0) - || (dlloader->module_close == 0) - || (dlloader->find_sym == 0)) + if ((dlloader == NULL) /* diagnose null parameters */ + || (dlloader->module_open == NULL) + || (dlloader->module_close == NULL) + || (dlloader->find_sym == NULL)) { LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); return 1; @@ -3786,7 +3817,7 @@ lt_dlloader_add (place, dlloader, loader_name) if (!node) return 1; - node->next = 0; + node->next = NULL; node->loader_name = loader_name; node->sym_prefix = dlloader->sym_prefix; node->dlloader_exit = dlloader->dlloader_exit; @@ -3922,7 +3953,7 @@ const char * lt_dlloader_name (place) lt_dlloader *place; { - const char *name = 0; + const char *name = NULL; if (place) { @@ -3942,7 +3973,7 @@ lt_user_data * lt_dlloader_data (place) lt_dlloader *place; { - lt_user_data *data = 0; + lt_user_data *data = NULL; if (place) { @@ -3962,7 +3993,7 @@ lt_dlloader * lt_dlloader_find (loader_name) const char *loader_name; { - lt_dlloader *place = 0; + lt_dlloader *place = NULL; LT_DLMUTEX_LOCK (); for (place = loaders; place; place = place->next) diff --git a/libguile-ltdl/upstream/ltdl.c b/libguile-ltdl/upstream/ltdl.c index 19293f4d0..820bd3071 100644 --- a/libguile-ltdl/upstream/ltdl.c +++ b/libguile-ltdl/upstream/ltdl.c @@ -94,6 +94,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA #include "ltdl.h" +#if WITH_DMALLOC +# include +#endif + @@ -166,6 +170,18 @@ LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) /* The following macros reduce the amount of typing needed to cast assigned memory. */ +#if WITH_DMALLOC + +#define LT_DLMALLOC(tp, n) ((tp *) xmalloc ((n) * sizeof(tp))) +#define LT_DLREALLOC(tp, p, n) ((tp *) xrealloc ((p), (n) * sizeof(tp))) +#define LT_DLFREE(p) \ + LT_STMT_START { if (p) (p) = (xfree (p), (lt_ptr) 0); } LT_STMT_END + +#define LT_EMALLOC(tp, n) ((tp *) xmalloc ((n) * sizeof(tp))) +#define LT_EREALLOC(tp, p, n) ((tp *) xrealloc ((p), (n) * sizeof(tp))) + +#else + #define LT_DLMALLOC(tp, n) ((tp *) lt_dlmalloc ((n) * sizeof(tp))) #define LT_DLREALLOC(tp, p, n) ((tp *) rpl_realloc ((p), (n) * sizeof(tp))) #define LT_DLFREE(p) \ @@ -174,8 +190,10 @@ LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) #define LT_EMALLOC(tp, n) ((tp *) lt_emalloc ((n) * sizeof(tp))) #define LT_EREALLOC(tp, p, n) ((tp *) lt_erealloc ((p), (n) * sizeof(tp))) +#endif + #define LT_DLMEM_REASSIGN(p, q) LT_STMT_START { \ - if ((p) != (q)) { lt_dlfree (p); (p) = (q); (q) = 0; } \ + if ((p) != (q)) { if (p) lt_dlfree (p); (p) = (q); (q) = 0; } \ } LT_STMT_END @@ -187,11 +205,11 @@ LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) static char *strdup LT_PARAMS((const char *str)); -char * +static char * strdup(str) const char *str; { - char *tmp = 0; + char *tmp = NULL; if (str) { @@ -213,16 +231,16 @@ strdup(str) static int strcmp LT_PARAMS((const char *str1, const char *str2)); -int +static int strcmp (str1, str2) const char *str1; const char *str2; { if (str1 == str2) return 0; - if (str1 == 0) + if (str1 == NULL) return -1; - if (str2 == 0) + if (str2 == NULL) return 1; for (;*str1 && *str2; ++str1, ++str2) @@ -245,7 +263,7 @@ strcmp (str1, str2) static const char *strchr LT_PARAMS((const char *str, int ch)); -const char* +static const char* strchr(str, ch) const char *str; int ch; @@ -271,12 +289,12 @@ strchr(str, ch) static const char *strrchr LT_PARAMS((const char *str, int ch)); -const char* +static const char* strrchr(str, ch) const char *str; int ch; { - const char *p, *q = 0; + const char *p, *q = NULL; for (p = str; *p != LT_EOS_CHAR; ++p) { @@ -305,7 +323,7 @@ strrchr(str, ch) static lt_ptr memcpy LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); -lt_ptr +static lt_ptr memcpy (dest, src, size) lt_ptr dest; const lt_ptr src; @@ -329,7 +347,7 @@ memcpy (dest, src, size) static lt_ptr memmove LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); -lt_ptr +static lt_ptr memmove (dest, src, size) lt_ptr dest; const lt_ptr src; @@ -364,22 +382,22 @@ memmove (dest, src, size) #undef realloc #define realloc rpl_realloc -lt_ptr +static lt_ptr realloc (ptr, size) lt_ptr ptr; size_t size; { - if (size <= 0) + if (size == 0) { /* For zero or less bytes, free the original memory */ - if (ptr != 0) + if (ptr != NULL) { lt_dlfree (ptr); } return (lt_ptr) 0; } - else if (ptr == 0) + else if (ptr == NULL) { /* Allow reallocation of a NULL pointer. */ return lt_dlmalloc (size); @@ -408,7 +426,7 @@ realloc (ptr, size) static error_t argz_append LT_PARAMS((char **pargz, size_t *pargz_len, const char *buf, size_t buf_len)); -error_t +static error_t argz_append (pargz, pargz_len, buf, buf_len) char **pargz; size_t *pargz_len; @@ -450,7 +468,7 @@ argz_append (pargz, pargz_len, buf, buf_len) static error_t argz_create_sep LT_PARAMS((const char *str, int delim, char **pargz, size_t *pargz_len)); -error_t +static error_t argz_create_sep (str, delim, pargz, pargz_len) const char *str; int delim; @@ -458,7 +476,7 @@ argz_create_sep (str, delim, pargz, pargz_len) size_t *pargz_len; { size_t argz_len; - char *argz = 0; + char *argz = NULL; assert (str); assert (pargz); @@ -513,7 +531,7 @@ argz_create_sep (str, delim, pargz, pargz_len) static error_t argz_insert LT_PARAMS((char **pargz, size_t *pargz_len, char *before, const char *entry)); -error_t +static error_t argz_insert (pargz, pargz_len, before, entry) char **pargz; size_t *pargz_len; @@ -524,11 +542,6 @@ argz_insert (pargz, pargz_len, before, entry) assert (pargz_len); assert (entry && *entry); - /* Either PARGZ/PARGZ_LEN is empty and BEFORE is NULL, - or BEFORE points into an address within the ARGZ vector. */ - assert ((!*pargz && !*pargz_len && !before) - || ((*pargz <= before) && (before < (*pargz + *pargz_len)))); - /* No BEFORE address indicates ENTRY should be inserted after the current last element. */ if (!before) @@ -575,7 +588,7 @@ argz_insert (pargz, pargz_len, before, entry) static char *argz_next LT_PARAMS((char *argz, size_t argz_len, const char *entry)); -char * +static char * argz_next (argz, argz_len, entry) char *argz; size_t argz_len; @@ -620,7 +633,7 @@ argz_next (argz, argz_len, entry) static void argz_stringify LT_PARAMS((char *argz, size_t argz_len, int sep)); -void +static void argz_stringify (argz, argz_len, sep) char *argz; size_t argz_len; @@ -744,11 +757,11 @@ static const char sys_search_path[] = LTDL_SYSSEARCHPATH; /* The mutex functions stored here are global, and are necessarily the same for all threads that wish to share access to libltdl. */ -static lt_dlmutex_lock *lt_dlmutex_lock_func = 0; -static lt_dlmutex_unlock *lt_dlmutex_unlock_func = 0; -static lt_dlmutex_seterror *lt_dlmutex_seterror_func = 0; -static lt_dlmutex_geterror *lt_dlmutex_geterror_func = 0; -static const char *lt_dllast_error = 0; +static lt_dlmutex_lock *lt_dlmutex_lock_func = NULL; +static lt_dlmutex_unlock *lt_dlmutex_unlock_func = NULL; +static lt_dlmutex_seterror *lt_dlmutex_seterror_func = NULL; +static lt_dlmutex_geterror *lt_dlmutex_geterror_func = NULL; +static const char *lt_dllast_error = NULL; /* Either set or reset the mutex functions. Either all the arguments must @@ -797,7 +810,7 @@ lt_dlmutex_register (lock, unlock, seterror, geterror) /* --- ERROR HANDLING --- */ -static const char **user_error_strings = 0; +static const char **user_error_strings = NULL; static int errorcount = LT_ERROR_MAX; int @@ -806,7 +819,7 @@ lt_dladderror (diagnostic) { int errindex = 0; int result = -1; - const char **temp = (const char **) 0; + const char **temp = NULL; assert (diagnostic); @@ -856,7 +869,7 @@ lt_dlseterror (errindex) return errors; } -lt_ptr +static lt_ptr lt_emalloc (size) size_t size; { @@ -866,7 +879,7 @@ lt_emalloc (size) return mem; } -lt_ptr +static lt_ptr lt_erealloc (addr, size) lt_ptr addr; size_t size; @@ -877,14 +890,14 @@ lt_erealloc (addr, size) return mem; } -char * +static char * lt_estrdup (str) const char *str; { - char *dup = strdup (str); - if (LT_STRLEN (str) && !dup) + char *copy = strdup (str); + if (LT_STRLEN (str) && !copy) LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - return dup; + return copy; } @@ -1118,7 +1131,7 @@ sys_shl_sym (loader_data, module, symbol) lt_module module; const char *symbol; { - lt_ptr address = 0; + lt_ptr address = NULL; /* sys_shl_open should never return a NULL module handle */ if (module == (lt_module) 0) @@ -1162,16 +1175,16 @@ sys_wll_open (loader_data, filename) const char *filename; { lt_dlhandle cur; - lt_module module = 0; - const char *errormsg = 0; - char *searchname = 0; + lt_module module = NULL; + const char *errormsg = NULL; + char *searchname = NULL; char *ext; char self_name_buf[MAX_PATH]; if (!filename) { /* Get the name of main module */ - *self_name_buf = 0; + *self_name_buf = '\0'; GetModuleFileName (NULL, self_name_buf, sizeof (self_name_buf)); filename = ext = self_name_buf; } @@ -1221,7 +1234,7 @@ sys_wll_open (loader_data, filename) { if (!cur->module) { - cur = 0; + cur = NULL; break; } @@ -1237,7 +1250,7 @@ sys_wll_open (loader_data, filename) if (cur || !module) { LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - module = 0; + module = NULL; } return module; @@ -1343,13 +1356,13 @@ sys_bedl_sym (loader_data, module, symbol) lt_module module; const char *symbol; { - lt_ptr address = 0; + lt_ptr address = NULL; image_id image = (image_id) module; if (get_image_symbol (image, symbol, B_SYMBOL_TYPE_ANY, address) != B_OK) { LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - address = 0; + address = NULL; } return address; @@ -1386,7 +1399,7 @@ sys_dld_open (loader_data, filename) { LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); LT_DLFREE (module); - module = 0; + module = NULL; } return module; @@ -1448,8 +1461,8 @@ typedef struct lt_dlsymlists_t const lt_dlsymlist *syms; } lt_dlsymlists_t; -static const lt_dlsymlist *default_preloaded_symbols = 0; -static lt_dlsymlists_t *preloaded_symbols = 0; +static const lt_dlsymlist *default_preloaded_symbols = NULL; +static lt_dlsymlists_t *preloaded_symbols = NULL; static int presym_init (loader_data) @@ -1459,7 +1472,7 @@ presym_init (loader_data) LT_DLMUTEX_LOCK (); - preloaded_symbols = 0; + preloaded_symbols = NULL; if (default_preloaded_symbols) { errors = lt_dlpreload (default_preloaded_symbols); @@ -1485,7 +1498,7 @@ presym_free_symlists () lists = lists->next; LT_DLFREE (tmp); } - preloaded_symbols = 0; + preloaded_symbols = NULL; LT_DLMUTEX_UNLOCK (); @@ -1594,7 +1607,7 @@ presym_close (loader_data, module) lt_module module; { /* Just to silence gcc -Wall */ - module = 0; + module = NULL; return 0; } @@ -1685,13 +1698,21 @@ static int lt_argz_insert LT_PARAMS((char **pargz, static int lt_argz_insertinorder LT_PARAMS((char **pargz, size_t *pargz_len, const char *entry)); +static int lt_argz_insertdir LT_PARAMS((char **pargz, + size_t *pargz_len, + const char *dirnam, + struct dirent *dp)); static int lt_dlpath_insertdir LT_PARAMS((char **ppath, char *before, const char *dir)); +static int list_files_by_dir LT_PARAMS((const char *dirnam, + char **pargz, + size_t *pargz_len)); +static int file_not_found LT_PARAMS((void)); -static char *user_search_path= 0; -static lt_dlloader *loaders = 0; -static lt_dlhandle handles = 0; +static char *user_search_path= NULL; +static lt_dlloader *loaders = NULL; +static lt_dlhandle handles = NULL; static int initialized = 0; /* Initialize libltdl. */ @@ -1705,8 +1726,8 @@ lt_dlinit () /* Initialize only at first call. */ if (++initialized == 1) { - handles = 0; - user_search_path = 0; /* empty search path */ + handles = NULL; + user_search_path = NULL; /* empty search path */ #if HAVE_LIBDL && !defined(__CYGWIN__) errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dl, "dlopen"); @@ -1841,7 +1862,7 @@ lt_dlexit () LT_DLMEM_REASSIGN (loader, next); } - loaders = 0; + loaders = NULL; } done: @@ -1902,7 +1923,7 @@ tryall_dlopen (handle, filename) } else { - cur->info.filename = 0; + cur->info.filename = NULL; } while (loader) @@ -1911,7 +1932,7 @@ tryall_dlopen (handle, filename) cur->module = loader->module_open (data, filename); - if (cur->module != 0) + if (cur->module != NULL) { break; } @@ -1942,7 +1963,7 @@ tryall_dlopen_module (handle, prefix, dirname, dlname) const char *dlname; { int error = 0; - char *filename = 0; + char *filename = NULL; size_t filename_len = 0; size_t dirname_len = LT_STRLEN (dirname); @@ -1952,7 +1973,7 @@ tryall_dlopen_module (handle, prefix, dirname, dlname) #ifdef LT_DIRSEP_CHAR /* Only canonicalized names (i.e. with DIRSEP chars already converted) should make it into this function: */ - assert (strchr (dirname, LT_DIRSEP_CHAR) == 0); + assert (strchr (dirname, LT_DIRSEP_CHAR) == NULL); #endif if (dirname[dirname_len -1] == '/') @@ -2036,7 +2057,7 @@ canonicalize_path (path, pcanonical) const char *path; char **pcanonical; { - char *canonical = 0; + char *canonical = NULL; assert (path && *path); assert (pcanonical); @@ -2138,11 +2159,11 @@ foreach_dirinpath (search_path, base_name, func, data1, data2) { int result = 0; int filenamesize = 0; - int lenbase = LT_STRLEN (base_name); + size_t lenbase = LT_STRLEN (base_name); size_t argz_len = 0; - char * argz = 0; - char * filename = 0; - char * canonical = 0; + char *argz = NULL; + char *filename = NULL; + char *canonical = NULL; LT_DLMUTEX_LOCK (); @@ -2159,10 +2180,10 @@ foreach_dirinpath (search_path, base_name, func, data1, data2) goto cleanup; { - char *dir_name = 0; + char *dir_name = NULL; while ((dir_name = argz_next (argz, argz_len, dir_name))) { - int lendir = LT_STRLEN (dir_name); + size_t lendir = LT_STRLEN (dir_name); if (lendir +1 +lenbase >= filenamesize) { @@ -2173,7 +2194,9 @@ foreach_dirinpath (search_path, base_name, func, data1, data2) goto cleanup; } - strncpy (filename, dir_name, lendir); + assert (filenamesize > lendir); + strcpy (filename, dir_name); + if (base_name && *base_name) { if (filename[lendir -1] != '/') @@ -2224,7 +2247,7 @@ find_file_callback (filename, data1, data2) LT_DLFREE (*pdir); *pdir = lt_estrdup (filename); - is_done = (*pdir == 0) ? -1 : 1; + is_done = (*pdir == NULL) ? -1 : 1; } return is_done; @@ -2236,7 +2259,7 @@ find_file (search_path, base_name, pdir) const char *base_name; char **pdir; { - FILE *file = 0; + FILE *file = NULL; foreach_dirinpath (search_path, base_name, find_file_callback, pdir, &file); @@ -2249,17 +2272,17 @@ find_handle_callback (filename, data, ignored) lt_ptr data; lt_ptr ignored; { - lt_dlhandle *handle = (lt_dlhandle *) data; - int found = access (filename, R_OK); + lt_dlhandle *handle = (lt_dlhandle *) data; + int notfound = access (filename, R_OK); /* Bail out if file cannot be read... */ - if (!found) + if (notfound) return 0; /* Try to dlopen the file, but do not continue searching in any case. */ if (tryall_dlopen (handle, filename) != 0) - *handle = 0; + *handle = NULL; return 1; } @@ -2288,10 +2311,10 @@ load_deplibs (handle, deplibs) char *deplibs; { #if LTDL_DLOPEN_DEPLIBS - char *p, *save_search_path = 0; + char *p, *save_search_path = NULL; int depcount = 0; int i; - char **names = 0; + char **names = NULL; #endif int errors = 0; @@ -2327,7 +2350,7 @@ load_deplibs (handle, deplibs) if (strncmp(p, "-L", 2) == 0 || strncmp(p, "-R", 2) == 0) { char save = *end; - *end = 0; /* set a temporary string terminator */ + *end = '\0'; /* set a temporary string terminator */ if (lt_dladdsearchdir(p+2)) { goto cleanup; @@ -2384,7 +2407,7 @@ load_deplibs (handle, deplibs) { char *name; char save = *end; - *end = 0; /* set a temporary string terminator */ + *end = '\0'; /* set a temporary string terminator */ if (strncmp(p, "-l", 2) == 0) { size_t name_len = 3+ /* "lib" */ LT_STRLEN (p + 2); @@ -2473,7 +2496,7 @@ trim (dest, str) /* remove the leading and trailing "'" from str and store the result in dest */ const char *end = strrchr (str, '\''); - int len = LT_STRLEN (str); + size_t len = LT_STRLEN (str); char *tmp; LT_DLFREE (*dest); @@ -2490,7 +2513,7 @@ trim (dest, str) } else { - *dest = 0; + *dest = NULL; } return 0; @@ -2511,22 +2534,22 @@ free_vars (dlname, oldname, libdir, deplibs) return 0; } -int +static int try_dlopen (phandle, filename) lt_dlhandle *phandle; const char *filename; { - const char * ext = 0; - const char * saved_error = 0; - char * canonical = 0; - char * base_name = 0; - char * dir = 0; - char * name = 0; + const char * ext = NULL; + const char * saved_error = NULL; + char * canonical = NULL; + char * base_name = NULL; + char * dir = NULL; + char * name = NULL; int errors = 0; lt_dlhandle newhandle; assert (phandle); - assert (*phandle == 0); + assert (*phandle == NULL); LT_DLMUTEX_GETERROR (saved_error); @@ -2534,7 +2557,7 @@ try_dlopen (phandle, filename) if (!filename) { *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == 0) + if (*phandle == NULL) return 1; memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); @@ -2591,14 +2614,13 @@ try_dlopen (phandle, filename) if (ext && strcmp (ext, archive_ext) == 0) { /* this seems to be a libtool module */ - FILE * file = 0; - char * dlname = 0; - char * old_name = 0; - char * libdir = 0; - char * deplibs = 0; - char * line = 0; + FILE * file = NULL; + char * dlname = NULL; + char * old_name = NULL; + char * libdir = NULL; + char * deplibs = NULL; + char * line = NULL; size_t line_len; - int i; /* if we can't find the installed flag, it is probably an installed libtool archive, produced with an old version @@ -2614,23 +2636,26 @@ try_dlopen (phandle, filename) } /* canonicalize the module name */ - for (i = 0; i < ext - base_name; ++i) - { - if (isalnum ((int)(base_name[i]))) - { - name[i] = base_name[i]; - } - else - { - name[i] = '_'; - } - } - name[ext - base_name] = LT_EOS_CHAR; + { + size_t i; + for (i = 0; i < ext - base_name; ++i) + { + if (isalnum ((int)(base_name[i]))) + { + name[i] = base_name[i]; + } + else + { + name[i] = '_'; + } + } + name[ext - base_name] = LT_EOS_CHAR; + } - /* Now try to open the .la file. If there is no directory name - component, try to find it first in user_search_path and then other - prescribed paths. Otherwise (or in any case if the module was not - yet found) try opening just the module name as passed. */ + /* Now try to open the .la file. If there is no directory name + component, try to find it first in user_search_path and then other + prescribed paths. Otherwise (or in any case if the module was not + yet found) try opening just the module name as passed. */ if (!dir) { const char *search_path; @@ -2689,7 +2714,7 @@ try_dlopen (phandle, filename) /* read the .la file */ while (!feof (file)) { - if (!fgets (line, line_len, file)) + if (!fgets (line, (int) line_len, file)) { break; } @@ -2699,7 +2724,7 @@ try_dlopen (phandle, filename) while (line[LT_STRLEN(line) -1] != '\n') { line = LT_DLREALLOC (char, line, line_len *2); - if (!fgets (&line[line_len -1], line_len +1, file)) + if (!fgets (&line[line_len -1], (int) line_len +1, file)) { break; } @@ -2757,7 +2782,7 @@ try_dlopen (phandle, filename) errors += trim (&dlname, &line[sizeof (STR_LIBRARY_NAMES) - 1]); if (!errors && dlname - && (last_libname = strrchr (dlname, ' ')) != 0) + && (last_libname = strrchr (dlname, ' ')) != NULL) { last_libname = lt_estrdup (last_libname + 1); if (!last_libname) @@ -2778,7 +2803,7 @@ try_dlopen (phandle, filename) /* allocate the handle */ *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == 0) + if (*phandle == NULL) ++errors; if (errors) @@ -2822,7 +2847,7 @@ try_dlopen (phandle, filename) { /* not a libtool module */ *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == 0) + if (*phandle == NULL) { ++errors; goto cleanup; @@ -2847,7 +2872,10 @@ try_dlopen (phandle, filename) #endif ))) { - tryall_dlopen (&newhandle, filename); + if (tryall_dlopen (&newhandle, filename) != 0) + { + newhandle = NULL; + } } if (!newhandle) @@ -2886,7 +2914,7 @@ lt_dlhandle lt_dlopen (filename) const char *filename; { - lt_dlhandle handle = 0; + lt_dlhandle handle = NULL; /* Just incase we missed a code path in try_dlopen() that reports an error, but forgets to reset handle... */ @@ -2898,10 +2926,10 @@ lt_dlopen (filename) /* If the last error messge store was `FILE_NOT_FOUND', then return non-zero. */ -int +static int file_not_found () { - const char *error = 0; + const char *error = NULL; LT_DLMUTEX_GETERROR (error); if (error == LT_DLSTRERROR (FILE_NOT_FOUND)) @@ -2918,12 +2946,11 @@ lt_dlhandle lt_dlopenext (filename) const char *filename; { - lt_dlhandle handle = 0; - char * tmp = 0; - char * ext = 0; - int len; + lt_dlhandle handle = NULL; + char * tmp = NULL; + char * ext = NULL; + size_t len; int errors = 0; - int file_found = 1; /* until proven otherwise */ if (!filename) { @@ -3002,7 +3029,7 @@ lt_dlopenext (filename) } -int +static int lt_argz_insert (pargz, pargz_len, before, entry) char **pargz; size_t *pargz_len; @@ -3028,13 +3055,13 @@ lt_argz_insert (pargz, pargz_len, before, entry) return 0; } -int +static int lt_argz_insertinorder (pargz, pargz_len, entry) char **pargz; size_t *pargz_len; const char *entry; { - char *before = 0; + char *before = NULL; assert (pargz); assert (pargz_len); @@ -3052,16 +3079,16 @@ lt_argz_insertinorder (pargz, pargz_len, entry) return lt_argz_insert (pargz, pargz_len, before, entry); } -int +static int lt_argz_insertdir (pargz, pargz_len, dirnam, dp) char **pargz; size_t *pargz_len; const char *dirnam; struct dirent *dp; { - char *buf = 0; + char *buf = NULL; size_t buf_len = 0; - char *end = 0; + char *end = NULL; size_t end_offset = 0; size_t dir_len = 0; int errors = 0; @@ -3118,13 +3145,13 @@ lt_argz_insertdir (pargz, pargz_len, dirnam, dp) return errors; } -int +static int list_files_by_dir (dirnam, pargz, pargz_len) const char *dirnam; char **pargz; size_t *pargz_len; { - DIR *dirp = 0; + DIR *dirp = NULL; int errors = 0; assert (dirnam && *dirnam); @@ -3135,7 +3162,7 @@ list_files_by_dir (dirnam, pargz, pargz_len) dirp = opendir (dirnam); if (dirp) { - struct dirent *dp = 0; + struct dirent *dp = NULL; while ((dp = readdir (dirp))) if (dp->d_name[0] != '.') @@ -3166,7 +3193,7 @@ foreachfile_callback (dirname, data1, data2) = (int (*) LT_PARAMS((const char *filename, lt_ptr data))) data1; int is_done = 0; - char *argz = 0; + char *argz = NULL; size_t argz_len = 0; if (list_files_by_dir (dirname, &argz, &argz_len) != 0) @@ -3175,7 +3202,7 @@ foreachfile_callback (dirname, data1, data2) goto cleanup; { - char *filename = 0; + char *filename = NULL; while ((filename = argz_next (argz, argz_len, filename))) if ((is_done = (*func) (filename, data2))) break; @@ -3285,6 +3312,9 @@ lt_dlclose (handle) errors += handle->loader->module_close (data, handle->module); errors += unload_deplibs(handle); + /* It is up to the callers to free the data itself. */ + LT_DLFREE (handle->caller_data); + LT_DLFREE (handle->info.filename); LT_DLFREE (handle->info.name); LT_DLFREE (handle); @@ -3309,7 +3339,7 @@ lt_dlsym (handle, symbol) lt_dlhandle handle; const char *symbol; { - int lensym; + size_t lensym; char lsym[LT_SYMBOL_LENGTH]; char *sym; lt_ptr address; @@ -3409,15 +3439,15 @@ lt_dlerror () return error ? error : LT_DLSTRERROR (UNKNOWN); } -int +static int lt_dlpath_insertdir (ppath, before, dir) char **ppath; char *before; const char *dir; { int errors = 0; - char *canonical = 0; - char *argz = 0; + char *canonical = NULL; + char *argz = NULL; size_t argz_len = 0; assert (ppath); @@ -3432,13 +3462,13 @@ lt_dlpath_insertdir (ppath, before, dir) assert (canonical && *canonical); /* If *PPATH is empty, set it to DIR. */ - if (*ppath == 0) + if (*ppath == NULL) { assert (!before); /* BEFORE cannot be set without PPATH. */ assert (dir); /* Without DIR, don't call this function! */ *ppath = lt_estrdup (dir); - if (*ppath == 0) + if (*ppath == NULL) ++errors; return errors; @@ -3672,7 +3702,7 @@ lt_dlcaller_set_data (key, handle, data) lt_ptr data; { int n_elements = 0; - lt_ptr stale = (lt_ptr) 0; + lt_ptr stale = NULL; int i; /* This needs to be locked so that the caller data can be updated @@ -3701,7 +3731,7 @@ lt_dlcaller_set_data (key, handle, data) if (!temp) { - stale = 0; + stale = NULL; goto done; } @@ -3761,12 +3791,12 @@ lt_dlloader_add (place, dlloader, loader_name) const char *loader_name; { int errors = 0; - lt_dlloader *node = 0, *ptr = 0; + lt_dlloader *node = NULL, *ptr = NULL; - if ((dlloader == 0) /* diagnose null parameters */ - || (dlloader->module_open == 0) - || (dlloader->module_close == 0) - || (dlloader->find_sym == 0)) + if ((dlloader == NULL) /* diagnose null parameters */ + || (dlloader->module_open == NULL) + || (dlloader->module_close == NULL) + || (dlloader->find_sym == NULL)) { LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); return 1; @@ -3777,7 +3807,7 @@ lt_dlloader_add (place, dlloader, loader_name) if (!node) return 1; - node->next = 0; + node->next = NULL; node->loader_name = loader_name; node->sym_prefix = dlloader->sym_prefix; node->dlloader_exit = dlloader->dlloader_exit; @@ -3913,7 +3943,7 @@ const char * lt_dlloader_name (place) lt_dlloader *place; { - const char *name = 0; + const char *name = NULL; if (place) { @@ -3933,7 +3963,7 @@ lt_user_data * lt_dlloader_data (place) lt_dlloader *place; { - lt_user_data *data = 0; + lt_user_data *data = NULL; if (place) { @@ -3953,7 +3983,7 @@ lt_dlloader * lt_dlloader_find (loader_name) const char *loader_name; { - lt_dlloader *place = 0; + lt_dlloader *place = NULL; LT_DLMUTEX_LOCK (); for (place = loaders; place; place = place->next) From bf1fa0a5ddf627cb4ee11d4857ac54f87a7b54a8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 25 Oct 2002 15:03:01 +0000 Subject: [PATCH 306/306] *** empty log message *** --- libguile-ltdl/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libguile-ltdl/ChangeLog b/libguile-ltdl/ChangeLog index 8f5081536..2f24c2df0 100644 --- a/libguile-ltdl/ChangeLog +++ b/libguile-ltdl/ChangeLog @@ -1,3 +1,8 @@ +2002-10-25 Marius Vollmer + + * upstream/ltdl.c: New copy from libtool 1.4.3. + * raw-ltdl.c: Merged in changes from libtool 1.4.3. + 2002-10-11 Marius Vollmer * upstream/Makefile.am (ltdl.h.diff, ltdl.c.diff): Look for