From aa529137005c8445ee6a0cd35634de686dd91b72 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 6 Jan 2004 22:20:19 +0000 Subject: [PATCH 001/167] * Makefile.am (SCM_TESTS): Add unif.test. --- test-suite/Makefile.am | 1 + 1 file changed, 1 insertion(+) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 2e9ce72a2..3481f77a5 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -68,6 +68,7 @@ SCM_TESTS = tests/alist.test \ tests/syntax.test \ tests/threads.test \ tests/time.test \ + tests/unif.test \ tests/version.test \ tests/weaks.test From 2359c543be71999796c4aaeff080231080426579 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 6 Jan 2004 22:21:01 +0000 Subject: [PATCH 002/167] *** empty log message *** --- test-suite/ChangeLog | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 6eaa04c30..8ad4970a2 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,17 @@ +2004-01-07 Kevin Ryde + + * tests/numbers.test (<): Add tests inum/bignum/flonum/frac with frac. + + * tests/q.test: New file. + (q-pop!): Exercise this, in particular the "not/null?" bug reported by + Richard Todd. + * Makefile.am (SCM_TESTS): Add q.test. + + * tests/unif.test: New file. + (uniform-array-set1!): Exercise this, in particular previous segv on + improper arg list. + * Makefile.am (SCM_TESTS): Add unif.test. + 2004-01-06 Marius Vollmer * standalone/test-unwind.c (close_port, delete_file, check_ports): From be24d06003764a837ed7cd39038e084f6a97d1dd Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 6 Jan 2004 23:40:08 +0000 Subject: [PATCH 003/167] (SCM_MUTEX_MAXSIZE): Increase to 12*sizeof(long), for the benefit of powerpc-apple-darwin5.5. Reported by Richard Todd. --- libguile/threads-plugin.h | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/libguile/threads-plugin.h b/libguile/threads-plugin.h index 569b267cc..9a88fe7e0 100644 --- a/libguile/threads-plugin.h +++ b/libguile/threads-plugin.h @@ -3,7 +3,7 @@ #ifndef SCM_THREADS_PLUGIN_H #define SCM_THREADS_PLUGIN_H -/* Copyright (C) 1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004 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 @@ -23,8 +23,11 @@ #include /* This file should *not* need to include pthread.h */ -/* Size is checked in scm_init_threads_plugin */ -#define SCM_MUTEX_MAXSIZE (9 * sizeof (long)) +/* Size is checked in scm_init_threads_plugin. + For reference, sizes encountered include, + powerpc-apple-darwin5.5 pthread_mutex_t 44 bytes + */ +#define SCM_MUTEX_MAXSIZE (12 * sizeof (long)) typedef struct { char _[SCM_MUTEX_MAXSIZE]; } scm_t_mutex; /*fixme* Should be defined similarly to scm_t_mutex. */ From ba40113e70354f72b46001440963662e7985cf14 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 6 Jan 2004 23:45:42 +0000 Subject: [PATCH 004/167] *** empty log message *** --- libguile/ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7a309f949..558f16ab5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -3,6 +3,9 @@ * numbers.c (s_bignum): Remove, not used since gmp bignums. Reported by Richard Todd. + * threads-plugin.h (SCM_MUTEX_MAXSIZE): Increase to 12*sizeof(long), + for the benefit of powerpc-apple-darwin5.5. Reported by Richard Todd. + * unif.c (scm_aind): Test SCM_CONSP rather than !SCM_NULLP while traversing the args list, fixes segv if an improper list is given. Reported by Rouben Rostamian. From dfe610a0856686bde529ec4d3b635ddf6d93f2cd Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 18:03:18 +0000 Subject: [PATCH 005/167] Did the follwing renamings: scm_with_blocked_asyncs -> scm_frame_block_asyncs, scm_with_unblocked_asyncs -> scm_frame_unblock_asyncs. Changed all uses. --- libguile/async.c | 12 ++++++------ libguile/async.h | 4 ++-- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/libguile/async.c b/libguile/async.c index 276292ac1..b4b8eb4e6 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -365,20 +365,20 @@ scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data) } void -scm_with_blocked_asyncs () +scm_frame_block_asyncs () { - scm_on_rewind (increase_block, NULL, SCM_F_WIND_EXPLICITLY); - scm_on_unwind (decrease_block, NULL, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind (increase_block, NULL, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind (decrease_block, NULL, SCM_F_WIND_EXPLICITLY); } void -scm_with_unblocked_asyncs () +scm_frame_unblock_asyncs () { if (scm_root->block_asyncs == 0) scm_misc_error ("scm_with_unblocked_asyncs", "asyncs already unblocked", SCM_EOL); - scm_on_rewind (decrease_block, NULL, SCM_F_WIND_EXPLICITLY); - scm_on_unwind (increase_block, NULL, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind (decrease_block, NULL, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind (increase_block, NULL, SCM_F_WIND_EXPLICITLY); } diff --git a/libguile/async.h b/libguile/async.h index 3174c7a48..8bb1ef3e6 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -44,8 +44,8 @@ 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); -void scm_with_blocked_asyncs (void); -void scm_with_unblocked_asyncs (void); +void scm_frame_block_asyncs (void); +void scm_frame_unblock_asyncs (void); SCM_API void scm_init_async (void); #if (SCM_ENABLE_DEPRECATED == 1) From 0888de4fd1b6ab308f7fab521534d9bce19b3e13 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 18:03:33 +0000 Subject: [PATCH 006/167] * dynwind.c (scm_frame_end): Do not use scm_i_dowinds. Instead, do the unwinding directly. It is simple enough. * dynwind.h, dynwind.c: Did the following renamings: scm_begin_frame -> scm_frame_begin, scm_end_frame -> scm_frame_end, scm_on_unwind -> scm_frame_unwind, scm_on_rewind -> scm_frame_rewind, scm_on_unwind_with_scm -> scm_frame_unwind_with_scm, scm_on_rewind_with_scm -> scm_frame_rewind_with_scm. Changed all uses. --- libguile/dynwind.c | 52 +++++++++++++++++++++++----------------------- libguile/dynwind.h | 20 +++++++++--------- 2 files changed, 36 insertions(+), 36 deletions(-) diff --git a/libguile/dynwind.c b/libguile/dynwind.c index 1a02dd1c0..c864ac86e 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -121,11 +121,11 @@ scm_internal_dynamic_wind (scm_t_guard before, { SCM ans; - scm_begin_frame (SCM_F_FRAME_REWINDABLE); - scm_on_rewind (before, guard_data, SCM_F_WIND_EXPLICITLY); - scm_on_unwind (after, guard_data, SCM_F_WIND_EXPLICITLY); + scm_frame_begin (SCM_F_FRAME_REWINDABLE); + scm_frame_rewind (before, guard_data, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind (after, guard_data, SCM_F_WIND_EXPLICITLY); ans = inner (inner_data); - scm_end_frame (); + scm_frame_end (); return ans; } @@ -150,7 +150,7 @@ static scm_t_bits tc16_winder; #define WINDER_MARK_P(w) (SCM_CELL_WORD_0(w) & WINDER_F_MARK) void -scm_begin_frame (scm_t_frame_flags flags) +scm_frame_begin (scm_t_frame_flags flags) { SCM f; scm_t_bits fl = ((flags&SCM_F_FRAME_REWINDABLE)? FRAME_F_REWINDABLE : 0); @@ -159,23 +159,23 @@ scm_begin_frame (scm_t_frame_flags flags) } void -scm_end_frame (void) +scm_frame_end (void) { - long delta; - SCM to; - - /* Unwind upto and including the next frame entry. + /* Unwind upto and including the next frame entry. We can only + encounter # entries on the way. */ - for (to = scm_dynwinds, delta = 1; - SCM_CONSP (to); - to = SCM_CDR (to), delta++) + while (SCM_CONSP (scm_dynwinds)) { - if (FRAME_P (SCM_CAR (to))) - { - scm_i_dowinds (SCM_CDR (to), delta, 1, NULL, NULL); - return; - } + SCM entry = SCM_CAR (scm_dynwinds); + scm_dynwinds = SCM_CDR (scm_dynwinds); + + if (FRAME_P (entry)) + return; + + assert (WINDER_P (entry)); + if (!WINDER_REWIND_P (entry) && WINDER_EXPLICIT_P (entry)) + WINDER_PROC(entry) (WINDER_DATA (entry)); } assert (0); @@ -190,8 +190,8 @@ winder_mark (SCM w) } void -scm_on_unwind (void (*proc) (void *), void *data, - scm_t_wind_flags flags) +scm_frame_unwind (void (*proc) (void *), void *data, + scm_t_wind_flags flags) { SCM w; scm_t_bits fl = ((flags&SCM_F_WIND_EXPLICITLY)? WINDER_F_EXPLICIT : 0); @@ -201,8 +201,8 @@ scm_on_unwind (void (*proc) (void *), void *data, } void -scm_on_rewind (void (*proc) (void *), void *data, - scm_t_wind_flags flags) +scm_frame_rewind (void (*proc) (void *), void *data, + scm_t_wind_flags flags) { SCM w; SCM_NEWSMOB2 (w, tc16_winder | WINDER_F_REWIND, @@ -213,8 +213,8 @@ scm_on_rewind (void (*proc) (void *), void *data, } void -scm_on_unwind_with_scm (void (*proc) (SCM), SCM data, - scm_t_wind_flags flags) +scm_frame_unwind_with_scm (void (*proc) (SCM), SCM data, + scm_t_wind_flags flags) { SCM w; scm_t_bits fl = ((flags&SCM_F_WIND_EXPLICITLY)? WINDER_F_EXPLICIT : 0); @@ -224,8 +224,8 @@ scm_on_unwind_with_scm (void (*proc) (SCM), SCM data, } void -scm_on_rewind_with_scm (void (*proc) (SCM), SCM data, - scm_t_wind_flags flags) +scm_frame_rewind_with_scm (void (*proc) (SCM), SCM data, + scm_t_wind_flags flags) { SCM w; SCM_NEWSMOB2 (w, tc16_winder | WINDER_F_REWIND | WINDER_F_MARK, diff --git a/libguile/dynwind.h b/libguile/dynwind.h index 920e9a83c..bf14126a1 100644 --- a/libguile/dynwind.h +++ b/libguile/dynwind.h @@ -50,18 +50,18 @@ typedef enum { SCM_F_WIND_EXPLICITLY = (1 << 0) } scm_t_wind_flags; -SCM_API void scm_begin_frame (scm_t_frame_flags); -SCM_API void scm_end_frame (void); +SCM_API void scm_frame_begin (scm_t_frame_flags); +SCM_API void scm_frame_end (void); -SCM_API void scm_on_unwind (void (*func) (void *), void *data, - scm_t_wind_flags); -SCM_API void scm_on_rewind (void (*func) (void *), void *data, - scm_t_wind_flags); +SCM_API void scm_frame_unwind (void (*func) (void *), void *data, + scm_t_wind_flags); +SCM_API void scm_frame_rewind (void (*func) (void *), void *data, + scm_t_wind_flags); -SCM_API void scm_on_unwind_with_scm (void (*func) (SCM), SCM data, - scm_t_wind_flags); -SCM_API void scm_on_rewind_with_scm (void (*func) (SCM), SCM data, - scm_t_wind_flags); +SCM_API void scm_frame_unwind_with_scm (void (*func) (SCM), SCM data, + scm_t_wind_flags); +SCM_API void scm_frame_rewind_with_scm (void (*func) (SCM), SCM data, + scm_t_wind_flags); #ifdef GUILE_DEBUG SCM_API SCM scm_wind_chain (void); From 07add3457ba962b8bce04b46101f85f7e089d8e8 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 18:03:46 +0000 Subject: [PATCH 007/167] Did the follwing renamings: scm_with_current_input_port -> scm_frame_current_input_port, scm_with_current_output_port -> scm_frame_current_output_port, scm_with_current_error_port -> scm_frame_current_error_port. Changed all uses. --- libguile/ports.c | 30 +++++++++++++++--------------- libguile/ports.h | 6 +++--- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/libguile/ports.c b/libguile/ports.c index 70fdcc0f2..45085e887 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -444,7 +444,7 @@ swap_port (SCM scm_data) } static void -scm_with_current_foo_port (SCM port, +scm_frame_current_foo_port (SCM port, SCM (*getter) (void), SCM (*setter) (SCM)) { SCM scm_data = scm_malloc_obj (sizeof (swap_data)); @@ -453,32 +453,32 @@ scm_with_current_foo_port (SCM port, data->getter = getter; data->setter = setter; - scm_on_rewind_with_scm (swap_port, scm_data, SCM_F_WIND_EXPLICITLY); - scm_on_unwind_with_scm (swap_port, scm_data, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind_with_scm (swap_port, scm_data, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_with_scm (swap_port, scm_data, SCM_F_WIND_EXPLICITLY); } void -scm_with_current_input_port (SCM port) +scm_frame_current_input_port (SCM port) { - scm_with_current_foo_port (port, - scm_current_input_port, - scm_set_current_input_port); + scm_frame_current_foo_port (port, + scm_current_input_port, + scm_set_current_input_port); } void -scm_with_current_output_port (SCM port) +scm_frame_current_output_port (SCM port) { - scm_with_current_foo_port (port, - scm_current_output_port, - scm_set_current_output_port); + scm_frame_current_foo_port (port, + scm_current_output_port, + scm_set_current_output_port); } void -scm_with_current_error_port (SCM port) +scm_frame_current_error_port (SCM port) { - scm_with_current_foo_port (port, - scm_current_error_port, - scm_set_current_error_port); + scm_frame_current_foo_port (port, + scm_current_error_port, + scm_set_current_error_port); } diff --git a/libguile/ports.h b/libguile/ports.h index 796ccf87e..8dffade07 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -235,9 +235,9 @@ 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 void scm_with_current_input_port (SCM port); -SCM_API void scm_with_current_output_port (SCM port); -SCM_API void scm_with_current_error_port (SCM port); +SCM_API void scm_frame_current_input_port (SCM port); +SCM_API void scm_frame_current_output_port (SCM port); +SCM_API void scm_frame_current_error_port (SCM port); 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); From ef20bf705f6b9d23267a08e2362bb91715dc7e4f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 18:08:52 +0000 Subject: [PATCH 008/167] (scm_frame_fluid): New. --- libguile/fluids.c | 17 +++++++++++++++++ libguile/fluids.h | 2 ++ 2 files changed, 19 insertions(+) diff --git a/libguile/fluids.c b/libguile/fluids.c index 32a5ffd37..7be538f9d 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -233,6 +233,23 @@ scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata) } #undef FUNC_NAME +static void +swap_fluid (SCM data) +{ + SCM f = SCM_CAR (data); + SCM t = scm_fluid_ref (f); + scm_fluid_set_x (f, SCM_CDR (data)); + SCM_SETCDR (data, t); +} + +void +scm_frame_fluid (SCM fluid, SCM value) +{ + SCM data = scm_cons (fluid, value); + scm_frame_rewind_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY); +} + void scm_init_fluids () { diff --git a/libguile/fluids.h b/libguile/fluids.h index 07dce8523..8a5150e83 100644 --- a/libguile/fluids.h +++ b/libguile/fluids.h @@ -76,6 +76,8 @@ SCM_API SCM scm_c_with_fluid (SCM fluid, SCM val, SCM (*cproc)(void *), void *cdata); SCM_API SCM scm_with_fluids (SCM fluids, SCM vals, SCM thunk); +SCM_API void scm_frame_fluid (SCM fluid, SCM value); + SCM_API SCM scm_i_make_initial_fluids (void); SCM_API void scm_i_copy_fluids (scm_root_state *); SCM_API void scm_i_swap_fluids (SCM fluids, SCM vals); From 6394add195faae1e7ed2cdb6b8523538d6e2283d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 18:13:07 +0000 Subject: [PATCH 009/167] Adapt to new 'frame' names. Document scm_c_with_fluid, scm_c_with_fluids, and scm_frame_fluid. --- doc/ref/scheme-control.texi | 32 ++++++++++++++++---------------- doc/ref/scheme-io.texi | 14 +++++++------- doc/ref/scheme-scheduling.texi | 29 +++++++++++++++++++++++------ 3 files changed, 46 insertions(+), 29 deletions(-) diff --git a/doc/ref/scheme-control.texi b/doc/ref/scheme-control.texi index 023fdb9b7..d56b543f7 100644 --- a/doc/ref/scheme-control.texi +++ b/doc/ref/scheme-control.texi @@ -1050,12 +1050,12 @@ convenient construction of anonymous procedures that close over lexical variables, this will be, well, inconvenient. Instead, C code can use @dfn{frames}. -Guile offers the functions @code{scm_begin_frame} and -@code{scm_end_frame} to delimit a dynamic extent. Within this dynamic +Guile offers the functions @code{scm_frame_begin} and +@code{scm_frame_end} to delimit a dynamic extent. Within this dynamic extent, which is called a @dfn{frame}, you can perform various @dfn{frame actions} that control what happens when the frame is entered or left. For example, you can register a cleanup routine with -@code{scm_on_unwind} that is executed when the frame is left. There are +@code{scm_frame_unwind} that is executed when the frame is left. There are several other more specialized frame actions as well, for example to temporarily block the execution of asyncs or to temporarily change the current output port. They are described elsewhere in this manual. @@ -1100,19 +1100,19 @@ scm_foo (SCM s1, SCM s2) @{ char *c_s1, *c_s2, *c_res; - scm_begin_frame (0); + scm_frame_begin (0); c_s1 = scm_to_string (s1); - scm_on_unwind (free, s1, SCM_F_EXPLICIT); + scm_frame_unwind (free, c_s1, SCM_F_EXPLICIT); c_s2 = scm_to_string (s2); - scm_on_unwind (free, s2, SCM_F_EXPLICIT); + scm_frame_unwind (free, c_s2, SCM_F_EXPLICIT); c_res = foo (c_s1, c_s2); if (c_res == NULL) scm_memory_error ("foo"); - scm_end_frame (); + scm_frame_end (); return scm_take0str (res); @} @@ -1131,7 +1131,7 @@ a frame can not be reentered non-locally. @end deftp -@deftypefn {C Function} void scm_begin_frame (scm_t_frame_flags flags) +@deftypefn {C Function} void scm_frame_begin (scm_t_frame_flags flags) The function @code{scm_begin_frame} starts a new frame and makes it the `current' one. @@ -1146,7 +1146,7 @@ is indeed ended properly. If you fail to call @code{scm_end_frame} each @code{scm_begin_frame}, the behavior is undefined. @end deftypefn -@deftypefn {C Function} void scm_end_frame () +@deftypefn {C Function} void scm_frame_end () End the current frame explicitly and make the previous frame current. @end deftypefn @@ -1162,25 +1162,25 @@ left locally. @end table @end deftp -@deftypefn {C Function} void scm_on_unwind (void (*func)(void *), void *data, scm_t_wind_flags flags) -@deftypefnx {C Function} void scm_on_unwind_with_scm (void (*func)(SCM), SCM data, scm_t_wind_flags flags) +@deftypefn {C Function} void scm_frame_unwind (void (*func)(void *), void *data, scm_t_wind_flags flags) +@deftypefnx {C Function} void scm_frame_unwind_with_scm (void (*func)(SCM), SCM data, scm_t_wind_flags flags) Arranges for @var{func} to be called with @var{data} as its arguments when the current frame ends implicitly. If @var{flags} contains @code{SCM_F_WIND_EXPLICITLY}, @var{func} is also called when the frame -ends explicitly with @code{scm_end_frame}. +ends explicitly with @code{scm_frame_end}. -The function @code{scm_on_unwind_with_scm} takes care that @var{data} +The function @code{scm_frame_unwind_with_scm} takes care that @var{data} is protected from garbage collected. @end deftypefn -@deftypefn {C Function} void scm_on_rewind (void (*func)(void *), void *data, scm_t_wind_flags flags) -@deftypefnx {C Function} void scm_on_rewind_with_scm (void (*func)(SCM), SCM data, scm_t_wind_flags flags) +@deftypefn {C Function} void scm_frame_rewind (void (*func)(void *), void *data, scm_t_wind_flags flags) +@deftypefnx {C Function} void scm_frame_rewind_with_scm (void (*func)(SCM), SCM data, scm_t_wind_flags flags) Arrange for @var{func} to be called with @var{data} as its argument when the current frame is restarted by rewinding the stack. When @var{flags} contains @code{SCM_F_WIND_EXPLICITLY}, @var{func} is called immediately as well. -The function @code{scm_on_rewind_with_scm} takes care that @var{data} +The function @code{scm_frame_rewind_with_scm} takes care that @var{data} is protected from garbage collected. @end deftypefn diff --git a/doc/ref/scheme-io.texi b/doc/ref/scheme-io.texi index 58deaf9aa..eb01ecbac 100644 --- a/doc/ref/scheme-io.texi +++ b/doc/ref/scheme-io.texi @@ -634,17 +634,17 @@ Change the ports returned by @code{current-input-port}, so that they use the supplied @var{port} for input or output. @end deffn -@deftypefn {C Function} void scm_with_current_input_port (SCM port) -@deftypefnx {C Function} void scm_with_current_output_port (SCM port) -@deftypefnx {C Function} void scm_with_current_error_port (SCM port) +@deftypefn {C Function} void scm_frame_current_input_port (SCM port) +@deftypefnx {C Function} void scm_frame_current_output_port (SCM port) +@deftypefnx {C Function} void scm_frame_current_error_port (SCM port) These functions must be used inside a pair of calls to -@code{scm_begin_frame} and @code{scm_end_frame} (@pxref{Frames}). +@code{scm_frame_begin} and @code{scm_frame_end} (@pxref{Frames}). During the dynamic extent of the frame, the indicated port is set to @var{port}. -More precisely, the the current port is saved when the dynamic extent is -entered and set to @var{port}. When the dynamic extent is left, the -current port is stored in @var{port} and reset to the saved value. +More precisely, the current port is swapped with a `backup' value +whenever the frame is entered or left. The backup value is +initialized with the @var{port} argument. @end deftypefn @node Port Types diff --git a/doc/ref/scheme-scheduling.texi b/doc/ref/scheme-scheduling.texi index c9b4a029a..e156d1bfc 100644 --- a/doc/ref/scheme-scheduling.texi +++ b/doc/ref/scheme-scheduling.texi @@ -147,15 +147,15 @@ 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 -@deftypefn {C Function} void scm_with_blocked_asyncs () +@deftypefn {C Function} void scm_frame_block_asyncs () This function must be used inside a pair of calls to -@code{scm_begin_frame} and @code{scm_end_frame} (@pxref{Frames}). +@code{scm_frame_begin} and @code{scm_frame_end} (@pxref{Frames}). During the dynamic extent of the frame, asyncs are blocked by one level. @end deftypefn -@deftypefn {C Function} void scm_with_unblocked_asyncs () +@deftypefn {C Function} void scm_frame_unblock_asyncs () This function must be used inside a pair of calls to -@code{scm_begin_frame} and @code{scm_end_frame} (@pxref{Frames}). +@code{scm_frame_begin} and @code{scm_frame_end} (@pxref{Frames}). During the dynamic extent of the frame, asyncs are unblocked by one level. @end deftypefn @@ -631,8 +631,6 @@ You should call it in preference to the system @code{select}. @cindex fluids -@c FIXME::martin: Review me! - Fluids are objects to store values in. They have a few properties which make them useful in certain situations: Fluids can have one value per dynamic root (@pxref{Dynamic Roots}), so that changes to the @@ -704,6 +702,25 @@ executed inside a @code{dynamic-wind} and the fluids are set/restored when control enter or leaves the established dynamic extent. @end deffn +@deftypefn {C Function} SCM scm_c_with_fluids (SCM fluids, SCM vals, SCM (*cproc)(void *), void *data) +@deftypefnx {C Function} SCM scm_c_with_fluid (SCM fluid, SCM val, SCM (*cproc)(void *), void *data) +The function @code{scm_c_with_fluids} is like @code{scm_with_fluids} +except that it takes a C function to call instead of a Scheme thunk. + +The function @code{scm_c_with_fluid} is similar but only allows one +fluid to be set instead of a list. +@end deftypefn + +@deftypefn {C Function} void scm_frame_fluid (SCM fluid, SCM val) +This function must be used inside a pair of calls to +@code{scm_frame_begin} and @code{scm_frame_end} (@pxref{Frames}). +During the dynamic extent of the frame, the fluid @var{fluid} is set +to @var{val}. + +More precisely, the value of the fluid is swapped with a `backup' +value whenever the frame is entered or left. The backup value is +initialized with the @var{val} argument. +@end deftypefn @node Futures @section Futures From a31635683414b09e757498ce5e7f954f389a45a6 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 18:17:04 +0000 Subject: [PATCH 010/167] (SCM_TESTS): Added continuations.test. --- test-suite/Makefile.am | 1 + 1 file changed, 1 insertion(+) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 3481f77a5..fa69702f3 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -26,6 +26,7 @@ SCM_TESTS = tests/alist.test \ tests/c-api.test \ tests/chars.test \ tests/common-list.test \ + tests/continuations.test \ tests/elisp.test \ tests/environments.test \ tests/eval.test \ From 8843e1fa41dba5019336205e9570ebef49ab6317 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 18:18:00 +0000 Subject: [PATCH 011/167] Adapted to 'frame' renamings. (check_fluid): New. --- test-suite/standalone/test-unwind.c | 77 ++++++++++++++++++++--------- 1 file changed, 53 insertions(+), 24 deletions(-) diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c index e64c6e4c3..4e107a92f 100644 --- a/test-suite/standalone/test-unwind.c +++ b/test-suite/standalone/test-unwind.c @@ -16,6 +16,7 @@ SCM check_cont_body (void *data); void close_port (SCM port); void delete_file (void *data); void check_ports (void); +void check_fluid (void); int flag1, flag2, flag3; @@ -32,10 +33,10 @@ set_flag (void *data) void func1 () { - scm_begin_frame (0); + scm_frame_begin (0); flag1 = 0; - scm_on_unwind (set_flag, &flag1, 0); - scm_end_frame (); + scm_frame_unwind (set_flag, &flag1, 0); + scm_frame_end (); } /* FUNC2 should set flag1. @@ -44,10 +45,10 @@ func1 () void func2 () { - scm_begin_frame (0); + scm_frame_begin (0); flag1 = 0; - scm_on_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); - scm_end_frame (); + scm_frame_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); + scm_frame_end (); } /* FUNC3 should set flag1. @@ -56,11 +57,11 @@ func2 () void func3 () { - scm_begin_frame (0); + scm_frame_begin (0); flag1 = 0; - scm_on_unwind (set_flag, &flag1, 0); + scm_frame_unwind (set_flag, &flag1, 0); scm_misc_error ("func3", "gratuitous error", SCM_EOL); - scm_end_frame (); + scm_frame_end (); } /* FUNC4 should set flag1. @@ -69,11 +70,11 @@ func3 () void func4 () { - scm_begin_frame (0); + scm_frame_begin (0); flag1 = 0; - scm_on_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); scm_misc_error ("func4", "gratuitous error", SCM_EOL); - scm_end_frame (); + scm_frame_end (); } SCM @@ -110,10 +111,10 @@ check_cont_body (void *data) int first; SCM val; - scm_begin_frame (flags); + scm_frame_begin (flags); val = scm_make_continuation (&first); - scm_end_frame (); + scm_frame_end (); return val; } @@ -174,26 +175,26 @@ check_ports () if (mktemp (filename) == NULL) exit (1); - scm_begin_frame (0); + scm_frame_begin (0); { SCM port = scm_open_file (scm_str2string (filename), scm_str2string ("w")); - scm_on_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY); - scm_with_current_output_port (port); + scm_frame_current_output_port (port); scm_write (scm_version (), SCM_UNDEFINED); } - scm_end_frame (); + scm_frame_end (); - scm_begin_frame (0); + scm_frame_begin (0); { SCM port = scm_open_file (scm_str2string (filename), scm_str2string ("r")); SCM res; - scm_on_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY); - scm_on_unwind (delete_file, filename, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind (delete_file, filename, SCM_F_WIND_EXPLICITLY); - scm_with_current_input_port (port); + scm_frame_current_input_port (port); res = scm_read (SCM_UNDEFINED); if (SCM_FALSEP (scm_equal_p (res, scm_version ()))) { @@ -201,9 +202,35 @@ check_ports () exit (1); } } - scm_end_frame (); + scm_frame_end (); } - + +void +check_fluid () +{ + SCM f = scm_make_fluid (); + SCM x; + + scm_fluid_set_x (f, SCM_MAKINUM (12)); + + scm_frame_begin (0); + scm_frame_fluid (f, SCM_MAKINUM (13)); + x = scm_fluid_ref (f); + scm_frame_end (); + + if (!SCM_EQ_P (x, SCM_MAKINUM (13))) + { + printf ("setting fluid didn't work\n"); + exit (1); + } + + if (!SCM_EQ_P (scm_fluid_ref (f), SCM_MAKINUM (12))) + { + printf ("resetting fluid didn't work\n"); + exit (1); + } +} + static void inner_main (void *data, int argc, char **argv) { @@ -217,6 +244,8 @@ inner_main (void *data, int argc, char **argv) check_ports (); + check_fluid (); + exit (0); } From fc6bb2831dd5bcb002c5711bd74764c3f2f54f66 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 18:18:09 +0000 Subject: [PATCH 012/167] *** empty log message *** --- NEWS | 26 ++++++++++++++++---------- doc/ref/ChangeLog | 6 ++++++ libguile/ChangeLog | 27 +++++++++++++++++++++++++++ test-suite/ChangeLog | 7 +++++++ 4 files changed, 56 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index b77391f38..8982fd195 100644 --- a/NEWS +++ b/NEWS @@ -581,28 +581,29 @@ starting the week. ** New way to deal with non-local exits and reentries. There is a new set of functions that essentially do what -scm_internal_dynamic_wind does, but in a more convenient way. Here is -a quick example of how to prevent a potential memory leak: +scm_internal_dynamic_wind does, but in a way that is more convenient +for C code in some situations. Here is a quick example of how to +prevent a potential memory leak: void foo () { char *mem; - scm_begin_frame (0); + scm_frame_begin (0); mem = scm_malloc (100); - scm_on_unwind (free, mem, SCM_F_WIND_EXPLICITELY); + scm_frame_unwind (free, mem, SCM_F_WIND_EXPLICITELY); - /* MEM would leak if BAR throws an error. SCM_ON_UNWIND frees it + /* MEM would leak if BAR throws an error. SCM_FRAME_UNWIND frees it nevertheless. */ bar (); - scm_end_frame (); + scm_frame_end (); /* Because of SCM_F_WIND_EXPLICITELY, MEM will be freed by - SCM_END_FRAME as well. + SCM_FRAME_END as well. */ } @@ -611,14 +612,19 @@ For full documentation, see the node "Frames" in the manual. ** New way to block and unblock asyncs In addition to scm_c_call_with_blocked_asyncs you can now also use -scm_with_blocked_asyncs in a 'frame' (see above). Likewise for -scm_c_call_with_unblocked_asyncs and scm_with_unblocked_asyncs. +scm_frame_block_asyncs in a 'frame' (see above). Likewise for +scm_c_call_with_unblocked_asyncs and scm_frame_unblock_asyncs. ** New way to temporarily set the current input, output or error ports -C code can now use scm_with_current__port in a 'frame' (see +C code can now use scm_frame_current__port in a 'frame' (see above). is one of "input", "output" or "error". +** New way to temporarily set fluids + +C code can now use scm_frame_fluid in a 'frame' (see +above) to temporarily set the value of a fluid. + ** New types scm_t_intmax and scm_t_uintmax. On platforms that have them, these types are identical to intmax_t and diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index ecebd2a76..f6f0ccce2 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2004-01-07 Marius Vollmer + + * scheme-control.texi, scheme-io.tex, scheme-scheduling.texi: + Adapt to new 'frame' names. Document scm_c_with_fluid, + scm_c_with_fluids, and scm_frame_fluid. + 2004-01-06 Marius Vollmer * scheme-control.texi: Document scm_on_unwind_with_scm and diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 558f16ab5..5bfc42761 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,30 @@ +2004-01-07 Marius Vollmer + + * fluids.h, fluids.c (scm_frame_fluid): New. + + * dynwind.c (scm_frame_end): Do not use scm_i_dowinds. Instead, + do the unwinding directly. It is simple enough. + + * dynwind.h, dynwind.c: Did the following renamings: + scm_begin_frame -> scm_frame_begin, + scm_end_frame -> scm_frame_end, + scm_on_unwind -> scm_frame_unwind, + scm_on_rewind -> scm_frame_rewind, + scm_on_unwind_with_scm -> scm_frame_unwind_with_scm, + scm_on_rewind_with_scm -> scm_frame_rewind_with_scm. + Changed all uses. + + * aync.h, async.c: Did the follwing renamings: + scm_with_blocked_asyncs -> scm_frame_block_asyncs, + scm_with_unblocked_asyncs -> scm_frame_unblock_asyncs. + Changed all uses. + + * ports.h, ports.c: Did the follwing renamings: + scm_with_current_input_port -> scm_frame_current_input_port, + scm_with_current_output_port -> scm_frame_current_output_port, + scm_with_current_error_port -> scm_frame_current_error_port. + Changed all uses. + 2004-01-07 Kevin Ryde * numbers.c (s_bignum): Remove, not used since gmp bignums. diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 8ad4970a2..659ffe13d 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,10 @@ +2004-01-07 Marius Vollmer + + * standalone/test-unwind.c: Adapted to 'frame' renamings. + (check_fluid): New. + + * Makefile.am (SCM_TESTS): Added continuations.test. + 2004-01-07 Kevin Ryde * tests/numbers.test (<): Add tests inum/bignum/flonum/frac with frac. From bebd3fbadd8541ee42b3e311c0e7f4a4751c6703 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 19:47:18 +0000 Subject: [PATCH 013/167] * fluids.c (scm_c_with_fluids): Use frames instead of adding to the wind chain explicitely. Use scm_c_with_fluid for the common case of only one fluid. (scm_with_fluid): New. (scm_c_with_fluid): Use frames instead of scm_c_with_fluids. * fluids.h, fluids.c (scm_frame_fluid): New. (scm_with_fluid): New. (scm_i_swap_fluids, scm_i_swap_fluids_reverse): Removed. --- libguile/fluids.c | 55 ++++++++++++++++++++++++++++++++++++----------- libguile/fluids.h | 3 +-- 2 files changed, 43 insertions(+), 15 deletions(-) diff --git a/libguile/fluids.c b/libguile/fluids.c index 7be538f9d..3f5591759 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -152,9 +152,11 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0, } #undef FUNC_NAME -void -scm_i_swap_fluids (SCM fluids, SCM vals) +static void +swap_fluids (SCM data) { + SCM fluids = SCM_CAR (data), vals = SCM_CDR (data); + while (!SCM_NULL_OR_NIL_P (fluids)) { SCM fl = SCM_CAR (fluids); @@ -169,14 +171,14 @@ scm_i_swap_fluids (SCM fluids, SCM vals) /* Swap the fluid values in reverse order. This is important when the same fluid appears multiple times in the fluids list. */ -void -scm_i_swap_fluids_reverse (SCM fluids, SCM vals) +static void +swap_fluids_reverse_aux (SCM fluids, SCM vals) { if (!SCM_NULL_OR_NIL_P (fluids)) { SCM fl, old_val; - scm_i_swap_fluids_reverse (SCM_CDR (fluids), SCM_CDR (vals)); + swap_fluids_reverse_aux (SCM_CDR (fluids), SCM_CDR (vals)); fl = SCM_CAR (fluids); old_val = scm_fluid_ref (fl); scm_fluid_set_x (fl, SCM_CAR (vals)); @@ -184,6 +186,11 @@ scm_i_swap_fluids_reverse (SCM fluids, SCM vals) } } +static void +swap_fluids_reverse (SCM data) +{ + swap_fluids_reverse_aux (SCM_CAR (data), SCM_CDR (data)); +} static SCM apply_thunk (void *thunk) @@ -199,7 +206,8 @@ SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0, "one after another. @var{thunk} must be a procedure with no argument.") #define FUNC_NAME s_scm_with_fluids { - return scm_c_with_fluids (fluids, values, apply_thunk, (void *) SCM_UNPACK (thunk)); + return scm_c_with_fluids (fluids, values, + apply_thunk, (void *) SCM_UNPACK (thunk)); } #undef FUNC_NAME @@ -207,7 +215,7 @@ SCM scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata) #define FUNC_NAME "scm_c_with_fluids" { - SCM ans; + SCM ans, data; long flen, vlen; SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen); @@ -215,21 +223,42 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata) if (flen != vlen) scm_out_of_range (s_scm_with_fluids, values); - scm_i_swap_fluids (fluids, values); - scm_dynwinds = scm_acons (fluids, values, scm_dynwinds); + if (flen == 1) + return scm_c_with_fluid (SCM_CAR (fluids), SCM_CAR (values), + cproc, cdata); + + data = scm_cons (fluids, values); + scm_frame_begin (SCM_F_FRAME_REWINDABLE); + scm_frame_rewind_with_scm (swap_fluids, data, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_with_scm (swap_fluids_reverse, data, SCM_F_WIND_EXPLICITLY); ans = cproc (cdata); - scm_dynwinds = SCM_CDR (scm_dynwinds); - scm_i_swap_fluids_reverse (fluids, values); + scm_frame_end (); return ans; } #undef FUNC_NAME +SCM_DEFINE (scm_with_fluid, "with-fluid*", 3, 0, 0, + (SCM fluid, SCM value, SCM thunk), + "Set @var{fluid} to @var{value} temporarily, and call @var{thunk}.\n" + "@var{thunk} must be a procedure with no argument.") +#define FUNC_NAME s_scm_with_fluid +{ + return scm_c_with_fluid (fluid, value, + apply_thunk, (void *) SCM_UNPACK (thunk)); +} +#undef FUNC_NAME + SCM scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata) #define FUNC_NAME "scm_c_with_fluid" { - return scm_c_with_fluids (scm_list_1 (fluid), scm_list_1 (value), - cproc, cdata); + SCM ans; + + scm_frame_begin (SCM_F_FRAME_REWINDABLE); + scm_frame_fluid (fluid, value); + ans = cproc (cdata); + scm_frame_end (); + return ans; } #undef FUNC_NAME diff --git a/libguile/fluids.h b/libguile/fluids.h index 8a5150e83..cb4fba4bd 100644 --- a/libguile/fluids.h +++ b/libguile/fluids.h @@ -75,13 +75,12 @@ SCM_API SCM scm_c_with_fluids (SCM fluids, SCM vals, SCM_API SCM scm_c_with_fluid (SCM fluid, SCM val, SCM (*cproc)(void *), void *cdata); SCM_API SCM scm_with_fluids (SCM fluids, SCM vals, SCM thunk); +SCM_API SCM scm_with_fluid (SCM fluid, SCM val, SCM thunk); SCM_API void scm_frame_fluid (SCM fluid, SCM value); SCM_API SCM scm_i_make_initial_fluids (void); SCM_API void scm_i_copy_fluids (scm_root_state *); -SCM_API void scm_i_swap_fluids (SCM fluids, SCM vals); -SCM_API void scm_i_swap_fluids_reverse (SCM fluids, SCM vals); SCM_API void scm_init_fluids (void); From 540cc7abdca49861911a24280429a8f5b3e06467 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 19:50:28 +0000 Subject: [PATCH 014/167] * dynwind.c (scm_i_dowinds): Removed code for handling fluids. --- libguile/dynwind.c | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/libguile/dynwind.c b/libguile/dynwind.c index c864ac86e..6c2cb6709 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -41,8 +41,6 @@ (tag . lazy-catch) lazy-catch tag is either a symbol or a boolean - ((fluid ...) . (value ...)) with-fluids - */ @@ -314,15 +312,13 @@ scm_i_dowinds (SCM to, long delta, int explicit, else { wind_key = SCM_CAR (wind_elt); - /* key = #t | symbol | thunk | list of variables | list of fluids */ + /* key = #t | symbol | thunk | list of variables */ if (SCM_NIMP (wind_key)) { if (SCM_CONSP (wind_key)) { if (SCM_VARIABLEP (SCM_CAR (wind_key))) scm_swap_bindings (wind_key, SCM_CDR (wind_elt)); - else if (SCM_FLUIDP (SCM_CAR (wind_key))) - scm_i_swap_fluids (wind_key, SCM_CDR (wind_elt)); } else if (SCM_TYP3 (wind_key) == scm_tc3_closure) scm_call_0 (wind_key); @@ -370,9 +366,6 @@ scm_i_dowinds (SCM to, long delta, int explicit, { if (SCM_VARIABLEP (SCM_CAR (wind_key))) scm_swap_bindings (wind_key, SCM_CDR (wind_elt)); - else if (SCM_FLUIDP (SCM_CAR (wind_key))) - scm_i_swap_fluids_reverse (wind_key, - SCM_CDR (wind_elt)); } else if (SCM_TYP3 (wind_key) == scm_tc3_closure) scm_call_0 (SCM_CDR (wind_elt)); From 062fccce799bd874bcab541a8641682f85a06135 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 19:51:07 +0000 Subject: [PATCH 015/167] (with-fluids): Use with-fluid* when only one fluid is being set. --- ice-9/boot-9.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index f41420006..0cc341a19 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2626,8 +2626,12 @@ ;; body) (defmacro with-fluids (bindings . body) - `(with-fluids* (list ,@(map car bindings)) (list ,@(map cadr bindings)) - (lambda () ,@body))) + (let ((fluids (map car bindings)) + (values (map cadr bindings))) + (if (and (= (length fluids) 1) (= (length values) 1)) + `(with-fluid* ,(car fluids) ,(car values) (lambda () ,@body)) + `(with-fluids* (list ,@fluids) (list ,@values) + (lambda () ,@body))))) From 96e3b2f8088df3406564cf39dea624ceb4999d5c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 19:51:18 +0000 Subject: [PATCH 016/167] *** empty log message *** --- ice-9/ChangeLog | 5 +++++ libguile/ChangeLog | 10 ++++++++++ 2 files changed, 15 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 14bac5f4c..aa315d334 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2004-01-07 Marius Vollmer + + * boot-9.scm (with-fluids): Use with-fluid* when only one fluid is + being set. + 2004-01-07 Kevin Ryde * q.scm (q-pop!): Should be "null?" not "not" for end-of-list. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5bfc42761..32f7febfc 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,6 +1,16 @@ 2004-01-07 Marius Vollmer + * dynwind.c (scm_i_dowinds): Removed code for handling fluids. + + * fluids.c (scm_c_with_fluids): Use frames instead of adding to + the wind chain explicitely. Use scm_c_with_fluid for the common + case of only one fluid. + (scm_with_fluid): New. + (scm_c_with_fluid): Use frames instead of scm_c_with_fluids. + * fluids.h, fluids.c (scm_frame_fluid): New. + (scm_with_fluid): New. + (scm_i_swap_fluids, scm_i_swap_fluids_reverse): Removed. * dynwind.c (scm_frame_end): Do not use scm_i_dowinds. Instead, do the unwinding directly. It is simple enough. From 14578fa4ea21173bd8360f4ba6e0660028769b42 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 20:21:30 +0000 Subject: [PATCH 017/167] * dynwind.h, dynwind.c (scm_i_dowinds): Removed 'explicit' argument since it is always zero now. Changed all callers. Removed code for handling fluids. --- libguile/continuations.c | 3 +-- libguile/dynwind.c | 29 +++++++++-------------------- libguile/dynwind.h | 2 +- 3 files changed, 11 insertions(+), 23 deletions(-) diff --git a/libguile/continuations.c b/libguile/continuations.c index 996d5eebf..60322b3af 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -239,8 +239,7 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val, delta = scm_ilength (scm_dynwinds) - scm_ilength (continuation->dynenv); data.continuation = continuation; data.dst = dst; - scm_i_dowinds (continuation->dynenv, delta, 0, - copy_stack, &data); + scm_i_dowinds (continuation->dynenv, delta, copy_stack, &data); scm_last_debug_frame = continuation->dframe; diff --git a/libguile/dynwind.c b/libguile/dynwind.c index 6c2cb6709..ca2fb704d 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -136,9 +136,9 @@ static scm_t_bits tc16_frame; #define FRAME_REWINDABLE_P(f) (SCM_CELL_WORD_0(f) & FRAME_F_REWINDABLE) static scm_t_bits tc16_winder; -#define WINDER_P(w) SCM_SMOB_PREDICATE (tc16_winder, (w)) -#define WINDER_PROC(w) ((void (*)(void *))SCM_CELL_WORD_1 (w)) -#define WINDER_DATA(w) ((void *)SCM_CELL_WORD_2 (w)) +#define WINDER_P(w) SCM_SMOB_PREDICATE (tc16_winder, (w)) +#define WINDER_PROC(w) ((void (*)(void *))SCM_CELL_WORD_1 (w)) +#define WINDER_DATA(w) ((void *)SCM_CELL_WORD_2 (w)) #define WINDER_F_EXPLICIT (1 << 16) #define WINDER_F_REWIND (1 << 17) @@ -263,12 +263,11 @@ scm_swap_bindings (SCM vars, SCM vals) void scm_dowinds (SCM to, long delta) { - scm_i_dowinds (to, delta, 0, NULL, NULL); + scm_i_dowinds (to, delta, NULL, NULL); } void -scm_i_dowinds (SCM to, long delta, int explicit, - void (*turn_func) (void *), void *data) +scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data) { tail: if (SCM_EQ_P (to, scm_dynwinds)) @@ -281,8 +280,7 @@ scm_i_dowinds (SCM to, long delta, int explicit, SCM wind_elt; SCM wind_key; - scm_i_dowinds (SCM_CDR (to), 1 + delta, explicit, - turn_func, data); + scm_i_dowinds (SCM_CDR (to), 1 + delta, turn_func, data); wind_elt = SCM_CAR (to); #if 0 @@ -303,11 +301,7 @@ scm_i_dowinds (SCM to, long delta, int explicit, else if (WINDER_P (wind_elt)) { if (WINDER_REWIND_P (wind_elt)) - { - void (*proc) (void *) = WINDER_PROC (wind_elt); - void *data = WINDER_DATA (wind_elt); - proc (data); - } + WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt)); } else { @@ -349,13 +343,8 @@ scm_i_dowinds (SCM to, long delta, int explicit, } else if (WINDER_P (wind_elt)) { - if (!WINDER_REWIND_P (wind_elt) - && (!explicit || WINDER_EXPLICIT_P (wind_elt))) - { - void (*proc) (void *) = WINDER_PROC (wind_elt); - void *data = WINDER_DATA (wind_elt); - proc (data); - } + if (!WINDER_REWIND_P (wind_elt)) + WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt)); } else { diff --git a/libguile/dynwind.h b/libguile/dynwind.h index bf14126a1..f619b46b5 100644 --- a/libguile/dynwind.h +++ b/libguile/dynwind.h @@ -36,7 +36,7 @@ SCM_API SCM scm_internal_dynamic_wind (scm_t_guard before, void *inner_data, void *guard_data); SCM_API void scm_dowinds (SCM to, long delta); -SCM_API void scm_i_dowinds (SCM to, long delta, int explicit, +SCM_API void scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data); SCM_API void scm_init_dynwind (void); From 7ebccde82ef49bcc9e5228114b92fdb49ac4ac7d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 7 Jan 2004 20:21:38 +0000 Subject: [PATCH 018/167] *** empty log message *** --- libguile/ChangeLog | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 32f7febfc..9460eac34 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,6 +1,8 @@ 2004-01-07 Marius Vollmer - * dynwind.c (scm_i_dowinds): Removed code for handling fluids. + * dynwind.h, dynwind.c (scm_i_dowinds): Removed 'explicit' + argument since it is always zero now. Changed all callers. + Removed code for handling fluids. * fluids.c (scm_c_with_fluids): Use frames instead of adding to the wind chain explicitely. Use scm_c_with_fluid for the common From 42155d759e66e5847f4795f6c883e25db4ac049e Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 8 Jan 2004 17:04:02 +0000 Subject: [PATCH 019/167] More stuff about flow control. Bug fixes in example. --- doc/ref/scheme-control.texi | 146 +++++++++++++++++++++++++++--------- 1 file changed, 110 insertions(+), 36 deletions(-) diff --git a/doc/ref/scheme-control.texi b/doc/ref/scheme-control.texi index d56b543f7..36918373d 100644 --- a/doc/ref/scheme-control.texi +++ b/doc/ref/scheme-control.texi @@ -2,6 +2,20 @@ @node Control Mechanisms @chapter Controlling the Flow of Program Execution +@menu +* begin:: Evaluating a sequence of expressions. +* if cond case:: Simple conditional evaluation. +* and or:: Conditional evaluation of a sequence. +* while do:: Iteration mechanisms. +* Continuations:: Continuations. +* Multiple Values:: Returning and accepting multiple values. +* Exceptions:: Throwing and catching exceptions. +* Error Reporting:: Procedures for signaling errors. +* Dynamic Wind:: Guarding against non-local entrance/exit. +* Frames:: Another way to handle non-localness +* Handling Errors:: How to handle errors in C code. +@end menu + Scheme has a more general view of program flow than C, both locally and non-locally. @@ -11,7 +25,69 @@ refers to situations where the program jumps across one or more levels of function activations without using the normal call or return operations. -[ XXX - tail calls instead of goto. ] +The primitive means of C for local control flow is the @code{goto} +statement, together with @code{if}. Loops done with @code{for}, +@code{while} or @code{do} could in principle be rewritten with just +@code{goto} and @code{if}. In Scheme, the primitive means for local +control flow is the @emph{function call} (together with @code{if}). +Thus, the repetition of some computation in a loop is ultimately +implemented by a function that calls itself, that is, by recursion. + +This approach is theoretically very powerful since it is easier to +reason formally about recursion than about gotos. In C, using +recursion exclusively would not be practical, tho, since it would eat +up the stack very quickly. In Scheme, however, it is practical: +function calls that appear in a @dfn{tail position} do not use any +additional stack space. + +A function call is in a tail position when it is the last thing the +calling function does. The value returned by the called function is +immediately returned from the calling function. In the following +example, the call to @code{bar-1} is in a tail position, while the +call to @code{bar-2} is not. (The call to @code{1-} in @code{foo-2} +is in a tail position, tho.) + +@lisp +(define (foo-1 x) + (bar-1 (1- x))) + +(define (foo-2 x) + (1- (bar-2 x))) +@end lisp + +Thus, when you take care to recurse only in tail positions, the +recursion will only use constant stack space and will be as good as a +loop constructed from gotos. + +Scheme offers a few syntactic abstractions (@code{do} and @dfn{named} +@code{let}) that make writing loops slightly easier. + +But only Scheme functions can call other functions in a tail position: +C functions can not. This matters when you have, say, two functions +that call each other recursively to form a common loop. The following +(unrealistic) example shows how one might go about determing whether a +non-negative integer @var{n} is even or odd. + +@lisp +(define (my-even? n) + (cond ((zero? n) #t) + (else (my-odd? (1- n))))) + +(define (my-odd? n) + (cond ((zero? n) #f) + (else (my-even? (1- n))))) +@end lisp + +Because the calls to @code{my-even?} and @code{my-odd?} are in tail +positions, these two procedures can be applied to arbitrary large +integers without overflowing the stack. (They will still take a lot +of time, of course.) + +However, when one or both of the two procedures would be rewritten in +C, it could no longer call its companion in a tail position (since C +does not have this concept). You might need to take this +consideration into account when deciding which parts of your program +to write in Scheme and which in C. In addition to calling functions and returning from them, a Scheme program can also exit non-locally from a function so that the control @@ -28,16 +104,17 @@ In general, these non-local jumps are done by invoking @code{call-with-current-continuation}. Guile also offers a slightly restricted set of functions, @code{catch} and @code{throw}, that can only be used for non-local exits. This restriction makes them more -efficient. Error reporting (with the function @code{error}) is done by -invoking @code{throw}, for example. The functions @code{catch} and -@code{throw} belong to the topic of @dfn{exceptions}. +efficient. Error reporting (with the function @code{error}) is +implemented by invoking @code{throw}, for example. The functions +@code{catch} and @code{throw} belong to the topic of @dfn{exceptions}. Since Scheme functions can call C functions and vice versa, C code can -experience the more general flow of control of Scheme as well. It is +experience the more general control flow of Scheme as well. It is possible that a C function will not return at all, or will return more than once. While C does offer @code{setjmp} and @code{longjmp} for -non-local exits, it is still a unusual thing for C code. In contrast, -non-local exits are very common in Scheme, mostly to report errors. +non-local exits, it is still an unusual thing for C code. In +contrast, non-local exits are very common in Scheme, mostly to report +errors. You need to be prepared for the non-local jumps in the control flow whenever you use a function from @code{libguile}: it is best to assume @@ -54,24 +131,11 @@ its previous value when @code{with-output-to-port} returns normally or when it is exited non-locally. Likewise, the port needs to be set again when control enters non-locally. -Scheme code can use the @code{dynamic-wind} function to arrange the -setting and resetting of the global state. C code could use the +Scheme code can use the @code{dynamic-wind} function to arrange for +the setting and resetting of the global state. C code could use the corresponding @code{scm_internal_dynamic_wind} function, but it might -prefer to use the @dfn{frames} concept that is more natural for C code. - -@menu -* begin:: Evaluating a sequence of expressions. -* if cond case:: Simple conditional evaluation. -* and or:: Conditional evaluation of a sequence. -* while do:: Iteration mechanisms. -* Continuations:: Continuations. -* Multiple Values:: Returning and accepting multiple values. -* Exceptions:: Throwing and catching exceptions. -* Error Reporting:: Procedures for signaling errors. -* Dynamic Wind:: Guarding against non-local entrance/exit. -* Frames:: Another way to handle non-localness -* Handling Errors:: How to handle errors in C code. -@end menu +prefer to use the @dfn{frames} concept that is more natural for C +code. @node begin @@ -81,12 +145,12 @@ prefer to use the @dfn{frames} concept that is more natural for C code. @cindex sequencing @cindex expression sequencing -@code{begin} is used for grouping several expressions together so that -they syntactically are treated as if they were one expression. This is -particularly important when syntactic expressions are used which only -allow one expression, but the programmer wants to use more than one -expression in that place. As an example, consider the conditional -expression below: +The @code{begin} syntax is used for grouping several expressions +together so that they are treated as if they were one expression. +This is particularly important when syntactic expressions are used +which only allow one expression, but the programmer wants to use more +than one expression in that place. As an example, consider the +conditional expression below: @lisp (if (> x 0) @@ -1103,10 +1167,10 @@ scm_foo (SCM s1, SCM s2) scm_frame_begin (0); c_s1 = scm_to_string (s1); - scm_frame_unwind (free, c_s1, SCM_F_EXPLICIT); + scm_frame_unwind (free, c_s1, SCM_F_WIND_EXPLICITLY); c_s2 = scm_to_string (s2); - scm_frame_unwind (free, c_s2, SCM_F_EXPLICIT); + scm_frame_unwind (free, c_s2, SCM_F_WIND_EXPLICITLY); c_res = foo (c_s1, c_s2); if (c_res == NULL) @@ -1140,10 +1204,20 @@ For normal frames, use 0. This will result in a frame that can not be reentered with a captured continuation. When you are prepared to handle reentries, include @code{SCM_F_FRAME_REWINDABLE} in @var{flags}. +Being prepared for reentry means that the effects of unwind handlers +can be undone on reentry. In the example above, we want to prevent a +memory leak on non-local exit and thus register an unwind handler that +frees the memory. But once the memory is freed, we can not get it +back on reentry. Thus reentry can not be allowed. + +The consequence is that continuations become less useful when +non-reenterable frames are captured, but you don't need to worry about +that too much. + The frame is ended either implicitly when a non-local exit happens, or explicitly with @code{scm_end_frame}. You must make sure that a frame -is indeed ended properly. If you fail to call @code{scm_end_frame} each -@code{scm_begin_frame}, the behavior is undefined. +is indeed ended properly. If you fail to call @code{scm_end_frame} +for each @code{scm_begin_frame}, the behavior is undefined. @end deftypefn @deftypefn {C Function} void scm_frame_end () @@ -1170,7 +1244,7 @@ when the current frame ends implicitly. If @var{flags} contains ends explicitly with @code{scm_frame_end}. The function @code{scm_frame_unwind_with_scm} takes care that @var{data} -is protected from garbage collected. +is protected from garbage collection. @end deftypefn @deftypefn {C Function} void scm_frame_rewind (void (*func)(void *), void *data, scm_t_wind_flags flags) @@ -1181,7 +1255,7 @@ contains @code{SCM_F_WIND_EXPLICITLY}, @var{func} is called immediately as well. The function @code{scm_frame_rewind_with_scm} takes care that @var{data} -is protected from garbage collected. +is protected from garbage collection. @end deftypefn From 84bde77f8e101c47f83a14801542582e4144afc2 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 9 Jan 2004 00:37:44 +0000 Subject: [PATCH 020/167] (Bit Vectors): Revise for clarity, following report by Rouben Rostamian. Remove #b() example, that syntax is not accepted. --- doc/ref/scheme-compound.texi | 97 ++++++++++++++++++++++++------------ 1 file changed, 65 insertions(+), 32 deletions(-) diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index b2fb11e42..aa7894b35 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -1635,49 +1635,82 @@ They are displayed as a sequence of @code{0}s and @example (make-uniform-vector 8 #t #f) @result{} #*00000000 - -#b(#t #f #t) @result{} -#*101 @end example -@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 -@var{bitvector}. +@deffn {Scheme Procedure} bit-count bool bitvector +@deffnx {C Function} scm_bit_count (bool, bitvector) +Return a count of how many entries in @var{bitvector} are equal to +@var{bool}. For example, + +@example +(bit-count #f #*000111000) @result{} 6 +@end example @end deffn -@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 -@var{bv} which is at least @var{k}. If no @var{bool} occurs -within the specified range @code{#f} is returned. +@deffn {Scheme Procedure} bit-position bool bitvector start +@deffnx {C Function} scm_bit_position (bool, bitvector, start) +Return the index of the first occurrance of @var{bool} in +@var{bitvector}, starting from @var{start}. If there is no @var{bool} +entry between @var{start} and the end of @var{bitvector}, then return +@code{#f}. For example, + +@example +(bit-position #t #*000101 0) @result{} 3 +(bit-position #f #*0001111 3) @result{} #f +@end example @end deffn -@deffn {Scheme Procedure} bit-invert! v -@deffnx {C Function} scm_bit_invert_x (v) -Modify @var{bv} by replacing each element with its negation. +@deffn {Scheme Procedure} bit-invert! bitvector +@deffnx {C Function} scm_bit_invert_x (bitvector) +Modify @var{bitvector} by replacing each element with its negation. @end deffn -@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 -length. If @var{bool} is @code{#t}, uve is OR'ed into -@var{bv}; If @var{bool} is @code{#f}, the inversion of uve is -AND'ed into @var{bv}. +@deffn {Scheme Procedure} bit-set*! bitvector uvec bool +@deffnx {C Function} scm_bit_set_star_x (bitvector, uvec, bool) +Set entries of @var{bitvector} to @var{bool}, with @var{uvec} +selecting the entries to change. -If uve is a unsigned long integer vector all the elements of uve -must be between 0 and the @code{length} of @var{bv}. The bits -of @var{bv} corresponding to the indexes in uve are set to -@var{bool}. The return value is unspecified. +If @var{uvec} is a bit vector, then those entries where it has +@code{#t} are the ones in @var{bitvector} which are set to @var{bool}. +When @var{bool} is @code{#t} it's like @var{uvec} is OR'ed into +@var{bitvector}. Or when @var{bool} is @code{#f} it can be seen as an +ANDNOT. + +@example +(define bv #*01000010) +(bit-set*! bv #*10010001 #t) +bv +@result{} #*11010011 +@end example + +If @var{uvec} is a uniform vector of unsigned long integers, then +they're indexes into @var{bitvector} which are set to @var{bool}. + +@example +(define bv #*01000010) +(bit-set*! bv #u(5 2 7) #t) +bv +@result{} #*01100111 +@end example @end deffn -@deffn {Scheme Procedure} bit-count* v kv obj -@deffnx {C Function} scm_bit_count_star (v, kv, obj) -Return -@lisp -(bit-count (bit-set*! (if bool bv (bit-invert! bv)) uve #t) #t). -@end lisp -@var{bv} is not modified. +@deffn {Scheme Procedure} bit-count* bitvector uvec bool +@deffnx {C Function} scm_bit_count_star (bitvector, uvec, bool) +Return a count of how many entries in @var{bitvector} are equal to +@var{bool}, with @var{uvec} selecting the entries to consider. + +@var{uvec} is interpreted in the same way as for @code{bit-set*!} +above. Namely, if @var{uvec} is a bit vector then entries which have +@code{#t} there are considered in @var{bitvector}. Or if @var{uvec} +is a uniform vector of unsigned long integers then it's the indexes in +@var{bitvector} to consider. + +For example, + +@example +(bit-count* #*01110111 #*11001101 #t) @result{} 3 +(bit-count* #*01110111 #u(7 0 4) #f) @result{} 2 +@end example @end deffn From c95243c71c35e97a6acf929ed3549310063befb2 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 9 Jan 2004 00:52:23 +0000 Subject: [PATCH 021/167] *** empty log message *** --- doc/ref/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index f6f0ccce2..1bfdb9069 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2004-01-09 Kevin Ryde + + * scheme-compound.texi (Bit Vectors): Revise for clarity, following + report by Rouben Rostamian. Remove #b() example, that syntax is not + accepted. + 2004-01-07 Marius Vollmer * scheme-control.texi, scheme-io.tex, scheme-scheduling.texi: From 27fca65629299a2aa348bd1218fda1d66596f529 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 10 Jan 2004 21:20:55 +0000 Subject: [PATCH 022/167] Use mktemp to create a truely unique temporary file name. Thanks to Stefan Nordhausen! --- libguile/guile-snarf.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in index f1343aab2..c8b7989cb 100644 --- a/libguile/guile-snarf.in +++ b/libguile/guile-snarf.in @@ -1,7 +1,7 @@ #!/bin/sh # Extract the initialization actions from source files. # -# Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002 Free Software Foundation, Inc. +# Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002, 2004 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 @@ -69,7 +69,7 @@ fi # set vars and handler -- handle CPP override cpp_ok_p=false -temp="/tmp/snarf.$$" +temp=`mktemp -t guile-snarf.XXXXXX` || exit 1 if [ x"$CPP" = x ] ; then cpp="@CPP@" ; else cpp="$CPP" ; fi trap "rm -f $temp" 0 1 2 15 From 5565749c2ee05f446a61f85090d7aa7603f08d5c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 10 Jan 2004 21:22:28 +0000 Subject: [PATCH 023/167] *** empty log message *** --- THANKS | 1 + libguile/ChangeLog | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/THANKS b/THANKS index babdf2fd2..196152e76 100644 --- a/THANKS +++ b/THANKS @@ -41,6 +41,7 @@ For fixes or providing information which led to a fix: Jeff Long Han-Wen Nienhuys Jan Nieuwenhuizen + Stefan Nordhausen Pieter Pareit Jack Pavlovsky Arno Peters diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 9460eac34..57b798560 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2004-01-10 Marius Vollmer + + * guile-snarf.in: Use mktemp to create a truely unique temporary + file name. Thanks to Stefan Nordhausen! + 2004-01-07 Marius Vollmer * dynwind.h, dynwind.c (scm_i_dowinds): Removed 'explicit' From 2370f8090728583da0557181af75014b4533c7e2 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 10 Jan 2004 21:37:59 +0000 Subject: [PATCH 024/167] (Queues): New chapter. --- doc/ref/misc-modules.texi | 108 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 108 insertions(+) diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi index aac4c3a58..d589c3976 100644 --- a/doc/ref/misc-modules.texi +++ b/doc/ref/misc-modules.texi @@ -615,6 +615,114 @@ use @code{throw} or similar to escape. @end defun +@node Queues +@chapter Queues +@cindex Queues +@tindex Queues + +@noindent +The functions in this section are provided by + +@example +(use-modules (ice-9 q)) +@end example + +This module implements queues holding arbitrary scheme objects and +designed for efficient first-in / first-out operations. + +@code{make-q} creates a queue, and objects are entered and removed +with @code{enq!} and @code{deq!}. @code{q-push!} and @code{q-pop!} +can be used too, treating the front of the queue like a stack. + +@sp 1 + +@deffn {Scheme Procedure} make-q +Return a new queue. +@end deffn + +@deffn {Scheme Procedure} q? obj +Return @code{#t} if @var{obj} is a queue, or @code{#f} if not. + +Note that queues are not a distinct class of objects but are +implemented with cons cells. For that reason certain list structures +can get @code{#t} from @code{q?}. +@end deffn + +@deffn {Scheme Procedure} enq! q obj +Add @var{obj} to the rear of @var{q}, and return @var{q}. +@end deffn + +@deffn {Scheme Procedure} deq! q +@deffnx {Scheme Procedure} q-pop! q +Remove and return the front element from @var{q}. If @var{q} is +empty, a @code{q-empty} exception is thrown. + +@code{deq!} and @code{q-pop!} are the same operation, the two names +just let an application match @code{enq!} with @code{deq!}, or +@code{q-push!} with @code{q-pop!}. +@end deffn + +@deffn {Scheme Procedure} q-push! q obj +Add @var{obj} to the front of @var{q}, and return @var{q}. +@end deffn + +@deffn {Scheme Procedure} q-length q +Return the number of elements in @var{q}. +@end deffn + +@deffn {Scheme Procedure} q-empty? q +Return true if @var{q} is empty. +@end deffn + +@deffn {Scheme Procedure} q-empty-check q +Throw a @code{q-empty} exception if @var{q} is empty. +@end deffn + +@deffn {Scheme Procedure} q-front q +Return the first element of @var{q} (without removing it). If @var{q} +is empty, a @code{q-empty} exception is thrown. +@end deffn + +@deffn {Scheme Procedure} q-rear q +Return the last element of @var{q} (without removing it). If @var{q} +is empty, a @code{q-empty} exception is thrown. +@end deffn + +@deffn {Scheme Procedure} q-remove! q obj +Remove all occurences of @var{obj} from @var{q}, and return @var{q}. +@var{obj} is compared to queue elements using @code{eq?}. +@end deffn + +@sp 1 +@cindex @code{q-empty} +The @code{q-empty} exceptions described above are thrown just as +@code{(throw 'q-empty)}, there's no message etc like an error throw. + +A queue is implemented as a cons cell, the @code{car} containing a +list of queued elements, and the @code{cdr} being the last cell in +that list (for ease of enqueuing). + +@example +(@var{list} . @var{last-cell}) +@end example + +@noindent +If the queue is empty, @var{list} is the empty list and +@var{last-cell} is @code{#f}. + +An application can directly access the queue list if desired, for +instance to search the elements or to insert at a specific point. + +@deffn {Scheme Procedure} sync-q! q +Recompute the @var{last-cell} field in @var{q}. + +All the operations above maintain @var{last-cell} as described, so +normally there's no need for @code{sync-q!}. But if an application +modifies the queue @var{list} then it must either maintain +@var{last-cell} similarly, or call @code{sync-q!} to recompute it. +@end deffn + + @c Local Variables: @c TeX-master: "guile.texi" @c End: From 5ad1686a78891ee71b088f5deb3d8ef7fac9eb4b Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 10 Jan 2004 21:40:26 +0000 Subject: [PATCH 025/167] * misc-modules.texi (Queues): New chapter. * guile.texi (Top): Add it. --- doc/ref/guile.texi | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index 96060e614..f148976fd 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -13,7 +13,8 @@ This reference manual documents Guile, GNU's Ubiquitous Intelligent Language for Extensions, manual edition @value{MANUAL-EDITION} corresponding to Guile @value{VERSION}. -Copyright 1996, 1997, 2000, 2001, 2002, 2003 Free Software Foundation. +Copyright 1996, 1997, 2000, 2001, 2002, 2003, 2004 Free Software +Foundation. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -129,7 +130,7 @@ notice identical to this one except for the removal of this paragraph @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.25 2003-11-03 00:53:08 kryde Exp $ +@subtitle $Id: guile.texi,v 1.26 2004-01-10 21:40:26 kryde Exp $ @c AUTHORS @@ -271,6 +272,7 @@ Part V: Guile Modules * Formatted Output:: The @code{format} procedure. * Rx Regexps:: The Rx regular expression library. * File Tree Walk:: Traversing the file system. +* Queues:: First-in first-out queuing. * Expect:: Controlling interactive programs with Guile. * The Scheme shell (scsh):: Using scsh interfaces in Guile. From ff96677fc3470d428bc1342731d6fff4e24df5ea Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 10 Jan 2004 21:43:10 +0000 Subject: [PATCH 026/167] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 1bfdb9069..4044ab632 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2004-01-11 Kevin Ryde + + * misc-modules.texi (Queues): New chapter. + * guile.texi (Top): Add it. + 2004-01-09 Kevin Ryde * scheme-compound.texi (Bit Vectors): Revise for clarity, following From 88ecf5cbd4ea94f6a95994fd676270f06a07bcf3 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 10 Jan 2004 23:18:48 +0000 Subject: [PATCH 027/167] (scm_bit_count, scm_bit_position, s_scm_bit_set_star_x, s_scm_bit_count_star, s_scm_bit_invert_x): Clarify docstrings, as per changes made to scheme-compound.texi. --- libguile/unif.c | 71 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 54 insertions(+), 17 deletions(-) diff --git a/libguile/unif.c b/libguile/unif.c index fd33048fd..ad9881cc0 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1795,9 +1795,15 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, (SCM item, SCM v, SCM k), - "Return the minimum index of an occurrence of @var{bool} in\n" - "@var{bv} which is at least @var{k}. If no @var{bool} occurs\n" - "within the specified range @code{#f} is returned.") + "Return the index of the first occurrance of @var{item} in bit\n" + "vector @var{v}, starting from @var{k}. If there is no\n" + "@var{item} entry between @var{k} and the end of\n" + "@var{bitvector}, then return @code{#f}. For example,\n" + "\n" + "@example\n" + "(bit-position #t #*000101 0) @result{} 3\n" + "(bit-position #f #*0001111 3) @result{} #f\n" + "@end example") #define FUNC_NAME s_scm_bit_position { long i, lenw, xbits, pos; @@ -1858,14 +1864,32 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, (SCM v, SCM kv, SCM obj), - "If uve is a bit-vector @var{bv} and uve must be of the same\n" - "length. If @var{bool} is @code{#t}, uve is OR'ed into\n" - "@var{bv}; If @var{bool} is @code{#f}, the inversion of uve is\n" - "AND'ed into @var{bv}.\n\n" - "If uve is a unsigned long integer vector all the elements of uve\n" - "must be between 0 and the @code{length} of @var{bv}. The bits\n" - "of @var{bv} corresponding to the indexes in uve are set to\n" - "@var{bool}. The return value is unspecified.") + "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n" + "selecting the entries to change. The return value is\n" + "unspecified.\n" + "\n" + "If @var{kv} is a bit vector, then those entries where it has\n" + "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n" + "@var{kv} and @var{v} must be the same length. When @var{obj}\n" + "is @code{#t} it's like @var{kv} is OR'ed into @var{v}. Or when\n" + "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n" + "\n" + "@example\n" + "(define bv #*01000010)\n" + "(bit-set*! bv #*10010001 #t)\n" + "bv\n" + "@result{} #*11010011\n" + "@end example\n" + "\n" + "If @var{kv} is a uniform vector of unsigned long integers, then\n" + "they're indexes into @var{v} which are set to @var{obj}.\n" + "\n" + "@example\n" + "(define bv #*01000010)\n" + "(bit-set*! bv #u(5 2 7) #t)\n" + "bv\n" + "@result{} #*01100111\n" + "@end example") #define FUNC_NAME s_scm_bit_set_star_x { register long i, k, vlen; @@ -1915,11 +1939,23 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, (SCM v, SCM kv, SCM obj), - "Return\n" - "@lisp\n" - "(bit-count (bit-set*! (if bool bv (bit-invert! bv)) uve #t) #t).\n" - "@end lisp\n" - "@var{bv} is not modified.") + "Return a count of how many entries in bit vector @var{v} are\n" + "equal to @var{obj}, with @var{kv} selecting the entries to\n" + "consider.\n" + "\n" + "If @var{kv} is a bit vector, then those entries where it has\n" + "@code{#t} are the ones in @var{v} which are considered.\n" + "@var{kv} and @var{v} must be the same length.\n" + "\n" + "If @var{kv} is a uniform vector of unsigned long integers, then\n" + "it's the indexes in @var{v} to consider.\n" + "\n" + "For example,\n" + "\n" + "@example\n" + "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n" + "(bit-count* #*01110111 #u(7 0 4) #f) @result{} 2\n" + "@end example") #define FUNC_NAME s_scm_bit_count_star { register long i, vlen, count = 0; @@ -1983,7 +2019,8 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, (SCM v), - "Modify @var{bv} by replacing each element with its negation.") + "Modify the bit vector @var{v} by replacing each element with\n" + "its negation.") #define FUNC_NAME s_scm_bit_invert_x { long int k; From 08568c953b69c82e68abc6272db9634a77ee385b Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 10 Jan 2004 23:20:10 +0000 Subject: [PATCH 028/167] *** empty log message *** --- libguile/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 57b798560..6bf21bf2b 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2004-01-11 Kevin Ryde + + * unif.c (scm_bit_count, scm_bit_position, s_scm_bit_set_star_x, + s_scm_bit_count_star, s_scm_bit_invert_x): Clarify docstrings, as per + changes made to scheme-compound.texi. + 2004-01-10 Marius Vollmer * guile-snarf.in: Use mktemp to create a truely unique temporary From d9623da1f2687d4a25cc5229c46ca5cf226a76ff Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 10 Jan 2004 23:30:23 +0000 Subject: [PATCH 029/167] Instead of the non-portable mktemp, use mkdir to create a unique temporary directory that we can safely use. Thanks to Stefan Nordhausen! --- libguile/guile-snarf.in | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in index c8b7989cb..f6977cac2 100644 --- a/libguile/guile-snarf.in +++ b/libguile/guile-snarf.in @@ -69,10 +69,12 @@ fi # set vars and handler -- handle CPP override cpp_ok_p=false -temp=`mktemp -t guile-snarf.XXXXXX` || exit 1 +tempdir="/tmp/snarf.$$" +(umask 077 && mkdir $tempdir) || exit 1 +temp="$tempdir/tmp" if [ x"$CPP" = x ] ; then cpp="@CPP@" ; else cpp="$CPP" ; fi -trap "rm -f $temp" 0 1 2 15 +trap "rm -rf $tempdir" 0 1 2 15 if [ ! "$outfile" = "-" ] ; then modern_snarf "$@" > $outfile From 2de97f05f0411ddc0b738db5748beee031762479 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 11 Jan 2004 00:01:48 +0000 Subject: [PATCH 030/167] Revert this, it breaks test-suite/tests/r5rs_pitfalls.test where false-if-exception is used within syntax-rules. (Suspect syntax-rules ought to support this sort of thing, but it doesn't right now.) * boot-9.scm (false-if-exception): Unquote catch and lambda, so as not to depend on expansion environment. --- 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 0cc341a19..e82726a8b 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -3330,8 +3330,8 @@ signals old-handlers)))))) (defmacro false-if-exception (expr) - `(,catch #t (,lambda () ,expr) - (,lambda args #f))) + `(catch #t (lambda () ,expr) + (lambda args #f))) ;;; This hook is run at the very end of an interactive session. ;;; From 9afa7a12f20c413b702f3e792dc2bde149c3718d Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 11 Jan 2004 00:03:33 +0000 Subject: [PATCH 031/167] *** empty log message *** --- ice-9/ChangeLog | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index aa315d334..1da6aafc5 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,12 @@ +2004-01-11 Kevin Ryde + + Revert this, it breaks test-suite/tests/r5rs_pitfalls.test where + false-if-exception is used within syntax-rules. (Suspect syntax-rules + ought to support this sort of thing, but it doesn't right now.) + + * boot-9.scm (false-if-exception): Unquote catch and lambda, so as not + to depend on expansion environment. + 2004-01-07 Marius Vollmer * boot-9.scm (with-fluids): Use with-fluid* when only one fluid is From 8081c3fb51b70c623c728a4ebf5d23ee735d3a1f Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 11 Jan 2004 00:18:25 +0000 Subject: [PATCH 032/167] * tests/exceptions.test (false-if-exception): Disable tests on referencing expansion environment, reverted. --- test-suite/tests/exceptions.test | 35 +++++++++++++++++--------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/test-suite/tests/exceptions.test b/test-suite/tests/exceptions.test index 05f464563..aedd53617 100644 --- a/test-suite/tests/exceptions.test +++ b/test-suite/tests/exceptions.test @@ -63,22 +63,25 @@ (lambda (x y . rest) #f))))) (with-test-prefix "false-if-exception" - + (pass-if (false-if-exception #t)) (pass-if (not (false-if-exception #f))) (pass-if (not (false-if-exception (error "xxx")))) - - (with-test-prefix "in empty environment" - ;; an environment with no bindings at all - (define empty-environment - (make-module 1)) - - (pass-if "#t" - (eval `(,false-if-exception #t) - empty-environment)) - (pass-if "#f" - (not (eval `(,false-if-exception #f) - empty-environment))) - (pass-if "exception" - (not (eval `(,false-if-exception (,error "xxx")) - empty-environment))))) + + ;; Not yet working. + ;; + ;; (with-test-prefix "in empty environment" + ;; ;; an environment with no bindings at all + ;; (define empty-environment + ;; (make-module 1)) + ;; + ;; (pass-if "#t" + ;; (eval `(,false-if-exception #t) + ;; empty-environment)) + ;; (pass-if "#f" + ;; (not (eval `(,false-if-exception #f) + ;; empty-environment))) + ;; (pass-if "exception" + ;; (not (eval `(,false-if-exception (,error "xxx")) + ;; empty-environment)))) + ) From 700ffd55e6cec2dd5dc33b8e04651bd31fb0b04b Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 11 Jan 2004 00:26:41 +0000 Subject: [PATCH 033/167] (system): New function, giving an exit code return in accordance with slib spec. --- ice-9/slib.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/ice-9/slib.scm b/ice-9/slib.scm index 55430068b..423653c75 100644 --- a/ice-9/slib.scm +++ b/ice-9/slib.scm @@ -246,6 +246,25 @@ (define >? >) (define >=? >=) +;;; {system} +;;; + +;; If the program run is killed by a signal, the shell normally gives an +;; exit code of 128+signum. If the shell itself is killed by a signal then +;; we do the same 128+signum here. +;; +;; "stop-sig" shouldn't arise here, since system shouldn't be calling +;; waitpid with WUNTRACED, but allow for it anyway, just in case. +;; +(if (defined? 'system) + (define-public system + (let ((guile-core-system system)) + (lambda (str) + (let ((st (guile-core-system str))) + (or (status:exit-val st) + (+ 128 (or (status:term-sig st) + (status:stop-sig st))))))))) + ;;; {Time} ;;; From 7dd5eb5898a81ce79ac3b67c349481911fd6e067 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 11 Jan 2004 00:28:08 +0000 Subject: [PATCH 034/167] *** empty log message *** --- ice-9/ChangeLog | 4 +++- test-suite/ChangeLog | 5 +++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 1da6aafc5..68ca2daf9 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,9 +1,11 @@ 2004-01-11 Kevin Ryde + * slib.scm (system): New function, giving an exit code return in + accordance with slib spec. + Revert this, it breaks test-suite/tests/r5rs_pitfalls.test where false-if-exception is used within syntax-rules. (Suspect syntax-rules ought to support this sort of thing, but it doesn't right now.) - * boot-9.scm (false-if-exception): Unquote catch and lambda, so as not to depend on expansion environment. diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 659ffe13d..86f09f077 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2004-01-11 Kevin Ryde + + * tests/exceptions.test (false-if-exception): Disable tests on + referencing expansion environment, reverted. + 2004-01-07 Marius Vollmer * standalone/test-unwind.c: Adapted to 'frame' renamings. From 327967ef26cbebc2611c4d49bbbb100378d3b1ff Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 11 Jan 2004 00:40:54 +0000 Subject: [PATCH 035/167] (scm_print_symbol_name): Handle #{`foo}#, #{,foo}#, #{.}#, and all numeric strings specially. Thanks to Paul Jarc! --- libguile/print.c | 26 ++++++++------------------ 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/libguile/print.c b/libguile/print.c index 6f8545dd6..200aafabe 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -39,6 +39,7 @@ #include "libguile/strports.h" #include "libguile/vectors.h" #include "libguile/lang.h" +#include "libguile/numbers.h" #include "libguile/validate.h" #include "libguile/print.h" @@ -315,16 +316,16 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) * weird because of other characters, backslahes need to be escaped too. * The first time we see a backslash, we set maybe_weird, and mw_pos points * to the backslash. Then if the name turns out to be weird, we re-process - * everything starting from mw_pos. */ + * everything starting from mw_pos. + * We could instead make backslashes always weird. This is not necessary + * to ensure that the output is (read)-able, but it would make this code + * simpler and faster. */ int maybe_weird = 0; size_t mw_pos = 0; - /* If the name is purely numeric, then it's weird as a whole, even though - * none of the individual characters is weird. But we won't know this - * until we reach the end of the name. This flag describes the part of the - * name we've looked at so far. */ - int all_digits = 1; - if (len == 0 || str[0] == '\'' || str[0] == ':' || str[len-1] == ':') + if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ',' || + str[0] == ':' || str[len-1] == ':' || (str[0] == '.' && len == 1) || + !SCM_FALSEP (scm_i_mem2number(str, len, 10))) { scm_lfwrite ("#{", 2, port); weird = 1; @@ -344,7 +345,6 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) case '#': case SCM_WHITE_SPACES: case SCM_LINE_INCREMENTORS: - all_digits = 0; weird_handler: if (maybe_weird) { @@ -367,7 +367,6 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) pos = end + 1; break; case '\\': - all_digits = 0; if (weird) goto weird_handler; if (!maybe_weird) @@ -376,18 +375,9 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) mw_pos = pos; } break; - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - break; default: - all_digits = 0; break; } - if (all_digits) - { - scm_lfwrite ("#{", 2, port); - weird = 1; - } if (pos < end) scm_lfwrite (str + pos, end - pos, port); if (weird) From 16c5cac25aa125128e123cae34865613e95e2938 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 11 Jan 2004 00:51:19 +0000 Subject: [PATCH 036/167] (scm_frame_unwind, scm_frame_unwind_handler): Renamed and changed all uses. (scm_frame_rewind, scm_frame_rewind_handler): Likewise. --- libguile/async.c | 8 ++++---- libguile/dynwind.c | 20 ++++++++++---------- libguile/dynwind.h | 16 ++++++++-------- libguile/fluids.c | 12 +++++++----- libguile/ports.c | 6 ++++-- 5 files changed, 33 insertions(+), 29 deletions(-) diff --git a/libguile/async.c b/libguile/async.c index b4b8eb4e6..34165fe11 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -367,8 +367,8 @@ scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data) void scm_frame_block_asyncs () { - scm_frame_rewind (increase_block, NULL, SCM_F_WIND_EXPLICITLY); - scm_frame_unwind (decrease_block, NULL, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind_handler (increase_block, NULL, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler (decrease_block, NULL, SCM_F_WIND_EXPLICITLY); } void @@ -377,8 +377,8 @@ scm_frame_unblock_asyncs () if (scm_root->block_asyncs == 0) scm_misc_error ("scm_with_unblocked_asyncs", "asyncs already unblocked", SCM_EOL); - scm_frame_rewind (decrease_block, NULL, SCM_F_WIND_EXPLICITLY); - scm_frame_unwind (increase_block, NULL, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind_handler (decrease_block, NULL, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler (increase_block, NULL, SCM_F_WIND_EXPLICITLY); } diff --git a/libguile/dynwind.c b/libguile/dynwind.c index ca2fb704d..28dbb0d45 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -120,8 +120,8 @@ scm_internal_dynamic_wind (scm_t_guard before, SCM ans; scm_frame_begin (SCM_F_FRAME_REWINDABLE); - scm_frame_rewind (before, guard_data, SCM_F_WIND_EXPLICITLY); - scm_frame_unwind (after, guard_data, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind_handler (before, guard_data, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler (after, guard_data, SCM_F_WIND_EXPLICITLY); ans = inner (inner_data); scm_frame_end (); return ans; @@ -188,8 +188,8 @@ winder_mark (SCM w) } void -scm_frame_unwind (void (*proc) (void *), void *data, - scm_t_wind_flags flags) +scm_frame_unwind_handler (void (*proc) (void *), void *data, + scm_t_wind_flags flags) { SCM w; scm_t_bits fl = ((flags&SCM_F_WIND_EXPLICITLY)? WINDER_F_EXPLICIT : 0); @@ -199,8 +199,8 @@ scm_frame_unwind (void (*proc) (void *), void *data, } void -scm_frame_rewind (void (*proc) (void *), void *data, - scm_t_wind_flags flags) +scm_frame_rewind_handler (void (*proc) (void *), void *data, + scm_t_wind_flags flags) { SCM w; SCM_NEWSMOB2 (w, tc16_winder | WINDER_F_REWIND, @@ -211,8 +211,8 @@ scm_frame_rewind (void (*proc) (void *), void *data, } void -scm_frame_unwind_with_scm (void (*proc) (SCM), SCM data, - scm_t_wind_flags flags) +scm_frame_unwind_handler_with_scm (void (*proc) (SCM), SCM data, + scm_t_wind_flags flags) { SCM w; scm_t_bits fl = ((flags&SCM_F_WIND_EXPLICITLY)? WINDER_F_EXPLICIT : 0); @@ -222,8 +222,8 @@ scm_frame_unwind_with_scm (void (*proc) (SCM), SCM data, } void -scm_frame_rewind_with_scm (void (*proc) (SCM), SCM data, - scm_t_wind_flags flags) +scm_frame_rewind_handler_with_scm (void (*proc) (SCM), SCM data, + scm_t_wind_flags flags) { SCM w; SCM_NEWSMOB2 (w, tc16_winder | WINDER_F_REWIND | WINDER_F_MARK, diff --git a/libguile/dynwind.h b/libguile/dynwind.h index f619b46b5..ce68bcd64 100644 --- a/libguile/dynwind.h +++ b/libguile/dynwind.h @@ -53,15 +53,15 @@ typedef enum { SCM_API void scm_frame_begin (scm_t_frame_flags); SCM_API void scm_frame_end (void); -SCM_API void scm_frame_unwind (void (*func) (void *), void *data, - scm_t_wind_flags); -SCM_API void scm_frame_rewind (void (*func) (void *), void *data, - scm_t_wind_flags); +SCM_API void scm_frame_unwind_handler (void (*func) (void *), void *data, + scm_t_wind_flags); +SCM_API void scm_frame_rewind_handler (void (*func) (void *), void *data, + scm_t_wind_flags); -SCM_API void scm_frame_unwind_with_scm (void (*func) (SCM), SCM data, - scm_t_wind_flags); -SCM_API void scm_frame_rewind_with_scm (void (*func) (SCM), SCM data, - scm_t_wind_flags); +SCM_API void scm_frame_unwind_handler_with_scm (void (*func) (SCM), SCM data, + scm_t_wind_flags); +SCM_API void scm_frame_rewind_handler_with_scm (void (*func) (SCM), SCM data, + scm_t_wind_flags); #ifdef GUILE_DEBUG SCM_API SCM scm_wind_chain (void); diff --git a/libguile/fluids.c b/libguile/fluids.c index 3f5591759..6cae477cc 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996,1997,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,2000,2001, 2004 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 @@ -229,8 +229,10 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata) data = scm_cons (fluids, values); scm_frame_begin (SCM_F_FRAME_REWINDABLE); - scm_frame_rewind_with_scm (swap_fluids, data, SCM_F_WIND_EXPLICITLY); - scm_frame_unwind_with_scm (swap_fluids_reverse, data, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind_handler_with_scm (swap_fluids, data, + SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler_with_scm (swap_fluids_reverse, data, + SCM_F_WIND_EXPLICITLY); ans = cproc (cdata); scm_frame_end (); return ans; @@ -275,8 +277,8 @@ void scm_frame_fluid (SCM fluid, SCM value) { SCM data = scm_cons (fluid, value); - scm_frame_rewind_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY); - scm_frame_unwind_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind_handler_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler_with_scm (swap_fluid, data, SCM_F_WIND_EXPLICITLY); } void diff --git a/libguile/ports.c b/libguile/ports.c index 45085e887..6e1446610 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -453,8 +453,10 @@ scm_frame_current_foo_port (SCM port, data->getter = getter; data->setter = setter; - scm_frame_rewind_with_scm (swap_port, scm_data, SCM_F_WIND_EXPLICITLY); - scm_frame_unwind_with_scm (swap_port, scm_data, SCM_F_WIND_EXPLICITLY); + scm_frame_rewind_handler_with_scm (swap_port, scm_data, + SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler_with_scm (swap_port, scm_data, + SCM_F_WIND_EXPLICITLY); } void From f1da8e4e0ba3a7226f515cb30349625049b4b120 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 11 Jan 2004 00:56:05 +0000 Subject: [PATCH 037/167] Renamed scm_frame_unwind to scm_frame_unwind_handler, and scm_frame_rewind to scm_frame_rewind_handler. --- NEWS | 8 ++++---- doc/ref/scheme-control.texi | 24 ++++++++++++------------ test-suite/standalone/test-unwind.c | 16 +++++++++------- 3 files changed, 25 insertions(+), 23 deletions(-) diff --git a/NEWS b/NEWS index 8982fd195..a2e8a1e13 100644 --- a/NEWS +++ b/NEWS @@ -593,11 +593,11 @@ prevent a potential memory leak: scm_frame_begin (0); mem = scm_malloc (100); - scm_frame_unwind (free, mem, SCM_F_WIND_EXPLICITELY); + scm_frame_unwind_handler (free, mem, SCM_F_WIND_EXPLICITELY); + + /* MEM would leak if BAR throws an error. + SCM_FRAME_UNWIND_HANDLER frees it nevertheless. */ - /* MEM would leak if BAR throws an error. SCM_FRAME_UNWIND frees it - nevertheless. - */ bar (); scm_frame_end (); diff --git a/doc/ref/scheme-control.texi b/doc/ref/scheme-control.texi index 36918373d..902010e6f 100644 --- a/doc/ref/scheme-control.texi +++ b/doc/ref/scheme-control.texi @@ -1167,10 +1167,10 @@ scm_foo (SCM s1, SCM s2) scm_frame_begin (0); c_s1 = scm_to_string (s1); - scm_frame_unwind (free, c_s1, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler (free, c_s1, SCM_F_WIND_EXPLICITLY); c_s2 = scm_to_string (s2); - scm_frame_unwind (free, c_s2, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler (free, c_s2, SCM_F_WIND_EXPLICITLY); c_res = foo (c_s1, c_s2); if (c_res == NULL) @@ -1226,8 +1226,8 @@ End the current frame explicitly and make the previous frame current. @deftp {C Type} scm_t_wind_flags This is an enumeration of several flags that modify the behavior of -@code{scm_on_unwind} and @code{scm_on_rewind}. The flags are listed in -the following table. +@code{scm_on_unwind_handler} and @code{scm_on_rewind_handler}. The +flags are listed in the following table. @table @code @item SCM_F_WIND_EXPLICITLY @@ -1236,26 +1236,26 @@ left locally. @end table @end deftp -@deftypefn {C Function} void scm_frame_unwind (void (*func)(void *), void *data, scm_t_wind_flags flags) -@deftypefnx {C Function} void scm_frame_unwind_with_scm (void (*func)(SCM), SCM data, scm_t_wind_flags flags) +@deftypefn {C Function} void scm_frame_unwind_handler (void (*func)(void *), void *data, scm_t_wind_flags flags) +@deftypefnx {C Function} void scm_frame_unwind_handler_with_scm (void (*func)(SCM), SCM data, scm_t_wind_flags flags) Arranges for @var{func} to be called with @var{data} as its arguments when the current frame ends implicitly. If @var{flags} contains @code{SCM_F_WIND_EXPLICITLY}, @var{func} is also called when the frame ends explicitly with @code{scm_frame_end}. -The function @code{scm_frame_unwind_with_scm} takes care that @var{data} -is protected from garbage collection. +The function @code{scm_frame_unwind_handler_with_scm} takes care that +@var{data} is protected from garbage collection. @end deftypefn -@deftypefn {C Function} void scm_frame_rewind (void (*func)(void *), void *data, scm_t_wind_flags flags) -@deftypefnx {C Function} void scm_frame_rewind_with_scm (void (*func)(SCM), SCM data, scm_t_wind_flags flags) +@deftypefn {C Function} void scm_frame_rewind_handler (void (*func)(void *), void *data, scm_t_wind_flags flags) +@deftypefnx {C Function} void scm_frame_rewind_handler_with_scm (void (*func)(SCM), SCM data, scm_t_wind_flags flags) Arrange for @var{func} to be called with @var{data} as its argument when the current frame is restarted by rewinding the stack. When @var{flags} contains @code{SCM_F_WIND_EXPLICITLY}, @var{func} is called immediately as well. -The function @code{scm_frame_rewind_with_scm} takes care that @var{data} -is protected from garbage collection. +The function @code{scm_frame_rewind_handler_with_scm} takes care that +@var{data} is protected from garbage collection. @end deftypefn diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c index 4e107a92f..44fbe4715 100644 --- a/test-suite/standalone/test-unwind.c +++ b/test-suite/standalone/test-unwind.c @@ -35,7 +35,7 @@ func1 () { scm_frame_begin (0); flag1 = 0; - scm_frame_unwind (set_flag, &flag1, 0); + scm_frame_unwind_handler (set_flag, &flag1, 0); scm_frame_end (); } @@ -47,7 +47,7 @@ func2 () { scm_frame_begin (0); flag1 = 0; - scm_frame_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); scm_frame_end (); } @@ -59,7 +59,7 @@ func3 () { scm_frame_begin (0); flag1 = 0; - scm_frame_unwind (set_flag, &flag1, 0); + scm_frame_unwind_handler (set_flag, &flag1, 0); scm_misc_error ("func3", "gratuitous error", SCM_EOL); scm_frame_end (); } @@ -72,7 +72,7 @@ func4 () { scm_frame_begin (0); flag1 = 0; - scm_frame_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); scm_misc_error ("func4", "gratuitous error", SCM_EOL); scm_frame_end (); } @@ -179,7 +179,8 @@ check_ports () { SCM port = scm_open_file (scm_str2string (filename), scm_str2string ("w")); - scm_frame_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler_with_scm (close_port, port, + SCM_F_WIND_EXPLICITLY); scm_frame_current_output_port (port); scm_write (scm_version (), SCM_UNDEFINED); @@ -191,8 +192,9 @@ check_ports () SCM port = scm_open_file (scm_str2string (filename), scm_str2string ("r")); SCM res; - scm_frame_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY); - scm_frame_unwind (delete_file, filename, SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler_with_scm (close_port, port, + SCM_F_WIND_EXPLICITLY); + scm_frame_unwind_handler (delete_file, filename, SCM_F_WIND_EXPLICITLY); scm_frame_current_input_port (port); res = scm_read (SCM_UNDEFINED); From c18140cf6e4f28a6dfa4deebe80c8fab8e262bf6 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 11 Jan 2004 00:58:38 +0000 Subject: [PATCH 038/167] * tests/r5rs_pitfall.scm: New. * Makefile.am (SCM_TESTS): Added it. --- test-suite/Makefile.am | 1 + test-suite/tests/r5rs_pitfall.scm | 0 2 files changed, 1 insertion(+) create mode 100644 test-suite/tests/r5rs_pitfall.scm diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index fa69702f3..241f66d0b 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -51,6 +51,7 @@ SCM_TESTS = tests/alist.test \ tests/posix.test \ tests/q.test \ tests/r4rs.test \ + tests/r5rs_pitfall.test \ tests/reader.test \ tests/regexp.test \ tests/srcprop.test \ diff --git a/test-suite/tests/r5rs_pitfall.scm b/test-suite/tests/r5rs_pitfall.scm new file mode 100644 index 000000000..e69de29bb From 25ffbdacbd86b4d51ffc25ad5deae3b113918b56 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sun, 11 Jan 2004 00:59:04 +0000 Subject: [PATCH 039/167] *** empty log message *** --- libguile/ChangeLog | 13 +++++++++++-- test-suite/ChangeLog | 5 +++++ 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 6bf21bf2b..2e05e472d 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2004-01-11 Marius Vollmer + + * dynwind.h, dynwind.c (scm_frame_unwind, + scm_frame_unwind_handler): Renamed and changed all uses. + (scm_frame_rewind, scm_frame_rewind_handler): Likewise. + 2004-01-11 Kevin Ryde * unif.c (scm_bit_count, scm_bit_position, s_scm_bit_set_star_x, @@ -6,8 +12,11 @@ 2004-01-10 Marius Vollmer - * guile-snarf.in: Use mktemp to create a truely unique temporary - file name. Thanks to Stefan Nordhausen! + * print.c (scm_print_symbol_name): Handle #{`foo}#, #{,foo}#, + #{.}#, and all numeric strings specially. Thanks to Paul Jarc! + + * guile-snarf.in: Use mkdir to create a unique temporary directory + that we can safely use. Thanks to Stefan Nordhausen! 2004-01-07 Marius Vollmer diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 86f09f077..2595e5760 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2004-01-11 Marius Vollmer + + * tests/r5rs_pitfall.scm: New. + * Makefile.am (SCM_TESTS): Added it. + 2004-01-11 Kevin Ryde * tests/exceptions.test (false-if-exception): Disable tests on From ffa04c1b099ccf686758760227fd3c99fe34fde3 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 12 Jan 2004 17:19:21 +0000 Subject: [PATCH 040/167] Use '#:' prefix for keywords instead of ':'. Thanks to Richard Todd! --- ice-9/mapping.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ice-9/mapping.scm b/ice-9/mapping.scm index 8abb5f46b..4cdcffd55 100644 --- a/ice-9/mapping.scm +++ b/ice-9/mapping.scm @@ -102,8 +102,8 @@ (define (hash-table-mapping . options) (let* ((size (or (and options (number? (car options)) (car options)) 71)) - (hash-proc (or (kw-arg-ref options :hash-proc) hash)) - (assoc-proc (or (kw-arg-ref options :assoc-proc) + (hash-proc (or (kw-arg-ref options #:hash-proc) hash)) + (assoc-proc (or (kw-arg-ref options #:assoc-proc) (cond ((eq? hash-proc hash) assoc) ((eq? hash-proc hashv) assv) @@ -111,7 +111,7 @@ (else (error 'hash-table-mapping "Hash-procedure specified with no known assoc function." hash-proc))))) - (delete-proc (or (kw-arg-ref options :delete-proc) + (delete-proc (or (kw-arg-ref options #:delete-proc) (cond ((eq? hash-proc hash) delete!) ((eq? hash-proc hashv) delv!) @@ -119,7 +119,7 @@ (else (error 'hash-table-mapping "Hash-procedure specified with no known delete function." hash-proc))))) - (table-constructor (or (kw-arg-ref options :table-constructor) + (table-constructor (or (kw-arg-ref options #:table-constructor) (lambda (len) (make-vector len '()))))) (make-hash-table-mapping (table-constructor size) hash-proc From 1dd2599f862a1df47682ff2162198afddbacc54a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 12 Jan 2004 17:20:43 +0000 Subject: [PATCH 041/167] *** empty log message *** --- ice-9/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 68ca2daf9..aa9840692 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2004-01-12 Marius Vollmer + + * mapping.scm: Use '#:' prefix for keywords instead of ':'. + Thanks to Richard Todd! + 2004-01-11 Kevin Ryde * slib.scm (system): New function, giving an exit code return in From 3a43b605b8275eaab3e563a5c10e8f62f648912a Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 12 Jan 2004 17:28:30 +0000 Subject: [PATCH 042/167] (compute-get-n-set): Use '#:' in error message instead of ':'. Thanks to Richard Todd! --- oop/goops.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/oop/goops.scm b/oop/goops.scm index ebeac4c6f..6c11acab6 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -1431,7 +1431,7 @@ (set (get-keyword #:slot-set! (slot-definition-options s) #f)) (env (class-environment class))) (if (not (and get set)) - (goops-error "You must supply a :slot-ref and a :slot-set! in ~S" + (goops-error "You must supply a #:slot-ref and a #:slot-set! in ~S" s)) (list get set))) (else (next-method)))) From f9825394b550ffe2ef2f1042f64a81b463c1229d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 12 Jan 2004 17:28:46 +0000 Subject: [PATCH 043/167] *** empty log message *** --- THANKS | 1 + oop/ChangeLog | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/THANKS b/THANKS index 196152e76..d4edecff6 100644 --- a/THANKS +++ b/THANKS @@ -51,6 +51,7 @@ For fixes or providing information which led to a fix: Andreas Rottmann Kevin Ryde Bill Schottstaedt + Richard Todd Greg Troxel Momchil Velikov Panagiotis Vossos diff --git a/oop/ChangeLog b/oop/ChangeLog index a8d6a7a0d..d79e625be 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,8 @@ +2004-01-12 Marius Vollmer + + * goops.scm (compute-get-n-set): Use '#:' in error message instead + of ':'. Thanks to Richard Todd! + 2003-04-20 Mikael Djurfeldt * goops.scm (compute-getters-n-setters): Allow for primitive From de5eb61998591242188b94b12325f318d69123f5 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 20 Jan 2004 00:30:13 +0000 Subject: [PATCH 044/167] (SLIB): Note `system' redefined by (ice-9 slib). Tweak `require' example. --- doc/ref/slib.texi | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/doc/ref/slib.texi b/doc/ref/slib.texi index 83adca154..6e661f006 100644 --- a/doc/ref/slib.texi +++ b/doc/ref/slib.texi @@ -11,16 +11,20 @@ must be executed: @end smalllisp @cindex @code{require} -@code{require} can then be used as described in -@ref{Top, , SLIB, slib, The SLIB Manual}. +@code{require} can then be used in the usual way (@pxref{Requesting +Features,,, slib, The SLIB Manual}). For example, -For example: +@example +(use-modules (ice-9 slib)) +(require 'primes) +(probably-prime? 13) +@result{} #t +@end example -@smalllisp -guile> (use-modules (ice-9 slib)) -guile> (require 'primes) -guile> (probably-prime? 13) -@end smalllisp +Note that @code{(ice-9 slib)} provides a new definition of +@code{system}, one giving a plain exit code return value, as per the +SLIB specification (@pxref{System Interface,,, slib, The SLIB +Manual}). @menu * SLIB installation:: From 8212ef316be479ca2d74a1ca9b3b276fc6fc5ed8 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 20 Jan 2004 00:32:46 +0000 Subject: [PATCH 045/167] (Higher level thread procedures): In monitor, don't let "newly created" suggest a mutex created on every evaluation. Note what "monitor" means. --- doc/ref/scheme-scheduling.texi | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/doc/ref/scheme-scheduling.texi b/doc/ref/scheme-scheduling.texi index e156d1bfc..74c138c88 100644 --- a/doc/ref/scheme-scheduling.texi +++ b/doc/ref/scheme-scheduling.texi @@ -438,9 +438,16 @@ Lock mutex @var{m}, evaluate @var{body}, and then unlock @var{m}. These sub-operations form the branches of a @code{dynamic-wind}. @end deffn -@deffn macro monitor first [rest@dots{}] -Evaluate forms @var{first} and @var{rest} under a newly created -anonymous mutex, using @code{with-mutex}. +@deffn macro monitor body@dots{} +Evaluate @var{body}, with a mutex locked so only one thread can +execute that code at any one time. Each @code{monitor} form has its +own private mutex and the locking is done as per @code{with-mutex} +above. The return value is the return from the last form in +@var{body}. + +The term ``monitor'' comes from operating system theory, where it +means a particular bit of code managing access to some resource and +which only ever executes on behalf of one process at any one time. @end deffn @node C level thread interface From e9b91f8e731bbc0c90dec059c6a4f5af84175fae Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 20 Jan 2004 00:45:42 +0000 Subject: [PATCH 046/167] (Guile License): Note readline is GPL and manual has its own copying terms. Describe briefly what the licenses mean in practice. --- doc/ref/preface.texi | 39 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) diff --git a/doc/ref/preface.texi b/doc/ref/preface.texi index 357df45a9..070208fef 100644 --- a/doc/ref/preface.texi +++ b/doc/ref/preface.texi @@ -20,9 +20,46 @@ corresponds to Guile version @value{VERSION}. @chapter The Guile License @end ifnottex -The license of Guile is the GNU Lesser General Public License. See +Guile is Free Software. Guile is copyrighted, not public domain, and +there are restrictions on its distribution or redistribution, but +these restrictions are designed to permit everything a cooperating +person would want to do. + +@itemize @bullet +@item +The Guile library (libguile) and supporting files are published under +the terms of the GNU Lesser General Public License version 2.1. See the file @file{COPYING.LIB}. +@item +The Guile readline module is published under the terms of the GNU +General Public License version 2. See the file @file{COPYING}. + +@item +The manual you're now reading is published under terms described +@iftex +at the start of the document. +@end iftex +@ifnottex +at the start of the document (@pxref{Top}). +@end ifnottex +@end itemize + +C code linking to the Guile library is subject to terms of that +library. Basically such code may be published on any terms, provided +users can re-link against a new or modified version of Guile. + +C code linking to the Guile readline module is subject to the terms of +that module. Basically such code must be published on Free terms. + +Scheme level code written to be run by Guile (but not derived from +Guile itself) is not resticted in any way, and may be published on any +terms. We encourage authors to publish on Free terms. + +You must be aware there is no warranty whatsoever for Guile. This is +described in full in the licenses. + + @iftex @section Layout of this Manual @end iftex From 165e14cfab897fad04b2a9fde2d3a23acd522517 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 20 Jan 2004 00:47:20 +0000 Subject: [PATCH 047/167] *** empty log message *** --- doc/ref/ChangeLog | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 4044ab632..eda1f0992 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,16 @@ +2004-01-20 Kevin Ryde + + * preface.texi (Guile License): Note readline is GPL and manual has + its own copying terms. Describe briefly what the licenses mean in + practice. + + * scheme-scheduling.texi (Higher level thread procedures): In monitor, + don't let "newly created" suggest a mutex created on every evaluation. + Note what "monitor" means. + + * slib.texi (SLIB): Note `system' redefined by (ice-9 slib). Tweak + `require' example. + 2004-01-11 Kevin Ryde * misc-modules.texi (Queues): New chapter. From 5c963b6eb8aa6f4c7c68ae9caaa7480f6c9b4475 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 20 Jan 2004 22:05:44 +0000 Subject: [PATCH 048/167] Add GDS doc --- emacs/ChangeLog | 6 ++++++ emacs/Makefile.am | 7 +++++++ emacs/gds.texi | 0 3 files changed, 13 insertions(+) create mode 100644 emacs/gds.texi diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 9930c7881..75b391993 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,9 @@ +2003-12-06 Neil Jerram + + * gds.texi: New. + + * Makefile.am (info_TEXINFOS): Added. + 2003-11-27 Neil Jerram Initial support for setting source breakpoints... diff --git a/emacs/Makefile.am b/emacs/Makefile.am index e281ff03c..981414f3f 100644 --- a/emacs/Makefile.am +++ b/emacs/Makefile.am @@ -25,7 +25,14 @@ subpkgdatadir = $(pkgdatadir)/${GUILE_EFFECTIVE_VERSION}/emacs subpkgdata_DATA = gds-client.scm gds-server.scm lisp_LISP = gds.el + +# Suppress byte compilation for now, but only because I haven't tested +# it yet, so have no idea whether a byte compiled version would work. ELCFILES = +info_TEXINFOS = gds.texi + +TEXINFO_TEX = ../doc/ref/texinfo.tex + ETAGS_ARGS = $(subpkgdata_DATA) $(lisp_LISP) EXTRA_DIST = $(subpkgdata_DATA) $(lisp_LISP) diff --git a/emacs/gds.texi b/emacs/gds.texi new file mode 100644 index 000000000..e69de29bb From a6ab1debafe33d895bf6f859f116142eecc02961 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 20 Jan 2004 22:09:32 +0000 Subject: [PATCH 049/167] Implement eval threads. --- emacs/ChangeLog | 5 + emacs/gds-client.scm | 489 ++++++++++++++++++++++++++++--------------- 2 files changed, 328 insertions(+), 166 deletions(-) diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 75b391993..7cac37c93 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,8 @@ +2004-01-20 Neil Jerram + + * gds-client.scm: Extensive changes to implement eval threads, and + to tidy up and organize the rest of the code. + 2003-12-06 Neil Jerram * gds.texi: New. diff --git a/emacs/gds-client.scm b/emacs/gds-client.scm index ea54c43df..17949cbb4 100644 --- a/emacs/gds-client.scm +++ b/emacs/gds-client.scm @@ -1,6 +1,6 @@ ;;;; Guile Debugger UI client -;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. ;;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -36,16 +36,48 @@ gds-server-died-hook) #:no-backtrace) -;; The TCP port number that the UI server listens for application -;; connections on. + +;;;; {Internal Tracing and Debugging} + +;; Some of this module's thread and mutex code is quite tricky and +;; includes `trc' statements to trace out useful information if the +;; environment variable GDS_TRC is defined. +(define trc + (if (getenv "GDS_TRC") + (let ((port (open-output-file "/home/neil/gds-client.log")) + (trc-mutex (make-mutex))) + (lambda args + (with-mutex trc-mutex + (write args port) + (newline port) + (force-output port)))) + noop)) + +(define-macro (assert expr) + `(or ,expr + (error "Assertion failed" expr))) + + +;;;; {TCP Connection} + +;; Communication between this module (running in the application being +;; debugged) and the GDS server and UI code (running in/under Emacs) +;; is through a TCP connection. `gds-port-number' is the TCP port +;; number where the server listens for application connections. (define gds-port-number 8333) -;; Once connected, the TCP socket port to the UI server. +;; Once connected, the TCP socket port to the server. (define gds-port #f) -(define* (gds-connect name debug #:optional host) - "Connect to the debug UI server as @var{name}, a string that should -be sufficient to describe the calling application to the debug UI +;; Public procedure to discover whether there is a GDS connection yet. +(define (gds-connected?) + "Return @code{#t} if a UI server connected has been made; else @code{#f}." + (not (not gds-port))) + +;; Public procedure to create the connection to the GDS server. +(define* (gds-connect name #:optional host) + "Connect to the GDS server as @var{name}, a string that should be +sufficient to describe the calling application to the GDS frontend user. The optional @var{host} arg specifies the hostname or dotted decimal IP address where the UI server is running; default is 127.0.0.1." @@ -59,96 +91,18 @@ decimal IP address where the UI server is running; default is (setsockopt s SOL_TCP TCP_NODELAY 1) (connect s AF_INET (inet-aton (or host "127.0.0.1")) gds-port-number) s)) - ;; Set debugger-output-port so that stuff written to it is - ;; accumulated for sending to the debug server. + ;; Set debugger-output-port so that messages written to it are not + ;; displayed on the application's stdout, but instead accumulated + ;; for sending to the GDS frontend. (set! (debugger-output-port) (make-soft-port (vector accumulate-output accumulate-output #f #f #f #f) "w")) - ;; Write initial context to debug server. + ;; Announce ourselves to the server. (write-form (list 'name name (getpid))) - ;(write-form (cons 'modules (map module-name (loaded-modules)))) - ;; Start the asynchronous UI thread. - (start-async-gds-thread) - ;; If `debug' is true, debug immediately. - (if debug - (debug-stack (make-stack #t gds-connect) #:continuable)) -; (gds-command-loop #f) - ) - -(define gds-disable-async-thread noop) -(define gds-continue-async-thread noop) -(define async-gds-thread #f) - -(define (start-async-gds-thread) - (let ((mutex (make-mutex)) - (condition (make-condition-variable)) - (admin (pipe))) - ;; Start the asynchronous UI thread. - (begin-thread - (set! async-gds-thread (current-thread)) - ;;(write (cons admin gds-port)) - ;;(newline) - (lock-mutex mutex) - (catch 'server-died - (lambda () - (let loop ((avail '())) - (write-note 'startloop) - ;;(write avail) - ;;(newline) - (cond ((not gds-port)) ; exit loop - ((null? avail) - (write-status 'ready-for-input) - (unlock-mutex mutex) - (let ((ports (car (select (list gds-port (car admin)) - '() '())))) - (lock-mutex mutex) - (loop ports))) - (else - (write-note 'sthg-to-read) - (let ((port (car avail))) - (if (eq? port gds-port) - (handle-instruction #f (read gds-port)) - (begin - (write-note 'debugger-takeover) - ;; Notification from debugger that it - ;; wants to take over. Read the - ;; notification char. - (read-char (car admin)) - ;; Wait on condition variable - this allows the - ;; debugger thread to grab the mutex. - (write-note 'cond-wait) - (signal-condition-variable condition) - (wait-condition-variable condition mutex) - )) - ;; Loop. - (loop '())))) - (write-note 'loopexited))) - (lambda args #f)) - (set! gds-disable-async-thread noop) - (set! gds-continue-async-thread noop) - (set! async-gds-thread #f) - (unlock-mutex mutex)) - ;; Redefine procs used by debugger thread to take control. - (set! gds-disable-async-thread - (lambda () - (lock-mutex mutex) - (write-char #\x (cdr admin)) - (force-output (cdr admin)) - (write-note 'char-written) - (wait-condition-variable condition mutex) - ;;(display "gds-disable-async-thread: locking mutex...\n" - ;; (current-error-port)) - )) - (set! gds-continue-async-thread - (lambda () - (write-note 'cond-signal) - (signal-condition-variable condition) - ;; Make sure that the async thread has got the message - ;; before we could possibly try to grab the main mutex - ;; again. - (unlock-mutex mutex))))) + ;; Start the UI read thread. + (set! ui-read-thread (make-thread ui-read-thread-proc))) (define accumulated-output '()) @@ -162,31 +116,135 @@ decimal IP address where the UI server is running; default is (set! accumulated-output '()) s)) -(define (gds-connected?) - "Return @code{#t} if a UI server connected has been made; else @code{#f}." - (not (not gds-port))) +;;;; {UI Read Thread} + +;; Except when the application enters the debugger, communication with +;; the GDS server and frontend is managed by a dedicated thread for +;; this purpose. This design avoids having to modify application code +;; at the expense of requiring a Guile with threads support. +(define (ui-read-thread-proc) + (let ((eval-thread-needed? #t)) + ;; Start up the default eval thread. + (make-thread eval-thread 1 (lambda () (not eval-thread-needed?))) + (with-mutex ui-read-mutex + (catch 'server-died + ;; Protected thunk: loop reading either protocol input from + ;; the server, or an indication (through ui-read-switch-pipe) + ;; that a thread in the debugger wants to take over the + ;; interaction with the server. + (lambda () + (let loop ((avail '())) + (write-note 'startloop) + (cond ((not gds-port)) ; exit loop + ((null? avail) + (write-status 'ready-for-input) + (loop (without-mutex ui-read-mutex + (car (select (list gds-port + (car ui-read-switch-pipe)) + '() '()))))) + (else + (write-note 'sthg-to-read) + (let ((port (car avail))) + (if (eq? port gds-port) + (handle-instruction #f (read gds-port)) + (begin + (write-note 'debugger-takeover) + ;; Notification from debugger that it wants + ;; to take over. Read the notification + ;; char. + (read-char (car ui-read-switch-pipe)) + ;; Wait on ui-read-switch variable - this + ;; allows the debugger thread to grab the + ;; mutex. + (write-note 'cond-wait) + (signal-condition-variable ui-read-switch) + (wait-condition-variable ui-read-switch + ui-read-mutex))) + ;; Loop. + (loop '())))) + (write-note 'loopexited))) + ;; Catch handler. + (lambda args #f))) + ;; Tell the eval thread that it can exit. + (with-mutex eval-work-mutex + (set! eval-thread-needed? #f) + (broadcast-condition-variable eval-work-changed)))) + +;; It's useful to keep a note of the UI thread's id. +(define ui-read-thread #f) + +;; Mutex used to control which thread is currently reading the TCP +;; connection to the server/UI. +(define ui-read-mutex (make-mutex)) + +;; Condition variable used by threads interested in reading the TCP +;; connection to signal changes in their state. +(define ui-read-switch (make-condition-variable)) + +;; Pipe used by application threads that enter the debugger to tell +;; the UI read thread that they'd like to take over reading the TCP +;; connection. +(define ui-read-switch-pipe (pipe)) + + +;;;; {Debugger Integration} + +;; When a thread enters the Guile debugger and a GDS connection is +;; present, the debugger calls `gds-command-loop' instead of entering +;; its usual command loop. (define (gds-command-loop state) "Interact with the UI frontend." (or (gds-connected?) (error "Not connected to UI server.")) - (gds-disable-async-thread) - (catch #t ; Only expect here 'exit-debugger or 'server-died. - (lambda () - (let loop ((state state)) - ;; Write accumulated debugger output. - (write-form (list 'output - (sans-surrounding-whitespace - (get-accumulated-output)))) - ;; Write current state to the frontend. - (if state (write-stack state)) - ;; Tell the frontend that we're waiting for input. - (write-status 'waiting-for-input) - ;; Read next instruction, act on it, and loop with - ;; updated state. - (loop (handle-instruction state (read gds-port))))) - (lambda args *unspecified*)) - (gds-continue-async-thread)) + ;; Take over server/UI interaction from the normal UI read thread. + (with-mutex ui-read-mutex) + (write-char #\x (cdr ui-read-switch-pipe)) + (force-output (cdr ui-read-switch-pipe)) + (write-note 'char-written) + (wait-condition-variable ui-read-switch ui-read-mutex) + ;; We now "have the com", as they say on Star Trek. + (catch #t ; Only expect here 'exit-debugger or 'server-died. + (lambda () + (let loop ((state state)) + ;; Write accumulated debugger output. + (write-form (list 'output (sans-surrounding-whitespace + (get-accumulated-output)))) + ;; Write current state to the frontend. + (if state (write-stack state)) + ;; Tell the frontend that we're waiting for input. + (write-status 'waiting-for-input) + ;; Read next instruction, act on it, and loop with updated + ;; state. + (loop (handle-instruction state (read gds-port))))) + (lambda args *unspecified*)) + (write-note 'cond-signal) + ;; Tell the UI read thread that it can take control again. + (signal-condition-variable ui-read-switch)) + + +;;;; {General Output to Server/UI} + +(define write-form + (let ((protocol-mutex (make-mutex))) + (lambda (form) + ;; Write any form FORM to UI frontend. + (with-mutex protocol-mutex + (write form gds-port) + (newline gds-port) + (force-output gds-port))))) + +(define (write-note note) + ;; Write a note (for debugging this code) to UI frontend. + (false-if-exception (write-form `(note ,note)))) + +(define (write-status status) + (write-form (list 'current-module + (format #f "~S" (module-name (current-module))))) + (write-form (list 'status status))) + + +;;;; {Stack Output to Server/UI} (define (write-stack state) ;; Write Emacs-readable representation of current state to UI @@ -207,16 +265,6 @@ decimal IP address where the UI server is running; default is (- nframes index 1) flags)))))) -(define (write-form form) - ;; Write any form FORM to UI frontend. - (write form gds-port) - (newline gds-port) - (force-output gds-port)) - -(define (write-note note) - ;; Write a note (for debugging this code) to UI frontend. - (false-if-exception (write-form `(note ,note)))) - (define (stack->emacs-readable stack) ;; Return Emacs-readable representation of STACK. (map (lambda (index) @@ -266,11 +314,11 @@ decimal IP address where the UI server is running; default is (format #f "~S" flag))) flags)) -(define the-ice-9-debugger-commands-module - (resolve-module '(ice-9 debugger commands))) -(define internal-error-stack #f) +;;;; {Handling GDS Protocol Instructions} +;; Instructions from the server/UI always come through here. If +;; `state' is non-#f, we are in the debugger; otherwise, not. (define (handle-instruction state ins) (if (eof-object? ins) (server-died) @@ -288,7 +336,8 @@ decimal IP address where the UI server is running; default is (apply throw key args)) (else (write-form - `(eval-results "GDS Internal Error\n" + `(eval-results error + "GDS Internal Error\n" ,(list (with-output-to-string (lambda () (write key) @@ -306,6 +355,8 @@ decimal IP address where the UI server is running; default is (run-hook gds-server-died-hook) (throw 'server-died)) +(define internal-error-stack #f) + (define gds-server-died-hook (make-hook)) (define (handle-instruction-1 state ins) @@ -326,6 +377,7 @@ decimal IP address where the UI server is running; default is stringstring (car reverse-name))) + (dir-hint-module-name (reverse (cdr reverse-name))) + (dir-hint (apply string-append + (map (lambda (elt) + (string-append (symbol->string elt) "/")) + dir-hint-module-name)))) + (%search-load-path (in-vicinity dir-hint name)))) + +(define (loaded-modules) + ;; Return list of all loaded modules sorted by name. + (sort (apropos-fold-all (lambda (module acc) (cons module acc)) '()) + (lambda (m1 m2) + (symliststring (car l1)) (symbol->string (car l2)))))) + + +;;;; {Source Breakpoint Installation} + (define (install-breakpoints x bpinfo) (define (install-recursive x) (if (list? x) @@ -427,7 +529,95 @@ decimal IP address where the UI server is running; default is (for-each install-recursive x)))) (install-recursive x)) -(define (gds-eval x bpinfo m) + +;;;; {Evaluation} + +;; Evaluation threads are unleashed by two possible triggers. One is +;; a boolean variable, specific to each thread, that tells the thread +;; to exit when set to #t. The other is another boolean variable, but +;; global, indicating that there is an evaluation to perform: +(define eval-work-available #f) + +;; This variable, which is only valid when `eval-work-available' is +;; #t, holds the evaluation to perform: +(define eval-work #f) + +;; A mutex protects against concurrent access to these variables. +(define eval-work-mutex (make-mutex)) + +;; Changes in these variables are signaled by broadcasting the +;; following condition variable. +(define eval-work-changed (make-condition-variable)) + +;; When an evaluation thread takes some work, it tells the main GDS +;; thread by signaling this condition variable. +(define eval-work-taken (make-condition-variable)) + +(define-macro (without-mutex m . body) + `(dynamic-wind + (lambda () (unlock-mutex ,m)) + (lambda () (begin ,@body)) + (lambda () (lock-mutex ,m)))) + +(define next-thread-number + (let ((count 0)) + (lambda () + (set! count (+ count 1)) + count))) + +(define (eval-thread depth thread-should-exit-thunk) + ;; Acquire mutex to check trigger variables. + (with-mutex eval-work-mutex + (let ((thread-number (next-thread-number))) + (trc 'eval-thread depth thread-number "entering loop") + (let loop () + (cond ((thread-should-exit-thunk) + ;; Allow thread to exit. + ) + + (eval-work-available + ;; Take a local copy of the work, reset global + ;; variables, then do the work with mutex released. + (trc 'eval-thread depth thread-number "starting work") + (let ((work eval-work) + (subthread-needed? #t)) + (set! eval-work-available #f) + (signal-condition-variable eval-work-taken) + (without-mutex eval-work-mutex + ;; Before starting evaluation, create another eval + ;; thread like this one, so that it can take over + ;; if another evaluation is requested before this + ;; one is finished. + (make-thread eval-thread (+ depth 1) + (lambda () (not subthread-needed?))) + ;; Do the evaluation(s). + (let loop2 ((correlator (car work)) + (m (cadr work)) + (exprs (cddr work)) + (results '())) + (if (null? exprs) + (write-form `(eval-results ,correlator ,@results)) + (loop2 correlator + m + (cdr exprs) + (append results (gds-eval (car exprs) m)))))) + (trc 'eval-thread depth thread-number "work done") + ;; Tell the subthread that it should now exit. + (set! subthread-needed? #f) + (broadcast-condition-variable eval-work-changed) + ;; Loop for more work for this thread. + (loop))) + + (else + ;; Wait for something to change, then loop to check + ;; trigger variables again. + (trc 'eval-thread depth thread-number "wait") + (wait-condition-variable eval-work-changed eval-work-mutex) + (trc 'eval-thread depth thread-number "wait done") + (loop)))) + (trc 'eval-thread depth thread-number "exiting")))) + +(define (gds-eval x m) ;; Consumer to accept possibly multiple values and present them for ;; Emacs as a list of strings. (define (value-consumer . values) @@ -436,9 +626,6 @@ decimal IP address where the UI server is running; default is (map (lambda (value) (with-output-to-string (lambda () (write value)))) values))) - ;; Before evaluation, set breakpoints in the read code as specified - ;; by bpinfo. - (install-breakpoints x bpinfo) ;; Now do evaluation. (let ((value #f)) (let* ((do-eval (if m @@ -480,35 +667,5 @@ decimal IP address where the UI server is running; default is '("unhandled-exception-in-evaluation")))))))))) (list output value)))) -(define (write-status status) - (write-form (list 'current-module - (format #f "~S" (module-name (current-module))))) - (write-form (list 'status status))) - -(define (loaded-module-source module-name) - ;; Return the file name that (ice-9 boot-9) probably loaded the - ;; named module from. (The `probably' is because `%load-path' might - ;; have changed since the module was loaded.) - (let* ((reverse-name (reverse module-name)) - (name (symbol->string (car reverse-name))) - (dir-hint-module-name (reverse (cdr reverse-name))) - (dir-hint (apply string-append - (map (lambda (elt) - (string-append (symbol->string elt) "/")) - dir-hint-module-name)))) - (%search-load-path (in-vicinity dir-hint name)))) - -(define (loaded-modules) - ;; Return list of all loaded modules sorted by name. - (sort (apropos-fold-all (lambda (module acc) (cons module acc)) '()) - (lambda (m1 m2) - (symliststring (car l1)) (symbol->string (car l2)))))) ;;; (emacs gds-client) ends here. From ea73836c1d10053452cc56c11d04ff0e550a22bf Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 20 Jan 2004 22:13:20 +0000 Subject: [PATCH 050/167] Reorg gds-send args; use evaluation correlator --- emacs/ChangeLog | 3 ++ emacs/gds.el | 94 +++++++++++++++++++++++-------------------------- 2 files changed, 47 insertions(+), 50 deletions(-) diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 7cac37c93..f86698e4c 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,5 +1,8 @@ 2004-01-20 Neil Jerram + * gds.el: Changes throughout because of (i) change of gds-send + args, (ii) introduction of evaluation correlator. + * gds-client.scm: Extensive changes to implement eval threads, and to tidy up and organize the rest of the code. diff --git a/emacs/gds.el b/emacs/gds.el index 865f9ee5c..af1c5cc74 100644 --- a/emacs/gds.el +++ b/emacs/gds.el @@ -105,8 +105,8 @@ ) ;; Send input to the subprocess. -(defun gds-send (string) - (process-send-string gds-process string)) +(defun gds-send (string client) + (process-send-string gds-process (format "(%S %s)\n" client string))) ;;;; Multiple application scheduling. @@ -179,7 +179,7 @@ (with-current-buffer gds-transcript (goto-char (point-max)) (let ((inhibit-read-only t)) - (insert (format "<%S %S %S>" client proc args) "\n"))) + (insert (format "rx %S" (cons client (cons proc args))) "\n"))) (cond (;; (name ...) - Client name. (eq proc 'name) (setq gds-pid (cadr args)) @@ -239,7 +239,7 @@ (;; (eval-results ...) - Results of evaluation. (eq proc 'eval-results) - (gds-display-results client args)) + (gds-display-results client (car args) (cdr args))) ((eq proc 'completion-result) (setq gds-completion-results (or (car args) t))) @@ -492,7 +492,7 @@ the following symbols. (defun gds-async-break (w &rest ignore) (interactive) - (gds-send (format "(%S async-break)\n" gds-focus-client))) + (gds-send "async-break" gds-focus-client)) (defun gds-toggle-debug-exceptions (w &rest ignore) (interactive) @@ -559,9 +559,8 @@ the following symbols. (defun gds-select-stack-frame (widget &rest ignored) (let* ((s (widget-value widget)) (ind (memq 'index (text-properties-at 0 s)))) - (gds-send (format "(%S debugger-command frame %d)\n" - gds-focus-client - (cadr ind))))) + (gds-send (format "debugger-command frame %d" (cadr ind)) + gds-focus-client))) ;; Overlay used to highlight the source expression corresponding to ;; the selected frame. @@ -697,11 +696,11 @@ are not readable by Emacs.") ;; Set flag to indicate module expanded. (setcdr minfo (list t)) ;; Get symlist from Guile. - (gds-send (format "(%S query-module %S)\n" client name))))) + (gds-send (format "query-module %S" name) client)))) (defun gds-query-modules () (interactive) - (gds-send (format "(%S query-modules)\n" gds-focus-client))) + (gds-send "query-modules" gds-focus-client)) (defun gds-view-browser () (interactive) @@ -735,38 +734,36 @@ are not readable by Emacs.") (defun gds-go () (interactive) - (gds-send (format "(%S debugger-command continue)\n" gds-focus-client))) + (gds-send "debugger-command continue" gds-focus-client)) (defun gds-next () (interactive) - (gds-send (format "(%S debugger-command next 1)\n" gds-focus-client))) + (gds-send "debugger-command next 1" gds-focus-client)) (defun gds-evaluate (expr) (interactive "sEvaluate (in this stack frame): ") - (gds-send (format "(%S debugger-command evaluate %s)\n" - gds-focus-client - (prin1-to-string expr)))) + (gds-send (format "debugger-command evaluate %s" (prin1-to-string expr)) + gds-focus-client)) (defun gds-step-in () (interactive) - (gds-send (format "(%S debugger-command step 1)\n" gds-focus-client))) + (gds-send "debugger-command step 1" gds-focus-client)) (defun gds-step-out () (interactive) - (gds-send (format "(%S debugger-command finish)\n" gds-focus-client))) + (gds-send "debugger-command finish" gds-focus-client)) (defun gds-trace-finish () (interactive) - (gds-send (format "(%S debugger-command trace-finish)\n" - gds-focus-client))) + (gds-send "debugger-command trace-finish" gds-focus-client)) (defun gds-frame-info () (interactive) - (gds-send (format "(%S debugger-command info-frame)\n" gds-focus-client))) + (gds-send "debugger-command info-frame" gds-focus-client)) (defun gds-frame-args () (interactive) - (gds-send (format "(%S debugger-command info-args)\n" gds-focus-client))) + (gds-send "debugger-command info-args" gds-focus-client)) ;;;; Setting breakpoints. @@ -821,11 +818,11 @@ are not readable by Emacs.") nil nil "debug-here"))) - (gds-send (format "(%S set-breakpoint %s %s %s)\n" - gds-focus-client + (gds-send (format "set-breakpoint %s %s %s" module sym - behaviour))))) + behaviour) + gds-focus-client)))) ;;;; Scheme source breakpoints. @@ -1056,19 +1053,25 @@ region's code." (setq column (current-column)) ; 0-based (beginning-of-line) (setq line (count-lines (point-min) (point)))) ; 0-based - (gds-send (format "(%S eval %s %S %d %d %S %S)\n" - client + (gds-send (format "eval region %s %S %d %d %s %S" (if module (prin1-to-string module) "#f") port-name line column - (gds-region-breakpoint-info start end) - (buffer-substring-no-properties start end))))) + (let ((bpinfo (gds-region-breakpoint-info start end))) + ;; Make sure that "no bpinfo" is represented + ;; as "()", not "nil", as Scheme doesn't + ;; understand "nil". + (if bpinfo (format "%S" bpinfo) "()")) + (buffer-substring-no-properties start end)) + client))) -(defun gds-eval-expression (expr &optional client) +(defun gds-eval-expression (expr &optional client correlator) "Evaluate the supplied EXPR (a string)." (interactive "sEvaluate expression: \nP") (setq client (gds-choose-client client)) - (gds-send (format "(%S eval #f \"Emacs expression\" 0 0 %S)\n" - client expr))) + (gds-send (format "eval %S #f \"Emacs expression\" 0 0 () %S" + (or correlator 'expression) + expr) + client)) (defun gds-eval-defun (&optional client) "Evaluate the defun (top-level form) at point." @@ -1087,13 +1090,8 @@ region's code." ;;;; Help. -;; Help is implemented as a special case of evaluation, where we -;; arrange for the evaluation result to be a known symbol that is -;; unlikely to crop up otherwise. When the evaluation result is this -;; symbol, we only display the output from the evaluation. - -(defvar gds-help-symbol '%-gds-help-% - "Symbol used by GDS to identify an evaluation response as help.") +;; Help is implemented as a special case of evaluation, identified by +;; the evaluation correlator 'help. (defun gds-help-symbol (sym &optional client) "Get help for SYM (a Scheme symbol)." @@ -1107,8 +1105,7 @@ region's code." "Describe Guile symbol: "))) (list (if (zerop (length val)) sym val) current-prefix-arg))) - (gds-eval-expression (format "(begin (help %s) '%S)" sym gds-help-symbol) - client)) + (gds-eval-expression (format "(help %s)" sym) client 'help)) (defun gds-apropos (regex &optional client) "List Guile symbols matching REGEX." @@ -1122,8 +1119,7 @@ region's code." "Guile apropos (regexp): "))) (list (if (zerop (length val)) sym val) current-prefix-arg))) - (gds-eval-expression (format "(begin (apropos %S) '%S)" regex gds-help-symbol) - client)) + (gds-eval-expression (format "(apropos %S)" regex) client 'help)) (defvar gds-completion-results nil) @@ -1140,10 +1136,11 @@ interesting happened, `nil' if not." nil (setq client (gds-choose-client client)) (setq gds-completion-results nil) - (gds-send (format "(%S complete %s)\n" client + (gds-send (format "complete %s" (prin1-to-string (buffer-substring-no-properties (- (point) chars) - (point))))) + (point)))) + client) (while (null gds-completion-results) (accept-process-output gds-process 0 200)) (cond ((eq gds-completion-results t) @@ -1167,11 +1164,8 @@ interesting happened, `nil' if not." ;;;; Display of evaluation and help results. -(defun gds-display-results (client results) - (let ((helpp (and (= (length results) 2) - (= (length (cadr results)) 1) - (string-equal (caadr results) - (prin1-to-string gds-help-symbol))))) +(defun gds-display-results (client correlator results) + (let ((helpp (eq correlator 'help))) (let ((buf (get-buffer-create (if helpp "*Guile Help*" "*Guile Results*")))) @@ -1221,7 +1215,7 @@ Used for determining the default for the next `gds-load-file'.") (setq gds-prev-load-dir/file (cons (file-name-directory file-name) (file-name-nondirectory file-name))) (setq client (gds-choose-client client)) - (gds-send (format "(%S load %S)\n" client file-name))) + (gds-send (format "load %S" file-name) client)) ;;;; Scheme mode keymap items. From bb5ad88f279511b092fbc0a63bde0ad8b5411906 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 20 Jan 2004 22:38:39 +0000 Subject: [PATCH 051/167] Back out change to lazy-handler-dispatch lookup. --- ice-9/ChangeLog | 5 +++++ ice-9/boot-9.scm | 24 ++++++++++++------------ 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index aa9840692..226e1881e 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2004-01-20 Neil Jerram + + * boot-9.scm (error-catching-loop): Back out 2003-11-19 change to + lazy-handler-dispatch lookup. + 2004-01-12 Marius Vollmer * mapping.scm: Use '#:' prefix for keywords instead of ':'. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index e82726a8b..98a15c61b 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2315,18 +2315,18 @@ (loop (thunk))) #f))))) - ;; Use a closure here rather than - ;; just `lazy-handler-dispatch' so - ;; that lookup of - ;; lazy-handler-dispatch's value is - ;; deferred until a throw occurs. - ;; This means that if code executed - ;; in the REPL just above set!s - ;; lazy-handler-dispatch, the new - ;; value will be used to handle the - ;; next throw from the REPL. - (lambda args - (apply lazy-handler-dispatch args)))) + ;; Note that having just + ;; `lazy-handler-dispatch' here is + ;; connected with the mechanism that + ;; produces a nice backtrace upon + ;; error. If, for example, this is + ;; replaced with (lambda args (apply + ;; lazy-handler-dispatch args)), the + ;; stack cutting (in save-stack) + ;; goes wrong and ends up saving no + ;; stack at all, so there is no + ;; backtrace. + lazy-handler-dispatch)) (lambda (key . args) (case key From 7eec4c37c73ef3e1a855655d9bbcaf790a919416 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 21 Jan 2004 00:06:11 +0000 Subject: [PATCH 052/167] * gc.c: add protected_object_count, a number that is dumped from gc_stats() --- libguile/ChangeLog | 5 +++++ libguile/gc.c | 13 +++++++++++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2e05e472d..910337d6e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2004-01-19 Han-Wen Nienhuys + + * gc.c: add protected_object_count, a number that is dumped from + gc_stats() + 2004-01-11 Marius Vollmer * dynwind.h, dynwind.c (scm_frame_unwind, diff --git a/libguile/gc.c b/libguile/gc.c index 50032bdad..74f61f0b4 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -275,6 +275,7 @@ 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; +unsigned long protected_obj_count = 0; SCM_SYMBOL (sym_cells_allocated, "cells-allocated"); @@ -289,6 +290,7 @@ 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"); +SCM_SYMBOL (sym_protected_objects, "protected-objects"); @@ -318,6 +320,7 @@ 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_protected_obj_count; double local_scm_gc_cells_swept; double local_scm_gc_cells_marked; SCM answer; @@ -353,7 +356,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, local_scm_gc_times = scm_gc_times; local_scm_gc_malloc_yield_percentage = scm_gc_malloc_yield_percentage; local_scm_gc_cell_yield_percentage= scm_gc_cell_yield_percentage; - + local_protected_obj_count = protected_obj_count; local_scm_gc_cells_swept = (double) scm_gc_cells_swept_acc + (double) scm_gc_cells_swept; @@ -378,7 +381,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, 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_cell_yield, scm_long2num (local_scm_gc_cell_yield_percentage)), + scm_cons (sym_protected_objects, scm_ulong2num (local_protected_obj_count)), scm_cons (sym_heap_segments, heap_segs), SCM_UNDEFINED); SCM_ALLOW_INTS; @@ -725,6 +729,8 @@ scm_permanent_object (SCM obj) scm_gc_protect_object(X) increments and scm_gc_unprotect_object(X) decrements. */ + + SCM scm_gc_protect_object (SCM obj) { @@ -736,6 +742,8 @@ scm_gc_protect_object (SCM obj) handle = scm_hashq_create_handle_x (scm_protects, obj, SCM_MAKINUM (0)); SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_MAKINUM (1))); + protected_obj_count ++; + SCM_REALLOW_INTS; return obj; @@ -769,6 +777,7 @@ scm_gc_unprotect_object (SCM obj) else SCM_SETCDR (handle, count); } + protected_obj_count --; SCM_REALLOW_INTS; From 012a3a7537d305b5ce2f95f3337978facac8634f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 00:45:48 +0000 Subject: [PATCH 053/167] * tests/srfi-26.test: New. * Makefile.am (SCM_TESTS): Added it. --- test-suite/Makefile.am | 1 + test-suite/tests/srfi-26.test | 74 +++++++++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+) create mode 100644 test-suite/tests/srfi-26.test diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 241f66d0b..ad232bd6b 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -61,6 +61,7 @@ SCM_TESTS = tests/alist.test \ tests/srfi-13.test \ tests/srfi-14.test \ tests/srfi-19.test \ + tests/srfi-26.test \ tests/srfi-34.test \ tests/srfi-4.test \ tests/srfi-9.test \ diff --git a/test-suite/tests/srfi-26.test b/test-suite/tests/srfi-26.test new file mode 100644 index 000000000..2ebe5de03 --- /dev/null +++ b/test-suite/tests/srfi-26.test @@ -0,0 +1,74 @@ +; CONFIDENCE TEST FOR IMPLEMENTATION OF SRFI-26 +; ============================================= +; +; Sebastian.Egner@philips.com, 3-Jun-2002. +; +; This file checks a few assertions about the implementation. +; If you run it and no error message is issued, the implementation +; is correct on the cases that have been tested. +; +; compliance: +; Scheme R5RS with +; SRFI-23: error +; +; loading this file into Scheme 48 0.57 after 'cut.scm' has been loaded: +; ,open srfi-23 +; ,load check.scm + +; (check expr) +; evals expr and issues an error if it is not #t. + +(define-module (test-srfi-26) + #:use-module (test-suite lib) + #:use-module (srfi srfi-26)) + +(define (check expr) + (pass-if "cut/cute" (eval expr (interaction-environment)))) + +; (check-all) +; runs several tests on cut and reports. + +(define (check-all) + (for-each + check + '( ; cuts + (equal? ((cut list)) '()) + (equal? ((cut list <...>)) '()) + (equal? ((cut list 1)) '(1)) + (equal? ((cut list <>) 1) '(1)) + (equal? ((cut list <...>) 1) '(1)) + (equal? ((cut list 1 2)) '(1 2)) + (equal? ((cut list 1 <>) 2) '(1 2)) + (equal? ((cut list 1 <...>) 2) '(1 2)) + (equal? ((cut list 1 <...>) 2 3 4) '(1 2 3 4)) + (equal? ((cut list 1 <> 3 <>) 2 4) '(1 2 3 4)) + (equal? ((cut list 1 <> 3 <...>) 2 4 5 6) '(1 2 3 4 5 6)) + (equal? (let* ((x 'wrong) (y (cut list x))) (set! x 'ok) (y)) '(ok)) + (equal? + (let ((a 0)) + (map (cut + (begin (set! a (+ a 1)) a) <>) + '(1 2)) + a) + 2) + ; cutes + (equal? ((cute list)) '()) + (equal? ((cute list <...>)) '()) + (equal? ((cute list 1)) '(1)) + (equal? ((cute list <>) 1) '(1)) + (equal? ((cute list <...>) 1) '(1)) + (equal? ((cute list 1 2)) '(1 2)) + (equal? ((cute list 1 <>) 2) '(1 2)) + (equal? ((cute list 1 <...>) 2) '(1 2)) + (equal? ((cute list 1 <...>) 2 3 4) '(1 2 3 4)) + (equal? ((cute list 1 <> 3 <>) 2 4) '(1 2 3 4)) + (equal? ((cute list 1 <> 3 <...>) 2 4 5 6) '(1 2 3 4 5 6)) + (equal? + (let ((a 0)) + (map (cute + (begin (set! a (+ a 1)) a) <>) + '(1 2)) + a) + 1)))) + +; run the checks when loading +(with-test-prefix "SRFI-26" + (check-all)) From feeef4fb40adc27426a4ccf98c4131e9133c97f2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 00:46:10 +0000 Subject: [PATCH 054/167] New, from Daniel Skarda. Thanks! --- srfi/srfi-26.scm | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 srfi/srfi-26.scm diff --git a/srfi/srfi-26.scm b/srfi/srfi-26.scm new file mode 100644 index 000000000..b536311bd --- /dev/null +++ b/srfi/srfi-26.scm @@ -0,0 +1,31 @@ +(define-module (srfi srfi-26) + :export (cut cute)) + +(cond-expand-provide (current-module) '(srfi-26)) + +(define-macro (cut slot . slots) + (let loop ((slots (cons slot slots)) + (params '()) + (args '())) + (if (null? slots) + `(lambda ,(reverse! params) ,(reverse! args)) + (let ((s (car slots)) + (rest (cdr slots))) + (case s + ((<>) + (let ((var (gensym))) + (loop rest (cons var params) (cons var args)))) + ((<...>) + (if (pair? rest) + (error "<...> not on the end of cut expression")) + (let ((var (gensym))) + `(lambda ,(append! (reverse! params) var) + (apply ,@(reverse! (cons var args)))))) + (else + (loop rest params (cons s args)))))))) + +(define-macro (cute . slots) + (let ((temp (map (lambda (s) (and (not (memq s '(<> <...>))) (gensym))) + slots))) + `(let ,(delq! #f (map (lambda (t s) (and t (list t s))) temp slots)) + (cut ,@(map (lambda (t s) (or t s)) temp slots))))) From b0b55bd6c7cab876607f544ca0e8d89d65f3f9c7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 00:47:06 +0000 Subject: [PATCH 055/167] Mention (srfi srfi-26). --- doc/ref/srfi-modules.texi | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 440a26bcb..7f15bd4c7 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -29,6 +29,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-16:: case-lambda * SRFI-17:: Generalized set! * SRFI-19:: Time/Date library. +* SRFI-26:: Convenient syntax for partial application @end menu @@ -2926,6 +2927,10 @@ month and weekday names are always expected in English. This may change in the future. @end defun +@node SRFI-26 +@section SRFI-26 + +XXX - To be written. @c srfi-modules.texi ends here From 5e673c69f5e77ee9038897ef1354e4169b8fcff1 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 00:47:19 +0000 Subject: [PATCH 056/167] Mention SRFI-26. --- doc/ref/scheme-modules.texi | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index 012238d74..96da7645a 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -515,6 +515,9 @@ Character-set library (@pxref{SRFI-14}). @item (srfi srfi-17) Getter-with-setter support (@pxref{SRFI-17}). +@item (srfi srfi-26) +Convenient syntax for partial application (@pxref{SRFI-26}) + @item (ice-9 slib) This module contains hooks for using Aubrey Jaffer's portable Scheme library SLIB from Guile (@pxref{SLIB}). From 9a5fc8c2034ef545e7d884b6c596b8d94dee2244 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 00:47:50 +0000 Subject: [PATCH 057/167] *** empty log message *** --- NEWS | 4 ++++ THANKS | 2 ++ srfi/ChangeLog | 4 ++++ test-suite/ChangeLog | 5 +++++ 4 files changed, 15 insertions(+) diff --git a/NEWS b/NEWS index a2e8a1e13..9383b9a0b 100644 --- a/NEWS +++ b/NEWS @@ -112,6 +112,10 @@ form around the code performing the heavy computations (typically a C code primitive), enabling the computations to run in parallel while the scripting code runs single-threadedly. +** New module (srfi srfi-26) + +This is an implementation of SRFI-26. + ** Guile now includes its own version of libltdl. We now use a modified version of libltdl that allows us to make diff --git a/THANKS b/THANKS index d4edecff6..26cf428ff 100644 --- a/THANKS +++ b/THANKS @@ -51,6 +51,8 @@ For fixes or providing information which led to a fix: Andreas Rottmann Kevin Ryde Bill Schottstaedt + Alex Shinn + Daniel Skarda Richard Todd Greg Troxel Momchil Velikov diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 110d02933..3756e6989 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,7 @@ +2004-01-21 Marius Vollmer + + * srfi-26.scm: New, from Daniel Skarda. Thanks! + 2003-12-03 Kevin Ryde * srfi-1.c, srfi-1.h, srfi-1.scm (count): Rewrite in C, avoiding diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 2595e5760..c32c85091 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2004-01-21 Marius Vollmer + + * tests/srfi-26.test: New. + * Makefile.am (SCM_TESTS): Added it. + 2004-01-11 Marius Vollmer * tests/r5rs_pitfall.scm: New. From 2da09c3fdeaa2d686f30f63672191115375154f2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 22:40:39 +0000 Subject: [PATCH 058/167] Added Copyright notice. --- doc/ref/autoconf.texi | 6 ++++++ doc/ref/data-rep.texi | 8 +++++++- doc/ref/debugging.texi | 6 ++++++ doc/ref/deprecated.texi | 6 ++++++ doc/ref/expect.texi | 6 ++++++ doc/ref/extend.texi | 6 ++++++ doc/ref/gh.texi | 6 ++++++ doc/ref/indices.texi | 6 ++++++ doc/ref/intro.texi | 6 ++++++ doc/ref/misc-modules.texi | 6 ++++++ doc/ref/posix.texi | 6 ++++++ doc/ref/program.texi | 6 ++++++ doc/ref/repl-modules.texi | 6 ++++++ doc/ref/scheme-binding.texi | 6 ++++++ doc/ref/scheme-compound.texi | 6 ++++++ doc/ref/scheme-control.texi | 6 ++++++ doc/ref/scheme-data.texi | 6 ++++++ doc/ref/scheme-debug.texi | 6 ++++++ doc/ref/scheme-evaluation.texi | 6 ++++++ doc/ref/scheme-ideas.texi | 6 ++++++ doc/ref/scheme-indices.texi | 6 ++++++ doc/ref/scheme-intro.texi | 6 ++++++ doc/ref/scheme-io.texi | 6 ++++++ doc/ref/scheme-memory.texi | 6 ++++++ doc/ref/scheme-modules.texi | 6 ++++++ doc/ref/scheme-options.texi | 6 ++++++ doc/ref/scheme-procedures.texi | 6 ++++++ doc/ref/scheme-reading.texi | 6 ++++++ doc/ref/scheme-scheduling.texi | 6 ++++++ doc/ref/scheme-translation.texi | 6 ++++++ doc/ref/scheme-utility.texi | 6 ++++++ doc/ref/scm.texi | 6 ++++++ doc/ref/script-getopt.texi | 6 ++++++ doc/ref/scripts.texi | 6 ++++++ doc/ref/scsh.texi | 6 ++++++ doc/ref/slib.texi | 6 ++++++ doc/ref/srfi-modules.texi | 6 ++++++ doc/ref/tcltk.texi | 6 ++++++ doc/ref/tools.texi | 6 ++++++ 39 files changed, 235 insertions(+), 1 deletion(-) diff --git a/doc/ref/autoconf.texi b/doc/ref/autoconf.texi index 8d05b2ecc..828155c3d 100644 --- a/doc/ref/autoconf.texi +++ b/doc/ref/autoconf.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Autoconf Support @chapter Autoconf Support diff --git a/doc/ref/data-rep.texi b/doc/ref/data-rep.texi index 09acbe054..5095044fd 100644 --- a/doc/ref/data-rep.texi +++ b/doc/ref/data-rep.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @c essay \input texinfo @c essay @c -*-texinfo-*- @c essay @c %**start of header @@ -46,7 +52,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.15 2003-10-06 19:24:15 mvo Exp $ +@c essay @subtitle $Id: data-rep.texi,v 1.16 2004-01-21 22:40:39 mvo Exp $ @c essay @subtitle For use with Guile @value{VERSION} @c essay @author Jim Blandy @c essay @author Free Software Foundation diff --git a/doc/ref/debugging.texi b/doc/ref/debugging.texi index 0859d9698..b88a852c2 100644 --- a/doc/ref/debugging.texi +++ b/doc/ref/debugging.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Debugging Features @chapter Debugging Features diff --git a/doc/ref/deprecated.texi b/doc/ref/deprecated.texi index 2f6f09fa5..9cc464295 100644 --- a/doc/ref/deprecated.texi +++ b/doc/ref/deprecated.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Deprecated @chapter Deprecated diff --git a/doc/ref/expect.texi b/doc/ref/expect.texi index 7e169e428..472c30e26 100644 --- a/doc/ref/expect.texi +++ b/doc/ref/expect.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Expect @chapter Expect diff --git a/doc/ref/extend.texi b/doc/ref/extend.texi index 5c72bef33..8e25ded2e 100644 --- a/doc/ref/extend.texi +++ b/doc/ref/extend.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Libguile Intro @chapter Using Guile as an Extension Language diff --git a/doc/ref/gh.texi b/doc/ref/gh.texi index 8c166373d..184c507cc 100644 --- a/doc/ref/gh.texi +++ b/doc/ref/gh.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node GH @chapter GH: A Portable C to Scheme Interface diff --git a/doc/ref/indices.texi b/doc/ref/indices.texi index 11ab7476b..a715b3084 100644 --- a/doc/ref/indices.texi +++ b/doc/ref/indices.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Concept Index @unnumbered Concept Index diff --git a/doc/ref/intro.texi b/doc/ref/intro.texi index cf01e049f..01c581714 100644 --- a/doc/ref/intro.texi +++ b/doc/ref/intro.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node What is Guile? @chapter What is Guile? diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi index d589c3976..10117b86a 100644 --- a/doc/ref/misc-modules.texi +++ b/doc/ref/misc-modules.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Pretty Printing @chapter Pretty Printing diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 584d5c848..6ee040826 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @node POSIX @chapter @acronym{POSIX} System Calls and Networking diff --git a/doc/ref/program.texi b/doc/ref/program.texi index eba3fdf83..7471f298c 100644 --- a/doc/ref/program.texi +++ b/doc/ref/program.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Programming Overview @chapter An Overview of Guile Programming diff --git a/doc/ref/repl-modules.texi b/doc/ref/repl-modules.texi index 9ef181d70..c2ab7b9d8 100644 --- a/doc/ref/repl-modules.texi +++ b/doc/ref/repl-modules.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Readline Support @chapter Readline Support diff --git a/doc/ref/scheme-binding.texi b/doc/ref/scheme-binding.texi index e9b891871..a89ddb80b 100644 --- a/doc/ref/scheme-binding.texi +++ b/doc/ref/scheme-binding.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Binding Constructs @chapter Definitions and Variable Bindings diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index aa7894b35..e81d97a6f 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Compound Data Types @chapter Compound Data Types diff --git a/doc/ref/scheme-control.texi b/doc/ref/scheme-control.texi index 902010e6f..96f2daa08 100644 --- a/doc/ref/scheme-control.texi +++ b/doc/ref/scheme-control.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Control Mechanisms @chapter Controlling the Flow of Program Execution diff --git a/doc/ref/scheme-data.texi b/doc/ref/scheme-data.texi index 07381ab16..7f1ef6001 100755 --- a/doc/ref/scheme-data.texi +++ b/doc/ref/scheme-data.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Simple Data Types @chapter Simple Generic Data Types diff --git a/doc/ref/scheme-debug.texi b/doc/ref/scheme-debug.texi index 66526557f..74465014f 100644 --- a/doc/ref/scheme-debug.texi +++ b/doc/ref/scheme-debug.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Debugging @chapter Debugging Infrastructure diff --git a/doc/ref/scheme-evaluation.texi b/doc/ref/scheme-evaluation.texi index a1fee40b5..738dc4de6 100644 --- a/doc/ref/scheme-evaluation.texi +++ b/doc/ref/scheme-evaluation.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Read/Load/Eval @chapter Reading and Evaluating Scheme Code diff --git a/doc/ref/scheme-ideas.texi b/doc/ref/scheme-ideas.texi index 052bdeb35..281a0ecfd 100644 --- a/doc/ref/scheme-ideas.texi +++ b/doc/ref/scheme-ideas.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Basic Ideas @chapter Basic Ideas in Scheme diff --git a/doc/ref/scheme-indices.texi b/doc/ref/scheme-indices.texi index acecb3ff4..bbb644cc5 100644 --- a/doc/ref/scheme-indices.texi +++ b/doc/ref/scheme-indices.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node R5RS Index @unnumbered R5RS Index diff --git a/doc/ref/scheme-intro.texi b/doc/ref/scheme-intro.texi index 22e875339..bd6700cc8 100644 --- a/doc/ref/scheme-intro.texi +++ b/doc/ref/scheme-intro.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Guile Scheme @chapter Guile's Implementation of Scheme diff --git a/doc/ref/scheme-io.texi b/doc/ref/scheme-io.texi index eb01ecbac..0c6d1593d 100644 --- a/doc/ref/scheme-io.texi +++ b/doc/ref/scheme-io.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Input and Output @chapter Input and Output diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi index 73cf3d4c1..64fcf7b43 100644 --- a/doc/ref/scheme-memory.texi +++ b/doc/ref/scheme-memory.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Memory Management @chapter Memory Management and Garbage Collection diff --git a/doc/ref/scheme-modules.texi b/doc/ref/scheme-modules.texi index 96da7645a..3923ed05e 100644 --- a/doc/ref/scheme-modules.texi +++ b/doc/ref/scheme-modules.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Modules @chapter Modules diff --git a/doc/ref/scheme-options.texi b/doc/ref/scheme-options.texi index 32ade3c12..c8f5a4d41 100644 --- a/doc/ref/scheme-options.texi +++ b/doc/ref/scheme-options.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Options and Config @chapter Configuration, Features and Runtime Options diff --git a/doc/ref/scheme-procedures.texi b/doc/ref/scheme-procedures.texi index ab71b546f..0cf418843 100644 --- a/doc/ref/scheme-procedures.texi +++ b/doc/ref/scheme-procedures.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Procedures and Macros @chapter Procedures and Macros diff --git a/doc/ref/scheme-reading.texi b/doc/ref/scheme-reading.texi index 6ec4a77b0..16ef72cca 100644 --- a/doc/ref/scheme-reading.texi +++ b/doc/ref/scheme-reading.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Further Reading @chapter Further Reading diff --git a/doc/ref/scheme-scheduling.texi b/doc/ref/scheme-scheduling.texi index 74c138c88..351945660 100644 --- a/doc/ref/scheme-scheduling.texi +++ b/doc/ref/scheme-scheduling.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Scheduling @chapter Threads, Mutexes, Asyncs and Dynamic Roots diff --git a/doc/ref/scheme-translation.texi b/doc/ref/scheme-translation.texi index 4d398c60f..e7a411ba6 100644 --- a/doc/ref/scheme-translation.texi +++ b/doc/ref/scheme-translation.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Translation @chapter Support for Translating Other Languages diff --git a/doc/ref/scheme-utility.texi b/doc/ref/scheme-utility.texi index d323eef4a..ec567f994 100644 --- a/doc/ref/scheme-utility.texi +++ b/doc/ref/scheme-utility.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Utility Functions @chapter General Utility Functions diff --git a/doc/ref/scm.texi b/doc/ref/scm.texi index d4a634eb9..fb1dc8955 100644 --- a/doc/ref/scm.texi +++ b/doc/ref/scm.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node API Overview @chapter Overview of the Guile API diff --git a/doc/ref/script-getopt.texi b/doc/ref/script-getopt.texi index c71dbd205..274c79912 100644 --- a/doc/ref/script-getopt.texi +++ b/doc/ref/script-getopt.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Command Line Handling @chapter Handling Command Line Options and Arguments diff --git a/doc/ref/scripts.texi b/doc/ref/scripts.texi index e0c5f2345..358f065b0 100644 --- a/doc/ref/scripts.texi +++ b/doc/ref/scripts.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Guile Scripting @chapter Guile Scripting diff --git a/doc/ref/scsh.texi b/doc/ref/scsh.texi index bc8979d67..a03c390ed 100644 --- a/doc/ref/scsh.texi +++ b/doc/ref/scsh.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node The Scheme shell (scsh) @chapter The Scheme shell (scsh) diff --git a/doc/ref/slib.texi b/doc/ref/slib.texi index 6e661f006..eefb6f05b 100644 --- a/doc/ref/slib.texi +++ b/doc/ref/slib.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node SLIB @chapter SLIB diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 7f15bd4c7..e8c2677c6 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node SRFI Support @chapter SRFI Support Modules diff --git a/doc/ref/tcltk.texi b/doc/ref/tcltk.texi index efc38ea9d..da3091946 100644 --- a/doc/ref/tcltk.texi +++ b/doc/ref/tcltk.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Tcl/Tk Interface @chapter Tcl/Tk Interface diff --git a/doc/ref/tools.texi b/doc/ref/tools.texi index 738db5a25..f2116dd71 100644 --- a/doc/ref/tools.texi +++ b/doc/ref/tools.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @page @node Miscellaneous Tools @chapter Miscellaneous Tools From c6ae9c7794ee2ff6d71f99a6e0ed6ac1f1f40075 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 22:43:36 +0000 Subject: [PATCH 059/167] * fdl.texi: New. * guile.texi: Include it as an appendix. * preface.texi: State that the manual is FDL. --- doc/ref/fdl.texi | 452 +++++++++++++++++++++++++++++++++++++++++++ doc/ref/guile.texi | 38 ++-- doc/ref/preface.texi | 15 +- 3 files changed, 477 insertions(+), 28 deletions(-) create mode 100644 doc/ref/fdl.texi diff --git a/doc/ref/fdl.texi b/doc/ref/fdl.texi new file mode 100644 index 000000000..c027a25fd --- /dev/null +++ b/doc/ref/fdl.texi @@ -0,0 +1,452 @@ + +@node GNU Free Documentation License +@appendix GNU Free Documentation License + +@cindex FDL, GNU Free Documentation License +@center Version 1.2, November 2002 + +@display +Copyright @copyright{} 2000,2001,2002 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. +@end display + +@enumerate 0 +@item +PREAMBLE + +The purpose of this License is to make a manual, textbook, or other +functional and useful document @dfn{free} in the sense of freedom: to +assure everyone the effective freedom to copy and redistribute it, +with or without modifying it, either commercially or noncommercially. +Secondarily, this License preserves for the author and publisher a way +to get credit for their work, while not being considered responsible +for modifications made by others. + +This License is a kind of ``copyleft'', which means that derivative +works of the document must themselves be free in the same sense. It +complements the GNU General Public License, which is a copyleft +license designed for free software. + +We have designed this License in order to use it for manuals for free +software, because free software needs free documentation: a free +program should come with manuals providing the same freedoms that the +software does. But this License is not limited to software manuals; +it can be used for any textual work, regardless of subject matter or +whether it is published as a printed book. We recommend this License +principally for works whose purpose is instruction or reference. + +@item +APPLICABILITY AND DEFINITIONS + +This License applies to any manual or other work, in any medium, that +contains a notice placed by the copyright holder saying it can be +distributed under the terms of this License. Such a notice grants a +world-wide, royalty-free license, unlimited in duration, to use that +work under the conditions stated herein. The ``Document'', below, +refers to any such manual or work. Any member of the public is a +licensee, and is addressed as ``you''. You accept the license if you +copy, modify or distribute the work in a way requiring permission +under copyright law. + +A ``Modified Version'' of the Document means any work containing the +Document or a portion of it, either copied verbatim, or with +modifications and/or translated into another language. + +A ``Secondary Section'' is a named appendix or a front-matter section +of the Document that deals exclusively with the relationship of the +publishers or authors of the Document to the Document's overall +subject (or to related matters) and contains nothing that could fall +directly within that overall subject. (Thus, if the Document is in +part a textbook of mathematics, a Secondary Section may not explain +any mathematics.) The relationship could be a matter of historical +connection with the subject or with related matters, or of legal, +commercial, philosophical, ethical or political position regarding +them. + +The ``Invariant Sections'' are certain Secondary Sections whose titles +are designated, as being those of Invariant Sections, in the notice +that says that the Document is released under this License. If a +section does not fit the above definition of Secondary then it is not +allowed to be designated as Invariant. The Document may contain zero +Invariant Sections. If the Document does not identify any Invariant +Sections then there are none. + +The ``Cover Texts'' are certain short passages of text that are listed, +as Front-Cover Texts or Back-Cover Texts, in the notice that says that +the Document is released under this License. A Front-Cover Text may +be at most 5 words, and a Back-Cover Text may be at most 25 words. + +A ``Transparent'' copy of the Document means a machine-readable copy, +represented in a format whose specification is available to the +general public, that is suitable for revising the document +straightforwardly with generic text editors or (for images composed of +pixels) generic paint programs or (for drawings) some widely available +drawing editor, and that is suitable for input to text formatters or +for automatic translation to a variety of formats suitable for input +to text formatters. A copy made in an otherwise Transparent file +format whose markup, or absence of markup, has been arranged to thwart +or discourage subsequent modification by readers is not Transparent. +An image format is not Transparent if used for any substantial amount +of text. A copy that is not ``Transparent'' is called ``Opaque''. + +Examples of suitable formats for Transparent copies include plain +@sc{ascii} without markup, Texinfo input format, La@TeX{} input +format, @acronym{SGML} or @acronym{XML} using a publicly available +@acronym{DTD}, and standard-conforming simple @acronym{HTML}, +PostScript or @acronym{PDF} designed for human modification. Examples +of transparent image formats include @acronym{PNG}, @acronym{XCF} and +@acronym{JPG}. Opaque formats include proprietary formats that can be +read and edited only by proprietary word processors, @acronym{SGML} or +@acronym{XML} for which the @acronym{DTD} and/or processing tools are +not generally available, and the machine-generated @acronym{HTML}, +PostScript or @acronym{PDF} produced by some word processors for +output purposes only. + +The ``Title Page'' means, for a printed book, the title page itself, +plus such following pages as are needed to hold, legibly, the material +this License requires to appear in the title page. For works in +formats which do not have any title page as such, ``Title Page'' means +the text near the most prominent appearance of the work's title, +preceding the beginning of the body of the text. + +A section ``Entitled XYZ'' means a named subunit of the Document whose +title either is precisely XYZ or contains XYZ in parentheses following +text that translates XYZ in another language. (Here XYZ stands for a +specific section name mentioned below, such as ``Acknowledgements'', +``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title'' +of such a section when you modify the Document means that it remains a +section ``Entitled XYZ'' according to this definition. + +The Document may include Warranty Disclaimers next to the notice which +states that this License applies to the Document. These Warranty +Disclaimers are considered to be included by reference in this +License, but only as regards disclaiming warranties: any other +implication that these Warranty Disclaimers may have is void and has +no effect on the meaning of this License. + +@item +VERBATIM COPYING + +You may copy and distribute the Document in any medium, either +commercially or noncommercially, provided that this License, the +copyright notices, and the license notice saying this License applies +to the Document are reproduced in all copies, and that you add no other +conditions whatsoever to those of this License. You may not use +technical measures to obstruct or control the reading or further +copying of the copies you make or distribute. However, you may accept +compensation in exchange for copies. If you distribute a large enough +number of copies you must also follow the conditions in section 3. + +You may also lend copies, under the same conditions stated above, and +you may publicly display copies. + +@item +COPYING IN QUANTITY + +If you publish printed copies (or copies in media that commonly have +printed covers) of the Document, numbering more than 100, and the +Document's license notice requires Cover Texts, you must enclose the +copies in covers that carry, clearly and legibly, all these Cover +Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on +the back cover. Both covers must also clearly and legibly identify +you as the publisher of these copies. The front cover must present +the full title with all words of the title equally prominent and +visible. You may add other material on the covers in addition. +Copying with changes limited to the covers, as long as they preserve +the title of the Document and satisfy these conditions, can be treated +as verbatim copying in other respects. + +If the required texts for either cover are too voluminous to fit +legibly, you should put the first ones listed (as many as fit +reasonably) on the actual cover, and continue the rest onto adjacent +pages. + +If you publish or distribute Opaque copies of the Document numbering +more than 100, you must either include a machine-readable Transparent +copy along with each Opaque copy, or state in or with each Opaque copy +a computer-network location from which the general network-using +public has access to download using public-standard network protocols +a complete Transparent copy of the Document, free of added material. +If you use the latter option, you must take reasonably prudent steps, +when you begin distribution of Opaque copies in quantity, to ensure +that this Transparent copy will remain thus accessible at the stated +location until at least one year after the last time you distribute an +Opaque copy (directly or through your agents or retailers) of that +edition to the public. + +It is requested, but not required, that you contact the authors of the +Document well before redistributing any large number of copies, to give +them a chance to provide you with an updated version of the Document. + +@item +MODIFICATIONS + +You may copy and distribute a Modified Version of the Document under +the conditions of sections 2 and 3 above, provided that you release +the Modified Version under precisely this License, with the Modified +Version filling the role of the Document, thus licensing distribution +and modification of the Modified Version to whoever possesses a copy +of it. In addition, you must do these things in the Modified Version: + +@enumerate A +@item +Use in the Title Page (and on the covers, if any) a title distinct +from that of the Document, and from those of previous versions +(which should, if there were any, be listed in the History section +of the Document). You may use the same title as a previous version +if the original publisher of that version gives permission. + +@item +List on the Title Page, as authors, one or more persons or entities +responsible for authorship of the modifications in the Modified +Version, together with at least five of the principal authors of the +Document (all of its principal authors, if it has fewer than five), +unless they release you from this requirement. + +@item +State on the Title page the name of the publisher of the +Modified Version, as the publisher. + +@item +Preserve all the copyright notices of the Document. + +@item +Add an appropriate copyright notice for your modifications +adjacent to the other copyright notices. + +@item +Include, immediately after the copyright notices, a license notice +giving the public permission to use the Modified Version under the +terms of this License, in the form shown in the Addendum below. + +@item +Preserve in that license notice the full lists of Invariant Sections +and required Cover Texts given in the Document's license notice. + +@item +Include an unaltered copy of this License. + +@item +Preserve the section Entitled ``History'', Preserve its Title, and add +to it an item stating at least the title, year, new authors, and +publisher of the Modified Version as given on the Title Page. If +there is no section Entitled ``History'' in the Document, create one +stating the title, year, authors, and publisher of the Document as +given on its Title Page, then add an item describing the Modified +Version as stated in the previous sentence. + +@item +Preserve the network location, if any, given in the Document for +public access to a Transparent copy of the Document, and likewise +the network locations given in the Document for previous versions +it was based on. These may be placed in the ``History'' section. +You may omit a network location for a work that was published at +least four years before the Document itself, or if the original +publisher of the version it refers to gives permission. + +@item +For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve +the Title of the section, and preserve in the section all the +substance and tone of each of the contributor acknowledgements and/or +dedications given therein. + +@item +Preserve all the Invariant Sections of the Document, +unaltered in their text and in their titles. Section numbers +or the equivalent are not considered part of the section titles. + +@item +Delete any section Entitled ``Endorsements''. Such a section +may not be included in the Modified Version. + +@item +Do not retitle any existing section to be Entitled ``Endorsements'' or +to conflict in title with any Invariant Section. + +@item +Preserve any Warranty Disclaimers. +@end enumerate + +If the Modified Version includes new front-matter sections or +appendices that qualify as Secondary Sections and contain no material +copied from the Document, you may at your option designate some or all +of these sections as invariant. To do this, add their titles to the +list of Invariant Sections in the Modified Version's license notice. +These titles must be distinct from any other section titles. + +You may add a section Entitled ``Endorsements'', provided it contains +nothing but endorsements of your Modified Version by various +parties---for example, statements of peer review or that the text has +been approved by an organization as the authoritative definition of a +standard. + +You may add a passage of up to five words as a Front-Cover Text, and a +passage of up to 25 words as a Back-Cover Text, to the end of the list +of Cover Texts in the Modified Version. Only one passage of +Front-Cover Text and one of Back-Cover Text may be added by (or +through arrangements made by) any one entity. If the Document already +includes a cover text for the same cover, previously added by you or +by arrangement made by the same entity you are acting on behalf of, +you may not add another; but you may replace the old one, on explicit +permission from the previous publisher that added the old one. + +The author(s) and publisher(s) of the Document do not by this License +give permission to use their names for publicity for or to assert or +imply endorsement of any Modified Version. + +@item +COMBINING DOCUMENTS + +You may combine the Document with other documents released under this +License, under the terms defined in section 4 above for modified +versions, provided that you include in the combination all of the +Invariant Sections of all of the original documents, unmodified, and +list them all as Invariant Sections of your combined work in its +license notice, and that you preserve all their Warranty Disclaimers. + +The combined work need only contain one copy of this License, and +multiple identical Invariant Sections may be replaced with a single +copy. If there are multiple Invariant Sections with the same name but +different contents, make the title of each such section unique by +adding at the end of it, in parentheses, the name of the original +author or publisher of that section if known, or else a unique number. +Make the same adjustment to the section titles in the list of +Invariant Sections in the license notice of the combined work. + +In the combination, you must combine any sections Entitled ``History'' +in the various original documents, forming one section Entitled +``History''; likewise combine any sections Entitled ``Acknowledgements'', +and any sections Entitled ``Dedications''. You must delete all +sections Entitled ``Endorsements.'' + +@item +COLLECTIONS OF DOCUMENTS + +You may make a collection consisting of the Document and other documents +released under this License, and replace the individual copies of this +License in the various documents with a single copy that is included in +the collection, provided that you follow the rules of this License for +verbatim copying of each of the documents in all other respects. + +You may extract a single document from such a collection, and distribute +it individually under this License, provided you insert a copy of this +License into the extracted document, and follow this License in all +other respects regarding verbatim copying of that document. + +@item +AGGREGATION WITH INDEPENDENT WORKS + +A compilation of the Document or its derivatives with other separate +and independent documents or works, in or on a volume of a storage or +distribution medium, is called an ``aggregate'' if the copyright +resulting from the compilation is not used to limit the legal rights +of the compilation's users beyond what the individual works permit. +When the Document is included in an aggregate, this License does not +apply to the other works in the aggregate which are not themselves +derivative works of the Document. + +If the Cover Text requirement of section 3 is applicable to these +copies of the Document, then if the Document is less than one half of +the entire aggregate, the Document's Cover Texts may be placed on +covers that bracket the Document within the aggregate, or the +electronic equivalent of covers if the Document is in electronic form. +Otherwise they must appear on printed covers that bracket the whole +aggregate. + +@item +TRANSLATION + +Translation is considered a kind of modification, so you may +distribute translations of the Document under the terms of section 4. +Replacing Invariant Sections with translations requires special +permission from their copyright holders, but you may include +translations of some or all Invariant Sections in addition to the +original versions of these Invariant Sections. You may include a +translation of this License, and all the license notices in the +Document, and any Warranty Disclaimers, provided that you also include +the original English version of this License and the original versions +of those notices and disclaimers. In case of a disagreement between +the translation and the original version of this License or a notice +or disclaimer, the original version will prevail. + +If a section in the Document is Entitled ``Acknowledgements'', +``Dedications'', or ``History'', the requirement (section 4) to Preserve +its Title (section 1) will typically require changing the actual +title. + +@item +TERMINATION + +You may not copy, modify, sublicense, or distribute the Document except +as expressly provided for under this License. Any other attempt to +copy, modify, sublicense or distribute the Document 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. + +@item +FUTURE REVISIONS OF THIS LICENSE + +The Free Software Foundation may publish new, revised versions +of the GNU Free Documentation 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. See +@uref{http://www.gnu.org/copyleft/}. + +Each version of the License is given a distinguishing version number. +If the Document specifies that a particular numbered version of this +License ``or any later version'' applies to it, you have the option of +following the terms and conditions either of that specified version or +of any later version that has been published (not as a draft) by the +Free Software Foundation. If the Document does not specify a version +number of this License, you may choose any version ever published (not +as a draft) by the Free Software Foundation. +@end enumerate + +@page +@appendixsubsec ADDENDUM: How to use this License for your documents + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and +license notices just after the title page: + +@smallexample +@group + Copyright (C) @var{year} @var{your name}. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.2 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. +@end group +@end smallexample + +If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, +replace the ``with...Texts.'' line with this: + +@smallexample +@group + with the Invariant Sections being @var{list their titles}, with + the Front-Cover Texts being @var{list}, and with the Back-Cover Texts + being @var{list}. +@end group +@end smallexample + +If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + +If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of +free software license, such as the GNU General Public License, +to permit their use in free software. + +@c Local Variables: +@c ispell-local-pdict: "ispell-dict" +@c End: + diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index f148976fd..5cf44d40b 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -13,31 +13,21 @@ This reference manual documents Guile, GNU's Ubiquitous Intelligent Language for Extensions, manual edition @value{MANUAL-EDITION} corresponding to Guile @value{VERSION}. -Copyright 1996, 1997, 2000, 2001, 2002, 2003, 2004 Free Software +Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 Free Software Foundation. -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. +Permission is granted to copy, distribute and/or modify this +document under the terms of the GNU Free Documentation License, +Version 1.2 or any later version published by the Free Software +Foundation; with the no Invariant Sections, with the Front-Cover +Texts being ``A GNU Manual,'' and with the Back-Cover Texts as in +(a) below. A copy of the license is included in the section +entitled "GNU Free Documentation License". -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by Free Software Foundation. +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual.'' @end copying -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). -@end ignore - @c Notes @c @@ -130,7 +120,7 @@ notice identical to this one except for the removal of this paragraph @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.26 2004-01-10 21:40:26 kryde Exp $ +@subtitle $Id: guile.texi,v 1.27 2004-01-21 22:43:36 mvo Exp $ @c AUTHORS @@ -276,6 +266,10 @@ Part V: Guile Modules * Expect:: Controlling interactive programs with Guile. * The Scheme shell (scsh):: Using scsh interfaces in Guile. +Appendices + +* GNU Free Documentation License:: The license of this manual. + Indices * Concept Index:: @@ -383,6 +377,8 @@ available through both Scheme and C interfaces. @include expect.texi @include scsh.texi +@include fdl.texi + @iftex @page @unnumbered{Indices} diff --git a/doc/ref/preface.texi b/doc/ref/preface.texi index 070208fef..9841e3673 100644 --- a/doc/ref/preface.texi +++ b/doc/ref/preface.texi @@ -1,3 +1,9 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + @iftex @page @unnumbered Preface @@ -36,13 +42,8 @@ The Guile readline module is published under the terms of the GNU General Public License version 2. See the file @file{COPYING}. @item -The manual you're now reading is published under terms described -@iftex -at the start of the document. -@end iftex -@ifnottex -at the start of the document (@pxref{Top}). -@end ifnottex +The manual you're now reading is published under the terms of the GNU +Free Documentation License (@pxref{GNU Free Documentation License}). @end itemize C code linking to the Guile library is subject to terms of that From 2153f45947ae02244ced165476be1768c39f39bf Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 21 Jan 2004 22:43:48 +0000 Subject: [PATCH 060/167] *** empty log message *** --- doc/ref/ChangeLog | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index eda1f0992..02ea2a02b 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,11 @@ +2004-01-21 Marius Vollmer + + Added copyright notices to all TeXinfo files. + + * fdl.texi: New. + * guile.texi: Include it as an appendix. + * preface.texi: State that the manual is FDL. + 2004-01-20 Kevin Ryde * preface.texi (Guile License): Note readline is GPL and manual has From 9d4bf6d39a328bfda7c3f23560dc303f2a096d24 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 22 Jan 2004 22:42:29 +0000 Subject: [PATCH 061/167] (m_expand_body): Rewrite the expression in place (by overwriting FORMS) also when a letrec is constructed, not only when no definitions are found. Do not return rewritten expression to emphasize the in-place rewriting. Changed all users. --- libguile/eval.c | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/libguile/eval.c b/libguile/eval.c index b23521128..374e1e925 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -764,9 +764,10 @@ m_body (SCM op, SCM exprs) } -/* The function m_expand_body memoizes a proper list of expressions forming a - * body. This function takes care of dealing with internal defines and - * transforming them into an equivalent letrec expression. */ +/* The function m_expand_body memoizes a proper list of expressions + * forming a body. This function takes care of dealing with internal + * defines and transforming them into an equivalent letrec expression. + * The list of expressions is rewritten in place. */ /* This is a helper function for m_expand_body. It helps to figure out whether * an expression denotes a syntactic keyword. */ @@ -835,7 +836,7 @@ is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env) return 0; } -static SCM +static void m_expand_body (const SCM forms, const SCM env) { /* The first body form can be skipped since it is known to be the ISYM that @@ -948,14 +949,13 @@ m_expand_body (const SCM forms, const SCM env) /* FIXME: forms does not hold information about the file location. */ letrec_expression = scm_cons_source (forms, scm_sym_letrec, letrec_tail); new_letrec_expression = scm_m_letrec (letrec_expression, env); - new_body = scm_list_1 (new_letrec_expression); - return new_body; + SCM_SETCAR (forms, new_letrec_expression); + SCM_SETCDR (forms, SCM_EOL); } else { SCM_SETCAR (forms, SCM_CAR (sequence)); SCM_SETCDR (forms, SCM_CDR (sequence)); - return forms; } } @@ -967,7 +967,8 @@ scm_m_expand_body (SCM exprs, SCM env) { scm_c_issue_deprecation_warning ("`scm_m_expand_body' is deprecated."); - return m_expand_body (exprs, env); + m_expand_body (exprs, env); + return exprs; } #endif @@ -2549,7 +2550,7 @@ scm_eval_body (SCM code, SCM env) scm_rec_mutex_lock (&source_mutex); /* check for race condition */ if (SCM_ISYMP (SCM_CAR (code))) - code = m_expand_body (code, env); + m_expand_body (code, env); scm_rec_mutex_unlock (&source_mutex); goto again; } @@ -2951,7 +2952,7 @@ dispatch: scm_rec_mutex_lock (&source_mutex); /* check for race condition */ if (SCM_ISYMP (SCM_CAR (x))) - x = m_expand_body (x, env); + m_expand_body (x, env); scm_rec_mutex_unlock (&source_mutex); goto nontoplevel_begin; } @@ -4604,7 +4605,7 @@ tail: scm_rec_mutex_lock (&source_mutex); /* check for race condition */ if (SCM_ISYMP (SCM_CAR (proc))) - proc = m_expand_body (proc, args); + m_expand_body (proc, args); scm_rec_mutex_unlock (&source_mutex); goto again; } From ef5b6b61d02b8174614837d676524b644fd59b3f Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 22 Jan 2004 22:43:01 +0000 Subject: [PATCH 062/167] *** empty log message *** --- libguile/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 910337d6e..791f8dc7d 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,10 @@ +2004-01-22 Marius Vollmer + + * eval.c (m_expand_body): Rewrite the expression in place (by + overwriting FORMS) also when a letrec is constructed, not only + when no definitions are found. Do not return rewritten expression + to emphasize the in-place rewriting. Changed all users. + 2004-01-19 Han-Wen Nienhuys * gc.c: add protected_object_count, a number that is dumped from From f62b9dff2192cc6286e325ba21f9c2127247b4c8 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 22 Jan 2004 23:14:09 +0000 Subject: [PATCH 063/167] (m_expand_body): remove stray variable new_body. --- libguile/ChangeLog | 4 ++++ libguile/eval.c | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 791f8dc7d..7275c92bc 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2004-01-23 Han-Wen Nienhuys + + * eval.c (m_expand_body): remove stray variable new_body. + 2004-01-22 Marius Vollmer * eval.c (m_expand_body): Rewrite the expression in place (by diff --git a/libguile/eval.c b/libguile/eval.c index 374e1e925..dd85f8780 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -932,7 +932,6 @@ m_expand_body (const SCM forms, const SCM env) SCM letrec_tail; SCM letrec_expression; SCM new_letrec_expression; - SCM new_body; SCM bindings = SCM_EOL; for (definition_idx = definitions; @@ -2244,6 +2243,7 @@ unmemocar (SCM form, SCM env) env = SCM_CAAR (env); for (ir = SCM_IDIST (c); ir != 0; --ir) env = SCM_CDR (env); + SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env)); } return form; From 77e51fd6ed535ff3f9d3c55368dd9e48cd6e94d0 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Thu, 22 Jan 2004 23:28:27 +0000 Subject: [PATCH 064/167] *** empty log message *** --- NEWS | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS b/NEWS index 9383b9a0b..9dbbaba67 100644 --- a/NEWS +++ b/NEWS @@ -18,6 +18,8 @@ Changes since the stable branch: ** Guile is now licensed with the GNU Lesser General Public License. +** The manual is now licensed with the GNU Free Documentation License. + ** Guile now requires GNU MP (http://swox.com/gmp). Guile now uses the GNU MP library for arbitrary precision arithmetic. From 2630aa9529f90e276aed64f013d6441a462c1c49 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 23 Jan 2004 00:40:30 +0000 Subject: [PATCH 065/167] (guile_TEXINFOS): Added fdl.texi. --- doc/ref/Makefile.am | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index 584bd8229..ccadaa389 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/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, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -33,7 +33,8 @@ guile_TEXINFOS = preface.texi intro.texi program.texi scheme-intro.texi \ expect.texi scsh.texi tcltk.texi scripts.texi gh.texi scm.texi \ debugging.texi indices.texi script-getopt.texi data-rep.texi \ extend.texi repl-modules.texi srfi-modules.texi misc-modules.texi \ - scheme-compound.texi autoconf.texi autoconf-macros.texi tools.texi + scheme-compound.texi autoconf.texi autoconf-macros.texi tools.texi \ + fdl.texi ETAGS_ARGS = $(info_TEXINFOS) $(guile_TEXINFOS) From 82b6774893cda810ad61c2cf078986fdfec38a72 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 23 Jan 2004 00:40:51 +0000 Subject: [PATCH 066/167] *** empty log message *** --- doc/ref/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 02ea2a02b..733eaeefd 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,7 @@ +2004-01-23 Marius Vollmer + + * Makefile.am (guile_TEXINFOS): Added fdl.texi. + 2004-01-21 Marius Vollmer Added copyright notices to all TeXinfo files. From a264c013fd0cc29b65e132f63b9f60752a6f4249 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Fri, 23 Jan 2004 14:24:37 +0000 Subject: [PATCH 067/167] * tests/syntax.test: Added test for unmemoizing internal defines. --- test-suite/ChangeLog | 4 ++++ test-suite/tests/syntax.test | 12 ++++++++++++ 2 files changed, 16 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index c32c85091..38dfe833f 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2004-01-23 Dirk Herrmann + + * tests/syntax.test: Added test for unmemoizing internal defines. + 2004-01-21 Marius Vollmer * tests/srfi-26.test: New. diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test index b01c1633b..36a3c1660 100644 --- a/test-suite/tests/syntax.test +++ b/test-suite/tests/syntax.test @@ -660,6 +660,18 @@ (pass-if-exception "missing body expression" exception:missing-body-expr (eval '(let () (define x #t)) + (interaction-environment))) + + (pass-if "unmemoization" + (eval '(begin + (define (foo) + (define (bar) + 'ok) + (bar)) + (foo) + (equal? + (procedure-source foo) + '(lambda () (letrec ((bar (lambda () (quote ok)))) (bar))))) (interaction-environment)))) (with-test-prefix "set!" From 36ffdf0abfcda91430e6d3839ba8cff7cf6a76b1 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Fri, 23 Jan 2004 14:47:56 +0000 Subject: [PATCH 068/167] * lib.scm: Extracted '/i' to toplevel. Print the guile version number before the benchmarks are run. Print the framework-time per iteration as an inexact number. --- benchmark-suite/ChangeLog | 6 ++++++ benchmark-suite/lib.scm | 24 ++++++++++++++++-------- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog index 09e00a3e2..927ff6227 100644 --- a/benchmark-suite/ChangeLog +++ b/benchmark-suite/ChangeLog @@ -1,3 +1,9 @@ +2004-01-23 Dirk Herrmann + + * lib.scm: Extracted '/i' to toplevel. Print the guile version + number before the benchmarks are run. Print the framework-time + per iteration as an inexact number. + 2004-01-06 Marius Vollmer * lib.scm (print-result, print-user-result): Handle exact diff --git a/benchmark-suite/lib.scm b/benchmark-suite/lib.scm index 840784e85..45f3d9026 100644 --- a/benchmark-suite/lib.scm +++ b/benchmark-suite/lib.scm @@ -255,7 +255,7 @@ ;;;; 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 +;;;; benchmarking framework itself to run some benchmark for the given ;;;; 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 @@ -286,12 +286,17 @@ ;;;; MISCELLANEOUS ;;;; +;;; Perform a division and convert the result to inexact. +(define (i/ a b) + (exact->inexact (/ a b))) + ;;; 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 ;;;; @@ -450,8 +455,7 @@ (user-time\interpreter (benchmark-user-time\interpreter before after gc-time)) (benchmark-core-time\interpreter - (benchmark-core-time\interpreter iterations before after gc-time)) - (i/ (lambda (a b) (exact->inexact (/ a b))))) + (benchmark-core-time\interpreter iterations before after gc-time))) (write (list name iterations 'total (i/ total-time time-base) 'user (i/ user-time time-base) @@ -483,8 +487,7 @@ (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)) - (i/ (lambda (a b) (exact->inexact (/ a b))))) + (benchmark-core-time\interpreter iterations before after gc-time))) (write (list name iterations 'user (i/ user-time time-base) 'benchmark (i/ benchmark-time time-base) @@ -501,19 +504,24 @@ ;;;; Initialize the benchmarking system: ;;;; -;;; First, make sure the benchmarking routines are compiled. +;;; First, display version information +(display ";; running guile version " (current-output-port)) +(display (version) (current-output-port)) +(newline (current-output-port)) + +;;; Second, 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 +;;; Third, 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 ";; framework time per iteration: " (current-output-port)) - (display (/ frame-time/iteration time-base) (current-output-port)) + (display (i/ frame-time/iteration time-base) (current-output-port)) (newline (current-output-port)))) (set! default-reporter initialization-reporter) (benchmark "empty initialization benchmark" 524288 #t) From c3b4b2418c0b4a7689cb1d729f5075468f93ae69 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 23 Jan 2004 21:13:01 +0000 Subject: [PATCH 069/167] Removed again. I was confused. The file added to SCM_TESTS was r5rs_pitfall.test, not r5rs_pitfall.scm. --- test-suite/tests/r5rs_pitfall.scm | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 test-suite/tests/r5rs_pitfall.scm diff --git a/test-suite/tests/r5rs_pitfall.scm b/test-suite/tests/r5rs_pitfall.scm deleted file mode 100644 index e69de29bb..000000000 From 8834dd6fae2d25db7a16919e5f95c24a1468c734 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 23 Jan 2004 21:14:24 +0000 Subject: [PATCH 070/167] *** empty log message *** --- test-suite/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 38dfe833f..dfdb183a2 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2004-01-23 Marius Vollmer + + * tests/r5rs_pitfall.scm: Removed again. I was confused. The + file added to SCM_TESTS was r5rs_pitfall.test, not + r5rs_pitfall.scm. + 2004-01-23 Dirk Herrmann * tests/syntax.test: Added test for unmemoizing internal defines. From c541e247aed0cc86b0f1760740ed5ca43ef7fb6d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Jan 2004 01:22:59 +0000 Subject: [PATCH 071/167] (srfi_DATA): Added srfi-26.scm. --- srfi/Makefile.am | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/srfi/Makefile.am b/srfi/Makefile.am index da52fa617..791e8891c 100644 --- a/srfi/Makefile.am +++ b/srfi/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001, 2002 Free Software Foundation, Inc. +## Copyright (C) 2001, 2002, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -68,6 +68,7 @@ srfi_DATA = srfi-1.scm \ srfi-16.scm \ srfi-17.scm \ srfi-19.scm \ + srfi-26.scm \ srfi-34.scm EXTRA_DIST = $(srfi_DATA) From 67314101f8db24df472dcd25cd89165dc48733ab Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 24 Jan 2004 01:23:16 +0000 Subject: [PATCH 072/167] *** empty log message *** --- srfi/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 3756e6989..776734a03 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,7 @@ +2004-01-24 Marius Vollmer + + * Makefile.am (srfi_DATA): Added srfi-26.scm. + 2004-01-21 Marius Vollmer * srfi-26.scm: New, from Daniel Skarda. Thanks! From d70e0619332fff5ecac141a3aa67c0b06deabc45 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 25 Jan 2004 13:02:21 +0000 Subject: [PATCH 073/167] Fix autoconf underquoting warnings --- ChangeLog | 6 ++++++ acinclude.m4 | 4 ++-- configure.in | 2 +- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9de813d60..1dda90b33 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2004-01-25 Neil Jerram + + * configure.in (GUILE_FUNC_DECLARED), acinclude.m4 + (GUILE_STRUCT_UTIMBUF, GUILE_NAMED_CHECK_FUNC): Correctly quote + macros being defined. + 2003-12-26 Marius Vollmer * configure.in: Find a suitable type for the new scm_t_intmax and diff --git a/acinclude.m4 b/acinclude.m4 index ac7544b27..fcbc3ddc4 100644 --- a/acinclude.m4 +++ b/acinclude.m4 @@ -1,7 +1,7 @@ dnl On the NeXT, #including doesn't give you a definition for dnl struct utime, unless you #define _POSIX_SOURCE. -AC_DEFUN(GUILE_STRUCT_UTIMBUF, [ +AC_DEFUN([GUILE_STRUCT_UTIMBUF], [ AC_CACHE_CHECK([whether we need POSIX to get struct utimbuf], guile_cv_struct_utimbuf_needs_posix, [AC_TRY_CPP([ @@ -71,7 +71,7 @@ dnl with other parameters, such as libraries, varying. dnl dnl GUILE_NAMED_CHECK_FUNC(FUNCTION, TESTNAME, dnl [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]]) -AC_DEFUN(GUILE_NAMED_CHECK_FUNC, +AC_DEFUN([GUILE_NAMED_CHECK_FUNC], [AC_MSG_CHECKING([for $1]) AC_CACHE_VAL(ac_cv_func_$1_$2, [AC_TRY_LINK( diff --git a/configure.in b/configure.in index 740acf725..923672f88 100644 --- a/configure.in +++ b/configure.in @@ -606,7 +606,7 @@ AC_TRY_LINK([#include ], ### Check for a declaration of FUNCTION in HEADERFILE; if it is ### not there, #define MISSING_FUNCTION_DECL. -AC_DEFUN(GUILE_FUNC_DECLARED, [ +AC_DEFUN([GUILE_FUNC_DECLARED], [ AC_CACHE_CHECK(for $1 declaration, guile_cv_func_$1_declared, AC_EGREP_HEADER($1, $2, guile_cv_func_$1_declared=yes, From 1264d33105824667b3f446de4e9178c0331e6069 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Mon, 26 Jan 2004 21:40:42 +0000 Subject: [PATCH 074/167] Simplify algorithm for popping up windows. --- emacs/ChangeLog | 27 +++++ emacs/gds-client.scm | 4 +- emacs/gds.el | 246 ++++++++++++++++++++++++++----------------- 3 files changed, 179 insertions(+), 98 deletions(-) diff --git a/emacs/ChangeLog b/emacs/ChangeLog index f86698e4c..33968667e 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,30 @@ +2004-01-26 Neil Jerram + + * gds.el (gds-request-focus, gds-quit): Simplify. Old algorithm + left in as a big comment. + (gds-focus-in-function, gds-focus-in, gds-focus-out-function, + gds-focus-out): New. + + * gds-client.scm (ui-read-thread-proc): Fix `with-mutex' syntax + error. + +2004-01-25 Neil Jerram + + * gds.el (gds-handle-client-input, gds-async-break, + gds-select-stack-frame, gds-query-modules, gds-go, gds-next, + gds-evaluate, gds-step-in, gds-step-out, gds-trace-finish, + gds-frame-info, gds-frame-args, gds-set-module-breakpoint, + gds-read-client, gds-choose-client): Change gds-focus-client to + gds-client. + (gds-choose-client): Set local value of gds-client to determined + client. + (gds-menu): Use gds-client rather than gds-focus-client. + (gds-client-ref): New. + (gds-client-blocked): Rewrite using gds-client-ref. + (gds-display-buffers): Take `client' arg instead of global + `gds-focus-client'. + (gds-request-focus): Call gds-display-buffers with explicit arg. + 2004-01-20 Neil Jerram * gds.el: Changes throughout because of (i) change of gds-send diff --git a/emacs/gds-client.scm b/emacs/gds-client.scm index 17949cbb4..a1bcf7220 100644 --- a/emacs/gds-client.scm +++ b/emacs/gds-client.scm @@ -198,7 +198,7 @@ decimal IP address where the UI server is running; default is (or (gds-connected?) (error "Not connected to UI server.")) ;; Take over server/UI interaction from the normal UI read thread. - (with-mutex ui-read-mutex) + (with-mutex ui-read-mutex (write-char #\x (cdr ui-read-switch-pipe)) (force-output (cdr ui-read-switch-pipe)) (write-note 'char-written) @@ -220,7 +220,7 @@ decimal IP address where the UI server is running; default is (lambda args *unspecified*)) (write-note 'cond-signal) ;; Tell the UI read thread that it can take control again. - (signal-condition-variable ui-read-switch)) + (signal-condition-variable ui-read-switch))) ;;;; {General Output to Server/UI} diff --git a/emacs/gds.el b/emacs/gds.el index af1c5cc74..c22d99ff6 100644 --- a/emacs/gds.el +++ b/emacs/gds.el @@ -68,9 +68,7 @@ "Shut down the GDS subprocess." (interactive) ;; Reset variables. - (setq gds-buffers nil - gds-focus-client nil - gds-waiting nil) + (setq gds-buffers nil) ;; Kill the subprocess. (process-kill-without-query gds-process) (condition-case nil @@ -109,11 +107,55 @@ (process-send-string gds-process (format "(%S %s)\n" client string))) -;;;; Multiple application scheduling. +;;;; Focussing in and out on interaction with a particular client. + +;;;; The slight possible problems here are that popping up a client's +;;;; interaction windows when that client wants attention might +;;;; interrupt something else that the Emacs user was working on at +;;;; the time, and that if multiple clients are being debugged at the +;;;; same time, their popping up of interaction windows might become +;;;; confusing. For this reason, we allow GDS's behavior to be +;;;; customized via the variables `gds-focus-in-function' and +;;;; `gds-focus-out-function'. +;;;; +;;;; That said, the default policy, which is probably OK for most +;;;; users most of the time, is very simple: when a client wants +;;;; attention, its interaction windows are popped up immediately. + +(defun gds-request-focus (client) + (funcall gds-focus-in-function client)) + +(defcustom gds-focus-in-function (function gds-focus-in) + "Function to call when a GDS client program wants user attention. +The function is called with one argument, the CLIENT in question." + :type 'function + :group 'gds) + +(defun gds-focus-in (client) + (gds-display-buffers client)) + +(defun gds-quit () + (interactive) + (funcall gds-focus-out-function)) + +(defcustom gds-focus-out-function (function gds-focus-out) + "Function to call when user quits interacting with a GDS client." + :type 'function + :group 'gds) + +(defun gds-focus-out () + (if (if (gds-client-blocked) + (y-or-n-p "Client is waiting for input. Quit anyway? ") + t) + (bury-buffer (current-buffer)))) + + +;;;; Multiple client focus -- an alternative implementation. + +;;;; The following code is provided as an alternative example of how a +;;;; customized GDS could schedule the display of multiple clients +;;;; that are competing for user attention. -;; Here is how we schedule the display of multiple clients that are -;; competing for user attention. -;; ;; - `gds-waiting' holds a list of clients that want attention but ;; haven't yet got it. A client is added to this list for two ;; reasons. (1) When it is blocked waiting for user input. @@ -127,40 +169,39 @@ ;; says that it is no longer blocked, and a small time passes without ;; it becoming blocked again. (2) If the user explicitly `quits' ;; that client. -(defvar gds-focus-client nil) -(defvar gds-waiting nil) - -(defun gds-request-focus (client) - (cond ((eq client gds-focus-client) - ;; CLIENT already has the focus. Display its buffer. - (gds-display-buffers)) - (gds-focus-client - ;; Another client has the focus. Add CLIENT to `gds-waiting'. - (or (memq client gds-waiting) - (setq gds-waiting (append gds-waiting (list client))))) - (t - ;; Give focus to CLIENT and display its buffer. - (setq gds-focus-client client) - (gds-display-buffers)))) - -;; Explicitly give up focus. -(defun gds-quit () - (interactive) - (if (or (car gds-waiting) - (not (gds-client-blocked)) - (y-or-n-p - "Client is blocked and no others are waiting. Still quit? ")) - (progn - (bury-buffer (current-buffer)) - ;; Pass on the focus. - (setq gds-focus-client (car gds-waiting) - gds-waiting (cdr gds-waiting)) - ;; If this client is blocked, add it back into the waiting list. - (if (gds-client-blocked) - (gds-request-focus gds-client)) - ;; If there is a new focus client, request display for it. - (if gds-focus-client - (gds-request-focus gds-focus-client))))) +;; +;; (defvar gds-focus-client nil) +;; (defvar gds-waiting nil) +;; +;; (defun gds-focus-in-alternative (client) +;; (cond ((eq client gds-focus-client) +;; ;; CLIENT already has the focus. Display its buffer. +;; (gds-display-buffers client)) +;; (gds-focus-client +;; ;; Another client has the focus. Add CLIENT to `gds-waiting'. +;; (or (memq client gds-waiting) +;; (setq gds-waiting (append gds-waiting (list client))))) +;; (t +;; ;; Give focus to CLIENT and display its buffer. +;; (setq gds-focus-client client) +;; (gds-display-buffers client)))) +;; +;; (defun gds-focus-out-alternative () +;; (if (or (car gds-waiting) +;; (not (gds-client-blocked)) +;; (y-or-n-p +;; "Client is blocked and no others are waiting. Still quit? ")) +;; (progn +;; (bury-buffer (current-buffer)) +;; ;; Pass on the focus. +;; (setq gds-focus-client (car gds-waiting) +;; gds-waiting (cdr gds-waiting)) +;; ;; If this client is blocked, add it back into the waiting list. +;; (if (gds-client-blocked) +;; (gds-request-focus gds-client)) +;; ;; If there is a new focus client, request display for it. +;; (if gds-focus-client +;; (gds-request-focus gds-focus-client))))) ;;;; GDS protocol dispatch. @@ -180,6 +221,7 @@ (goto-char (point-max)) (let ((inhibit-read-only t)) (insert (format "rx %S" (cons client (cons proc args))) "\n"))) + (cond (;; (name ...) - Client name. (eq proc 'name) (setq gds-pid (cadr args)) @@ -233,15 +275,14 @@ (setq gds-status 'closed) (gds-update-buffers) (setq gds-buffers - (delq (assq client gds-buffers) gds-buffers)) - (if (eq client gds-focus-client) - (gds-quit))) + (delq (assq client gds-buffers) gds-buffers))) (;; (eval-results ...) - Results of evaluation. (eq proc 'eval-results) (gds-display-results client (car args) (cdr args))) - ((eq proc 'completion-result) + (;; (completion-result ...) - Available completions. + (eq proc 'completion-result) (setq gds-completion-results (or (car args) t))) (;; (breakpoint-set FILE LINE COLUMN INFO) - Breakpoint set. @@ -331,8 +372,18 @@ (setq gds-buffers (delq existing gds-buffers)) (gds-client-buffer client 'name '("(GDS buffer killed)")))))) +;; Get the current buffer's associated client's value of SYM. +(defun gds-client-ref (sym) + (and gds-client + (let ((buf (assq gds-client gds-buffers))) + (and buf + (cdr buf) + (buffer-live-p (cdr buf)) + (with-current-buffer buf + (symbol-value sym)))))) + (defun gds-client-blocked () - (eq gds-status 'waiting-for-input)) + (eq (gds-client-ref 'gds-status) 'waiting-for-input)) (defvar gds-delayed-update-timer nil) @@ -374,26 +425,25 @@ (setq gds-delayed-update-timer (run-at-time 0.5 nil (function gds-update-delayed-update-buffers))))) -(defun gds-display-buffers () - (if gds-focus-client - (let ((gds-focus-buffer (cdr (assq gds-focus-client gds-buffers)))) - ;; If there's already a window showing the buffer, use it. - (let ((window (get-buffer-window gds-focus-buffer t))) - (if window - (progn - (make-frame-visible (window-frame window)) - (select-frame (window-frame window)) - (select-window window)) - ;(select-window (display-buffer gds-focus-buffer)) - (display-buffer gds-focus-buffer))) - ;; If there is an associated source buffer, display it as well. - (if (and (eq (car gds-views) 'stack) - gds-frame-source-overlay - (> (overlay-end gds-frame-source-overlay) 0)) - (let ((window (display-buffer - (overlay-buffer gds-frame-source-overlay)))) - (set-window-point window - (overlay-start gds-frame-source-overlay))))))) +(defun gds-display-buffers (client) + (let ((buf (cdr (assq client gds-buffers)))) + ;; If there's already a window showing the buffer, use it. + (let ((window (get-buffer-window buf t))) + (if window + (progn + (make-frame-visible (window-frame window)) + (select-frame (window-frame window)) + (select-window window)) + ;;(select-window (display-buffer buf)) + (display-buffer buf))) + ;; If there is an associated source buffer, display it as well. + (if (and (eq (car gds-views) 'stack) + gds-frame-source-overlay + (> (overlay-end gds-frame-source-overlay) 0)) + (let ((window (display-buffer + (overlay-buffer gds-frame-source-overlay)))) + (set-window-point window + (overlay-start gds-frame-source-overlay)))))) ;;;; Management of `views'. @@ -492,7 +542,7 @@ the following symbols. (defun gds-async-break (w &rest ignore) (interactive) - (gds-send "async-break" gds-focus-client)) + (gds-send "async-break" gds-client)) (defun gds-toggle-debug-exceptions (w &rest ignore) (interactive) @@ -560,7 +610,7 @@ the following symbols. (let* ((s (widget-value widget)) (ind (memq 'index (text-properties-at 0 s)))) (gds-send (format "debugger-command frame %d" (cadr ind)) - gds-focus-client))) + gds-client))) ;; Overlay used to highlight the source expression corresponding to ;; the selected frame. @@ -700,7 +750,7 @@ are not readable by Emacs.") (defun gds-query-modules () (interactive) - (gds-send "query-modules" gds-focus-client)) + (gds-send "query-modules" gds-client)) (defun gds-view-browser () (interactive) @@ -734,36 +784,36 @@ are not readable by Emacs.") (defun gds-go () (interactive) - (gds-send "debugger-command continue" gds-focus-client)) + (gds-send "debugger-command continue" gds-client)) (defun gds-next () (interactive) - (gds-send "debugger-command next 1" gds-focus-client)) + (gds-send "debugger-command next 1" gds-client)) (defun gds-evaluate (expr) (interactive "sEvaluate (in this stack frame): ") (gds-send (format "debugger-command evaluate %s" (prin1-to-string expr)) - gds-focus-client)) + gds-client)) (defun gds-step-in () (interactive) - (gds-send "debugger-command step 1" gds-focus-client)) + (gds-send "debugger-command step 1" gds-client)) (defun gds-step-out () (interactive) - (gds-send "debugger-command finish" gds-focus-client)) + (gds-send "debugger-command finish" gds-client)) (defun gds-trace-finish () (interactive) - (gds-send "debugger-command trace-finish" gds-focus-client)) + (gds-send "debugger-command trace-finish" gds-client)) (defun gds-frame-info () (interactive) - (gds-send "debugger-command info-frame" gds-focus-client)) + (gds-send "debugger-command info-frame" gds-client)) (defun gds-frame-args () (interactive) - (gds-send "debugger-command info-args" gds-focus-client)) + (gds-send "debugger-command info-args" gds-client)) ;;;; Setting breakpoints. @@ -822,7 +872,7 @@ are not readable by Emacs.") module sym behaviour) - gds-focus-client)))) + gds-client)))) ;;;; Scheme source breakpoints. @@ -961,15 +1011,17 @@ isn't yet known to Guile." ;; connection, receive the result and any output generated through the ;; same connection, and display the result and output to the user. ;; -;; Where there are multiple Guile applications known to GDS, GDS by -;; default sends code to the one that holds the debugging focus, -;; i.e. `gds-focus-client'. Where no application has the focus, -;; or the command is invoked with `C-u', GDS asks the user which -;; application is intended. +;; For each buffer where evaluations can be requested, GDS uses the +;; buffer-local variable `gds-client' to track which GDS client +;; program should receive and handle that buffer's evaluations. In +;; the common case where GDS is only managing one client program, a +;; buffer's value of `gds-client' is set automatically to point to +;; that program the first time that an evaluation (or help or +;; completion) is requested. If there are multiple GDS clients +;; running at that time, GDS asks the user which one is intended. (defun gds-read-client () - (let* ((def (if gds-focus-client - (cdr (assq gds-focus-client gds-names)))) + (let* ((def (and gds-client (cdr (assq gds-client gds-names)))) (prompt (if def (concat "Application for eval (default " def @@ -991,16 +1043,18 @@ isn't yet known to Guile." (defun gds-choose-client (client) (or ;; If client is an integer, it is the port number of the ;; intended client. - (if (integerp client) client) + (if (integerp client) + client) ;; Any other non-nil value indicates invocation with a prefix ;; arg, which forces asking the user which application is ;; intended. - (if client (gds-read-client)) - ;; If ask not forced, and there is a client with the focus, - ;; default to that one. - gds-focus-client - ;; If there are no clients at this point, and we are allowed to - ;; autostart a captive Guile, do so. + (if client + (setq gds-client (gds-read-client))) + ;; If ask not forced, and current buffer is associated with a + ;; client, use that client. + gds-client + ;; If there are no clients at this point, and we are + ;; allowed to autostart a captive Guile, do so. (and (null gds-buffers) gds-autostart-captive (progn @@ -1008,13 +1062,13 @@ isn't yet known to Guile." (while (null gds-buffers) (accept-process-output (get-buffer-process gds-captive) 0 100000)) - (caar gds-buffers))) + (setq gds-client (caar gds-buffers)))) ;; If there is only one known client, use that one. (if (and (car gds-buffers) (null (cdr gds-buffers))) - (caar gds-buffers)) + (setq gds-client (caar gds-buffers))) ;; Last resort - ask the user. - (gds-read-client) + (setq gds-client (gds-read-client)) ;; Signal an error. (error "No application chosen."))) @@ -1358,7 +1412,7 @@ Used for determining the default for the next `gds-load-file'.") (define-key gds-menu [view] `(menu-item "View" ,gds-view-menu :enable gds-views)) (define-key gds-menu [debug] - `(menu-item "Debug" ,gds-debug-menu :enable (and gds-focus-client + `(menu-item "Debug" ,gds-debug-menu :enable (and gds-client (gds-client-blocked)))) (define-key gds-menu [breakpoint] `(menu-item "Breakpoints" ,gds-breakpoint-menu :enable t)) From 328df3e3bec2aa4d5ef719c7cf6bdb30850c031c Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Wed, 28 Jan 2004 21:33:58 +0000 Subject: [PATCH 075/167] (Uniform Arrays): Added a FIXME warning that the 1/3 prototype no longer works. --- doc/ref/ChangeLog | 5 +++++ doc/ref/scheme-compound.texi | 2 ++ 2 files changed, 7 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 733eaeefd..671df4911 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2004-01-28 Mikael Djurfeldt + + * scheme-compound.texi (Uniform Arrays): Added a FIXME warning + that the 1/3 prototype no longer works. + 2004-01-23 Marius Vollmer * Makefile.am (guile_TEXINFOS): Added fdl.texi. diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index e81d97a6f..5137ecf01 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -1514,6 +1514,8 @@ prototype type printing character 'l signed long long (integer) l 1.0 float (single precision) s 1/3 double (double precision float) i +[FIXME: This (1/3) no longer works due to the + new support for rational numbers.] 0+i complex (double precision) c () conventional vector @end example From 15e6a33592258524edfd0e39d4a48c84b6fee462 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 4 Feb 2004 12:50:37 +0000 Subject: [PATCH 076/167] * gds.el (gds-handle-client-input): Handle new `thread-status' protocol. (gds-display-slow-eval): New. (gds-client-ref): Bugfix: buf -> (cdr buf). (gds-display-buffers): Bugfix: minimum overlay end value is 1, not 0. (gds-evals-in-progress): New. (gds-results): New. (gds-insert-interaction): Show evaluations in progress (with button to interrupt them) and results of last help or evaluation. (gds-interrupt-eval): New. (gds-debug-trap-hooks, gds-up, gds-down): New. (gds-eval-region, gds-eval-expression): Include abbreviated code in eval correlator. (gds-abbreviated-length, gds-abbreviated): New. (gds-mode-map): New keys for gds-debug-trap-hooks, gds-up, gds-down. (gds-debug-menu): New menu entries for gds-up, gds-down. * gds-client.scm (gds-connect): Enable trapping for gds-eval stacks. (ui-read-thread-proc): Write 'running status earlier. (stack->emacs-readable): Limit stack length to 'depth debug option. (handle-instruction): Update format of eval correlator. (handle-instruction-1): Resolve module names from root module instead of from current module. (resolve-module-from-root): New. (handle-instruction-1): New protocol `interrupt-eval'. (eval-thread-table): New. (eval-thread): Add thread to eval-thread-table; write new protocol to frontend to communicate eval thread status; update for new correlator format; bind correlator local before entering loop2. (gds-eval): Use start-stack 'gds-eval-stack to rebase stack. * gds.el (gds-start, gds-start-captive): Do `process-kill-without-query' as soon as processes started, ... (gds-shutdown, gds-kill-captive): ... instead of here. (gds-display-results): More clearly show unspecified results; show results in interaction view instead of in separate window. (gds-send): Add sent protocol to transcript. --- emacs/.cvsignore | 4 + emacs/ChangeLog | 44 ++++++++++ emacs/gds-client.scm | 56 +++++++++---- emacs/gds.el | 195 +++++++++++++++++++++++++++++++++---------- 4 files changed, 240 insertions(+), 59 deletions(-) diff --git a/emacs/.cvsignore b/emacs/.cvsignore index 282522db0..d6870b18c 100644 --- a/emacs/.cvsignore +++ b/emacs/.cvsignore @@ -1,2 +1,6 @@ Makefile Makefile.in +version.texi +*.info +stamp-vti +mdate-sh diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 33968667e..544065acd 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,47 @@ +2004-01-28 Neil Jerram + + * gds.el (gds-handle-client-input): Handle new `thread-status' + protocol. + (gds-display-slow-eval): New. + (gds-client-ref): Bugfix: buf -> (cdr buf). + (gds-display-buffers): Bugfix: minimum overlay end value is 1, not + 0. + (gds-evals-in-progress): New. + (gds-results): New. + (gds-insert-interaction): Show evaluations in progress (with + button to interrupt them) and results of last help or evaluation. + (gds-interrupt-eval): New. + (gds-debug-trap-hooks, gds-up, gds-down): New. + (gds-eval-region, gds-eval-expression): Include abbreviated code + in eval correlator. + (gds-abbreviated-length, gds-abbreviated): New. + (gds-mode-map): New keys for gds-debug-trap-hooks, gds-up, + gds-down. + (gds-debug-menu): New menu entries for gds-up, gds-down. + + * gds-client.scm (gds-connect): Enable trapping for gds-eval + stacks. + (ui-read-thread-proc): Write 'running status earlier. + (stack->emacs-readable): Limit stack length to 'depth debug + option. + (handle-instruction): Update format of eval correlator. + (handle-instruction-1): Resolve module names from root module + instead of from current module. + (resolve-module-from-root): New. + (handle-instruction-1): New protocol `interrupt-eval'. + (eval-thread-table): New. + (eval-thread): Add thread to eval-thread-table; write new protocol + to frontend to communicate eval thread status; update for new + correlator format; bind correlator local before entering loop2. + (gds-eval): Use start-stack 'gds-eval-stack to rebase stack. + + * gds.el (gds-start, gds-start-captive): Do + `process-kill-without-query' as soon as processes started, ... + (gds-shutdown, gds-kill-captive): ... instead of here. + (gds-display-results): More clearly show unspecified results; show + results in interaction view instead of in separate window. + (gds-send): Add sent protocol to transcript. + 2004-01-26 Neil Jerram * gds.el (gds-request-focus, gds-quit): Simplify. Old algorithm diff --git a/emacs/gds-client.scm b/emacs/gds-client.scm index a1bcf7220..ba4d58737 100644 --- a/emacs/gds-client.scm +++ b/emacs/gds-client.scm @@ -23,6 +23,7 @@ #:use-module (ice-9 debugger breakpoints procedural) #:use-module (ice-9 debugger breakpoints source) #:use-module (ice-9 debugger state) + #:use-module (ice-9 debugger trap-hooks) #:use-module (ice-9 debugger utils) #:use-module (ice-9 optargs) #:use-module (ice-9 regex) @@ -101,6 +102,7 @@ decimal IP address where the UI server is running; default is "w")) ;; Announce ourselves to the server. (write-form (list 'name name (getpid))) + (add-trapped-stack-id! 'gds-eval-stack) ;; Start the UI read thread. (set! ui-read-thread (make-thread ui-read-thread-proc))) @@ -124,6 +126,7 @@ decimal IP address where the UI server is running; default is ;; this purpose. This design avoids having to modify application code ;; at the expense of requiring a Guile with threads support. (define (ui-read-thread-proc) + (write-status 'running) (let ((eval-thread-needed? #t)) ;; Start up the default eval thread. (make-thread eval-thread 1 (lambda () (not eval-thread-needed?))) @@ -269,7 +272,8 @@ decimal IP address where the UI server is running; default is ;; Return Emacs-readable representation of STACK. (map (lambda (index) (frame->emacs-readable (stack-ref stack index))) - (iota (stack-length stack)))) + (iota (min (stack-length stack) + (cadr (memq 'depth (debug-options))))))) (define (frame->emacs-readable frame) ;; Return Emacs-readable representation of FRAME. @@ -336,7 +340,7 @@ decimal IP address where the UI server is running; default is (apply throw key args)) (else (write-form - `(eval-results error + `(eval-results (error . "") "GDS Internal Error\n" ,(list (with-output-to-string (lambda () @@ -373,7 +377,7 @@ decimal IP address where the UI server is running; default is ,(or (loaded-module-source name) "(no source file)") ,@(sort (module-map (lambda (key value) (symbol->string key)) - (resolve-module name)) + (resolve-module-from-root name)) string (overlay-end gds-frame-source-overlay) 0)) + (> (overlay-end gds-frame-source-overlay) 1)) (let ((window (display-buffer (overlay-buffer gds-frame-source-overlay)))) (set-window-point window @@ -505,6 +541,14 @@ the following symbols. "The exception keys for which to debug a GDS client.") (make-variable-buffer-local 'gds-exception-keys) +(defvar gds-evals-in-progress nil + "Alist describing evaluations in progress.") +(make-variable-buffer-local 'gds-evals-in-progress) + +(defvar gds-results nil + "Last help or evaluation results.") +(make-variable-buffer-local 'gds-results) + (defun gds-insert-interaction () (erase-buffer) ;; Insert stuff for interacting with a running (non-blocked) Guile @@ -534,7 +578,18 @@ the following symbols. (widget-create 'editable-field :notify (function gds-set-exception-keys) gds-exception-keys) - (widget-insert "\n")) + (let ((evals gds-evals-in-progress)) + (if evals + (widget-insert "\nEvaluations in progress:\n")) + (while evals + (let ((w (widget-create 'push-button + :notify (function gds-interrupt-eval) + "Interrupt"))) + (widget-put w :thread-number (caar evals)) + (widget-insert " " (cddar evals) "\n")) + (setq evals (cdr evals)))) + (if gds-results + (widget-insert "\n" (cdr gds-results)))) (defun gds-sigint (w &rest ignore) (interactive) @@ -544,6 +599,11 @@ the following symbols. (interactive) (gds-send "async-break" gds-client)) +(defun gds-interrupt-eval (w &rest ignore) + (interactive) + (gds-send (format "interrupt-eval %S" (widget-get w :thread-number)) + gds-client)) + (defun gds-toggle-debug-exceptions (w &rest ignore) (interactive) (setq gds-debug-exceptions (widget-value w)) @@ -815,6 +875,18 @@ are not readable by Emacs.") (interactive) (gds-send "debugger-command info-args" gds-client)) +(defun gds-debug-trap-hooks () + (interactive) + (gds-send "debugger-command debug-trap-hooks" gds-client)) + +(defun gds-up () + (interactive) + (gds-send "debugger-command up 1" gds-client)) + +(defun gds-down () + (interactive) + (gds-send "debugger-command down 1" gds-client)) + ;;;; Setting breakpoints. @@ -1107,26 +1179,45 @@ region's code." (setq column (current-column)) ; 0-based (beginning-of-line) (setq line (count-lines (point-min) (point)))) ; 0-based - (gds-send (format "eval region %s %S %d %d %s %S" - (if module (prin1-to-string module) "#f") - port-name line column - (let ((bpinfo (gds-region-breakpoint-info start end))) - ;; Make sure that "no bpinfo" is represented - ;; as "()", not "nil", as Scheme doesn't - ;; understand "nil". - (if bpinfo (format "%S" bpinfo) "()")) - (buffer-substring-no-properties start end)) - client))) + (let ((code (buffer-substring-no-properties start end))) + (gds-send (format "eval (region . %S) %s %S %d %d %s %S" + (gds-abbreviated code) + (if module (prin1-to-string module) "#f") + port-name line column + (let ((bpinfo (gds-region-breakpoint-info start end))) + ;; Make sure that "no bpinfo" is represented + ;; as "()", not "nil", as Scheme doesn't + ;; understand "nil". + (if bpinfo (format "%S" bpinfo) "()")) + code) + client)))) (defun gds-eval-expression (expr &optional client correlator) "Evaluate the supplied EXPR (a string)." (interactive "sEvaluate expression: \nP") (setq client (gds-choose-client client)) - (gds-send (format "eval %S #f \"Emacs expression\" 0 0 () %S" + (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 () %S" (or correlator 'expression) + (gds-abbreviated expr) expr) client)) +(defconst gds-abbreviated-length 35) + +(defun gds-abbreviated (code) + (let ((nlpos (string-match (regexp-quote "\n") code))) + (while nlpos + (setq code + (if (= nlpos (- (length code) 1)) + (substring code 0 nlpos) + (concat (substring code 0 nlpos) + "\\n" + (substring code (+ nlpos 1))))) + (setq nlpos (string-match (regexp-quote "\n") code)))) + (if (> (length code) gds-abbreviated-length) + (concat (substring code 0 (- gds-abbreviated-length 3)) "...") + code)) + (defun gds-eval-defun (&optional client) "Evaluate the defun (top-level form) at point." (interactive "P") @@ -1219,29 +1310,38 @@ interesting happened, `nil' if not." ;;;; Display of evaluation and help results. (defun gds-display-results (client correlator results) - (let ((helpp (eq correlator 'help))) + (let ((helpp (eq (car correlator) 'help))) (let ((buf (get-buffer-create (if helpp "*Guile Help*" "*Guile Results*")))) - (save-excursion - (set-buffer buf) - (erase-buffer) - (scheme-mode) - (while results - (insert (car results)) - (if helpp - nil - (mapcar (function (lambda (value) - (insert " => " value "\n"))) - (cadr results)) - (insert "\n")) - (setq results (cddr results))) - (goto-char (point-min)) - (if (and helpp (looking-at "Evaluating in ")) - (delete-region (point) (progn (forward-line 1) (point))))) - (pop-to-buffer buf) - (run-hooks 'temp-buffer-show-hook) - (other-window 1)))) + (setq gds-results + (save-excursion + (set-buffer buf) + (erase-buffer) + (scheme-mode) + (insert (cdr correlator) "\n\n") + (while results + (insert (car results)) + (or (bolp) (insert "\\\n")) + (if helpp + nil + (if (cadr results) + (mapcar (function (lambda (value) + (insert " => " value "\n"))) + (cadr results)) + (insert " => no (or unspecified) value\n")) + (insert "\n")) + (setq results (cddr results))) + (goto-char (point-min)) + (if (and helpp (looking-at "Evaluating in ")) + (delete-region (point) (progn (forward-line 1) (point)))) + (cons correlator (buffer-string)))) + ;;(pop-to-buffer buf) + ;;(run-hooks 'temp-buffer-show-hook) + ;;(other-window 1) + )) + (gds-promote-view 'interaction) + (gds-request-focus client)) ;;;; Loading (evaluating) a whole Scheme file. @@ -1301,7 +1401,9 @@ Used for determining the default for the next `gds-load-file'.") (define-key gds-mode-map "t" (function gds-trace-finish)) (define-key gds-mode-map "I" (function gds-frame-info)) (define-key gds-mode-map "A" (function gds-frame-args)) - +(define-key gds-mode-map "H" (function gds-debug-trap-hooks)) +(define-key gds-mode-map "u" (function gds-up)) +(define-key gds-mode-map "d" (function gds-down)) (define-key gds-mode-map "b" (function gds-set-breakpoint)) (define-key gds-mode-map "vi" (function gds-view-interaction)) @@ -1338,6 +1440,10 @@ Used for determining the default for the next `gds-load-file'.") (setq gds-debug-menu (make-sparse-keymap "Debug")) (define-key gds-debug-menu [go] '(menu-item "Go" gds-go)) + (define-key gds-debug-menu [down] + '(menu-item "Move Down 1 Frame" gds-down)) + (define-key gds-debug-menu [up] + '(menu-item "Move Up 1 Frame" gds-up)) (define-key gds-debug-menu [trace-finish] '(menu-item "Trace This Frame" gds-trace-finish)) (define-key gds-debug-menu [step-out] @@ -1464,6 +1570,7 @@ Used for determining the default for the next `gds-load-file'.") nil "-q"))) (let ((proc (get-buffer-process gds-captive))) + (process-kill-without-query proc) (comint-send-string proc "(set! %load-path (cons \"/home/neil/Guile/cvs/guile-core\" %load-path))\n") (comint-send-string proc "(debug-enable 'backtrace)\n") (comint-send-string proc "(use-modules (emacs gds-client))\n") @@ -1471,13 +1578,11 @@ Used for determining the default for the next `gds-load-file'.") (defun gds-kill-captive () (if gds-captive - (let ((proc (get-buffer-process gds-captive))) - (process-kill-without-query proc) - (condition-case nil - (progn - (kill-process proc) - (accept-process-output gds-process 0 200)) - (error))))) + (condition-case nil + (progn + (kill-process (get-buffer-process gds-captive)) + (accept-process-output gds-process 0 200)) + (error)))) ;;;; The end! From 16353acc6f0d025d4dc101d01285611d7162a0f4 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 8 Feb 2004 19:14:18 +0000 Subject: [PATCH 077/167] * read.c (scm_read_opts): New opts `elisp-vectors' and `escaped-parens'. (s_vector): New. (scm_lreadr): Use scm_lreadparen1 instead of scm_lreadparen. Make handling of elisp vector syntax dependent on SCM_ENABLE_ELISP and `elisp-vectors' option instead of SCM_ELISP_READ_EXTENSIONS. Allow "\(" and "\)" in strings when SCM_ENABLE_ELISP defined and `escaped-parens' option set. (scm_read_token): If elisp vector syntax active, disallow [ and ] in tokens. (scm_lreadparen): Rewrite as interface to scm_lreadparen1. (scm_lreadparen1): New. * read.h: Remove conditionally compiled last arg to scm_lreadparen. (SCM_ELISP_VECTORS_P, SCM_ESCAPED_PARENS_P): New. --- libguile/ChangeLog | 19 +++++++++++++++ libguile/read.c | 58 ++++++++++++++++++++++++++++++++-------------- libguile/read.h | 15 ++++++------ 3 files changed, 67 insertions(+), 25 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7275c92bc..0aa4f1ccd 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,22 @@ +2004-02-08 Neil Jerram + + * read.c (scm_read_opts): New opts `elisp-vectors' and + `escaped-parens'. + (s_vector): New. + (scm_lreadr): Use scm_lreadparen1 instead of scm_lreadparen. Make + handling of elisp vector syntax dependent on SCM_ENABLE_ELISP and + `elisp-vectors' option instead of SCM_ELISP_READ_EXTENSIONS. + Allow "\(" and "\)" in strings when SCM_ENABLE_ELISP defined and + `escaped-parens' option set. + (scm_read_token): If elisp vector syntax active, disallow [ and ] + in tokens. + (scm_lreadparen): Rewrite as interface to scm_lreadparen1. + (scm_lreadparen1): New. + + * read.h: Remove conditionally compiled last arg to + scm_lreadparen. + (SCM_ELISP_VECTORS_P, SCM_ESCAPED_PARENS_P): New. + 2004-01-23 Han-Wen Nienhuys * eval.c (m_expand_body): remove stray variable new_body. diff --git a/libguile/read.c b/libguile/read.c index 718d4097b..dd37e8469 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -52,6 +52,13 @@ scm_t_option scm_read_opts[] = { "Convert symbols to lower case."}, { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), "Style of keyword recognition: #f or 'prefix."} +#if SCM_ENABLE_ELISP + , + { SCM_OPTION_BOOLEAN, "elisp-vectors", 0, + "Support Elisp vector syntax, namely `[...]'."}, + { SCM_OPTION_BOOLEAN, "escaped-parens", 0, + "Support `\\(' and `\\)' in strings."} +#endif }; /* @@ -291,8 +298,10 @@ skip_scsh_block_comment (SCM port) static SCM scm_get_hash_procedure(int c); +static SCM scm_lreadparen1 (SCM *, SCM, char *, SCM *, char); static char s_list[]="list"; +static char s_vector[]="vector"; SCM scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) @@ -313,15 +322,19 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) case '(': return SCM_RECORD_POSITIONS_P ? scm_lreadrecparen (tok_buf, port, s_list, copy) - : scm_lreadparen (tok_buf, port, s_list, copy SCM_ELISP_CLOSE); + : scm_lreadparen1 (tok_buf, port, s_list, copy, ')'); case ')': scm_input_error (FUNC_NAME, port,"unexpected \")\"", SCM_EOL); goto tryagain; -#ifdef SCM_ELISP_READ_EXTENSIONS +#if SCM_ENABLE_ELISP case '[': - p = scm_lreadparen (tok_buf, port, "vector", copy, ']'); - return SCM_NULLP (p) ? scm_nullvect : scm_vector (p); + if (SCM_ELISP_VECTORS_P) + { + p = scm_lreadparen1 (tok_buf, port, s_vector, copy, ']'); + return SCM_NULLP (p) ? scm_nullvect : scm_vector (p); + } + goto read_token; #endif case '\'': p = scm_sym_quote; @@ -382,7 +395,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) switch (c) { case '(': - p = scm_lreadparen (tok_buf, port, "vector", copy SCM_ELISP_CLOSE); + p = scm_lreadparen1 (tok_buf, port, s_vector, copy, ')'); return SCM_NULLP (p) ? scm_nullvect : scm_vector (p); case 't': @@ -502,6 +515,13 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) case '"': case '\\': break; +#if SCM_ENABLE_ELISP + case '(': + case ')': + if (SCM_ESCAPED_PARENS_P) + break; + goto bad_escaped; +#endif case '\n': continue; case '0': @@ -592,6 +612,9 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) } /* fallthrough */ default: +#if SCM_ENABLE_ELISP + read_token: +#endif j = scm_read_token (c, tok_buf, port, 0); /* fallthrough */ @@ -636,7 +659,7 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) { case '(': case ')': -#ifdef SCM_ELISP_READ_EXTENSIONS +#if SCM_ENABLE_ELISP case '[': case ']': #endif @@ -644,7 +667,11 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) case ';': case SCM_WHITE_SPACES: case SCM_LINE_INCREMENTORS: - if (weird) + if (weird +#if SCM_ENABLE_ELISP + || ((!SCM_ELISP_VECTORS_P) && ((c == '[') || (c == ']'))) +#endif + ) goto default_case; scm_ungetc (c, port); @@ -697,13 +724,13 @@ _Pragma ("opt"); /* # pragma _CRI opt */ #endif SCM -scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy -#ifdef SCM_ELISP_READ_EXTENSIONS - , char term_char -#else -#define term_char ')' -#endif - ) +scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy) +{ + return scm_lreadparen1 (tok_buf, port, name, copy, ')'); +} + +static SCM +scm_lreadparen1 (SCM *tok_buf, SCM port, char *name, SCM *copy, char term_char) #define FUNC_NAME "scm_lreadparen" { SCM tmp; @@ -738,9 +765,6 @@ scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy return ans; } #undef FUNC_NAME -#ifndef SCM_ELISP_READ_EXTENSIONS -#undef term_char -#endif SCM diff --git a/libguile/read.h b/libguile/read.h index f4d57086e..2f7251492 100644 --- a/libguile/read.h +++ b/libguile/read.h @@ -51,7 +51,13 @@ SCM_API scm_t_option scm_read_opts[]; #define SCM_RECORD_POSITIONS_P scm_read_opts[1].val #define SCM_CASE_INSENSITIVE_P scm_read_opts[2].val #define SCM_KEYWORD_STYLE scm_read_opts[3].val +#if SCM_ENABLE_ELISP +#define SCM_ELISP_VECTORS_P scm_read_opts[4].val +#define SCM_ESCAPED_PARENS_P scm_read_opts[5].val +#define SCM_N_READ_OPTIONS 6 +#else #define SCM_N_READ_OPTIONS 4 +#endif @@ -64,14 +70,7 @@ SCM_API int scm_flush_ws (SCM port, const char *eoferr); SCM_API int scm_casei_streq (char * s1, char * s2); SCM_API SCM scm_lreadr (SCM * tok_buf, SCM port, SCM *copy); SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird); -SCM_API SCM scm_lreadparen (SCM * tok_buf, SCM port, char *name, SCM *copy -#ifdef SCM_ELISP_READ_EXTENSIONS - , char term_char -#define SCM_ELISP_CLOSE , ')' -#else -#define SCM_ELISP_CLOSE -#endif - ); +SCM_API SCM scm_lreadparen (SCM * tok_buf, SCM port, char *name, SCM *copy); SCM_API SCM scm_lreadrecparen (SCM * tok_buf, SCM port, char *name, SCM *copy); SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc); SCM_API void scm_init_read (void); From f1dc5f45ab455339c02340d612af409ab9f51fc9 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Mon, 9 Feb 2004 01:48:34 +0000 Subject: [PATCH 078/167] * Makefile.am (TAGS_FILES): Use this variable instead of ETAGS_ARGS so that TAGS can be built using separate build directory. * Makefile.am (TAGS_FILES): Use this variable instead of ETAGS_ARGS so that TAGS can be built using separate build directory. * debugger/breakpoints/Makefile.am (TAGS_FILES), debugger/Makefile.am (TAGS_FILES), Makefile.am (TAGS_FILES): Use this variable instead of ETAGS_ARGS so that TAGS can be built using separate build directory. * primitives/Makefile.am (TAGS_FILES), internals/Makefile.am (TAGS_FILES), Makefile.am (TAGS_FILES): Use this variable instead of ETAGS_ARGS so that TAGS can be built using separate build directory. * Makefile.am, goops/Makefile.am (TAGS_FILES): Use this variable instead of ETAGS_ARGS so that TAGS can be built using separate build directory. * Makefile.am (TAGS_FILES): Use this variable instead of ETAGS_ARGS so that TAGS can be built using separate build directory. --- emacs/ChangeLog | 6 ++++++ emacs/Makefile.am | 4 ++-- guile-readline/ChangeLog | 6 ++++++ guile-readline/Makefile.am | 4 ++-- ice-9/ChangeLog | 7 +++++++ ice-9/Makefile.am | 4 ++-- ice-9/debugger/Makefile.am | 4 ++-- ice-9/debugger/breakpoints/Makefile.am | 4 ++-- lang/elisp/ChangeLog | 7 +++++++ lang/elisp/Makefile.am | 4 ++-- lang/elisp/internals/Makefile.am | 4 ++-- lang/elisp/primitives/Makefile.am | 4 ++-- oop/ChangeLog | 6 ++++++ oop/Makefile.am | 4 ++-- oop/goops/Makefile.am | 4 ++-- srfi/ChangeLog | 6 ++++++ srfi/Makefile.am | 4 ++-- 17 files changed, 60 insertions(+), 22 deletions(-) diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 544065acd..3ddf384d1 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,9 @@ +2004-02-08 Mikael Djurfeldt + + * Makefile.am (TAGS_FILES): Use this variable instead of + ETAGS_ARGS so that TAGS can be built using separate build + directory. + 2004-01-28 Neil Jerram * gds.el (gds-handle-client-input): Handle new `thread-status' diff --git a/emacs/Makefile.am b/emacs/Makefile.am index 981414f3f..c85ad1ca5 100644 --- a/emacs/Makefile.am +++ b/emacs/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2003 Free Software Foundation, Inc. +## Copyright (C) 2003, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -34,5 +34,5 @@ info_TEXINFOS = gds.texi TEXINFO_TEX = ../doc/ref/texinfo.tex -ETAGS_ARGS = $(subpkgdata_DATA) $(lisp_LISP) +TAGS_FILES = $(subpkgdata_DATA) $(lisp_LISP) EXTRA_DIST = $(subpkgdata_DATA) $(lisp_LISP) diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index 1f448be35..8d94208bb 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,9 @@ +2004-02-08 Mikael Djurfeldt + + * Makefile.am (TAGS_FILES): Use this variable instead of + ETAGS_ARGS so that TAGS can be built using separate build + directory. + 2003-05-04 Marius Vollmer * configure.in: When checking whether readline clears SA_RESTART, diff --git a/guile-readline/Makefile.am b/guile-readline/Makefile.am index 84ecd1e62..5f5493099 100644 --- a/guile-readline/Makefile.am +++ b/guile-readline/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, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -51,7 +51,7 @@ SUFFIXES = .x $(GUILE_SNARF) -o $@ $< $(snarfcppopts) EXTRA_DIST = $(ice9_DATA) LIBGUILEREADLINE-VERSION -ETAGS_ARGS = $(ice9_DATA) +TAGS_FILES = $(ice9_DATA) MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 226e1881e..570426117 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,10 @@ +2004-02-08 Mikael Djurfeldt + + * debugger/breakpoints/Makefile.am (TAGS_FILES), + debugger/Makefile.am (TAGS_FILES), Makefile.am (TAGS_FILES): Use + this variable instead of ETAGS_ARGS so that TAGS can be built + using separate build directory. + 2004-01-20 Neil Jerram * boot-9.scm (error-catching-loop): Back out 2003-11-19 change to diff --git a/ice-9/Makefile.am b/ice-9/Makefile.am index 1864a730a..46bc3db05 100644 --- a/ice-9/Makefile.am +++ b/ice-9/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998,1999,2000,2001,2003 Free Software Foundation, Inc. +## Copyright (C) 1998,1999,2000,2001,2003, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -39,7 +39,7 @@ ice9_sources = \ subpkgdatadir = $(pkgdatadir)/${GUILE_EFFECTIVE_VERSION}/ice-9 subpkgdata_DATA = $(ice9_sources) -ETAGS_ARGS = $(subpkgdata_DATA) +TAGS_FILES = $(subpkgdata_DATA) ## test.scm is not currently installed. EXTRA_DIST = $(ice9_sources) test.scm compile-psyntax.scm diff --git a/ice-9/debugger/Makefile.am b/ice-9/debugger/Makefile.am index 0697378b4..9a9df1043 100644 --- a/ice-9/debugger/Makefile.am +++ b/ice-9/debugger/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2002 Free Software Foundation, Inc. +## Copyright (C) 2002, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -29,6 +29,6 @@ ice9_debugger_sources = behaviour.scm breakpoints.scm command-loop.scm \ subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/ice-9/debugger subpkgdata_DATA = $(ice9_debugger_sources) -ETAGS_ARGS = $(subpkgdata_DATA) +TAGS_FILES = $(subpkgdata_DATA) EXTRA_DIST = $(ice9_debugger_sources) diff --git a/ice-9/debugger/breakpoints/Makefile.am b/ice-9/debugger/breakpoints/Makefile.am index 76be30790..e28c672a0 100644 --- a/ice-9/debugger/breakpoints/Makefile.am +++ b/ice-9/debugger/breakpoints/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2002 Free Software Foundation, Inc. +## Copyright (C) 2002, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -24,5 +24,5 @@ AUTOMAKE_OPTIONS = gnu subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/ice-9/debugger/breakpoints subpkgdata_DATA = procedural.scm range.scm source.scm -ETAGS_ARGS = $(subpkgdata_DATA) +TAGS_FILES = $(subpkgdata_DATA) EXTRA_DIST = $(subpkgdata_DATA) diff --git a/lang/elisp/ChangeLog b/lang/elisp/ChangeLog index 57a99e8a4..1114618d0 100644 --- a/lang/elisp/ChangeLog +++ b/lang/elisp/ChangeLog @@ -1,3 +1,10 @@ +2004-02-08 Mikael Djurfeldt + + * primitives/Makefile.am (TAGS_FILES), internals/Makefile.am + (TAGS_FILES), Makefile.am (TAGS_FILES): Use this variable instead + of ETAGS_ARGS so that TAGS can be built using separate build + directory. + 2003-11-01 Neil Jerram * internals/format.scm (format), internals/signal.scm (error), diff --git a/lang/elisp/Makefile.am b/lang/elisp/Makefile.am index 51ebeaf32..0a2561285 100644 --- a/lang/elisp/Makefile.am +++ b/lang/elisp/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -34,6 +34,6 @@ elisp_sources = \ subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/lang/elisp subpkgdata_DATA = $(elisp_sources) -ETAGS_ARGS = $(subpkgdata_DATA) +TAGS_FILES = $(subpkgdata_DATA) EXTRA_DIST = $(elisp_sources) diff --git a/lang/elisp/internals/Makefile.am b/lang/elisp/internals/Makefile.am index b759212e5..34581f506 100644 --- a/lang/elisp/internals/Makefile.am +++ b/lang/elisp/internals/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -37,6 +37,6 @@ elisp_sources = \ subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/lang/elisp/internals subpkgdata_DATA = $(elisp_sources) -ETAGS_ARGS = $(subpkgdata_DATA) +TAGS_FILES = $(subpkgdata_DATA) EXTRA_DIST = $(elisp_sources) diff --git a/lang/elisp/primitives/Makefile.am b/lang/elisp/primitives/Makefile.am index 152b63de5..1f15f41aa 100644 --- a/lang/elisp/primitives/Makefile.am +++ b/lang/elisp/primitives/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -46,6 +46,6 @@ elisp_sources = \ subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/lang/elisp/primitives subpkgdata_DATA = $(elisp_sources) -ETAGS_ARGS = $(subpkgdata_DATA) +TAGS_FILES = $(subpkgdata_DATA) EXTRA_DIST = $(elisp_sources) diff --git a/oop/ChangeLog b/oop/ChangeLog index d79e625be..fb6744af9 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,9 @@ +2004-02-08 Mikael Djurfeldt + + * Makefile.am, goops/Makefile.am (TAGS_FILES): Use this variable + instead of ETAGS_ARGS so that TAGS can be built using separate + build directory. + 2004-01-12 Marius Vollmer * goops.scm (compute-get-n-set): Use '#:' in error message instead diff --git a/oop/Makefile.am b/oop/Makefile.am index 6107a959a..ba2a81099 100644 --- a/oop/Makefile.am +++ b/oop/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2000 Free Software Foundation, Inc. +## Copyright (C) 2000, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -28,6 +28,6 @@ oop_sources = goops.scm subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/oop subpkgdata_DATA = $(oop_sources) -ETAGS_ARGS = $(subpkgdata_DATA) +TAGS_FILES = $(subpkgdata_DATA) EXTRA_DIST = $(oop_sources) diff --git a/oop/goops/Makefile.am b/oop/goops/Makefile.am index 0229de8e9..125909e3b 100644 --- a/oop/goops/Makefile.am +++ b/oop/goops/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2000, 2001 Free Software Foundation, Inc. +## Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -29,6 +29,6 @@ goops_sources = \ subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/oop/goops subpkgdata_DATA = $(goops_sources) -ETAGS_ARGS = $(subpkgdata_DATA) +TAGS_FILES = $(subpkgdata_DATA) EXTRA_DIST = $(goops_sources) diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 776734a03..3e255d44e 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,9 @@ +2004-02-08 Mikael Djurfeldt + + * Makefile.am (TAGS_FILES): Use this variable instead of + ETAGS_ARGS so that TAGS can be built using separate build + directory. + 2004-01-24 Marius Vollmer * Makefile.am (srfi_DATA): Added srfi-26.scm. diff --git a/srfi/Makefile.am b/srfi/Makefile.am index 791e8891c..13f9a53ce 100644 --- a/srfi/Makefile.am +++ b/srfi/Makefile.am @@ -71,8 +71,8 @@ srfi_DATA = srfi-1.scm \ srfi-26.scm \ srfi-34.scm -EXTRA_DIST = $(srfi_DATA) -ETAGS_ARGS = $(srfi_DATA) +EXTRA_DIST = $(srfi_DATA) +TAGS_FILES = $(srfi_DATA) GUILE_SNARF = ../libguile/guile-snarf From 2c284c947e3a4cf3f67d3222a7071d020793f00a Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Mon, 9 Feb 2004 19:18:01 +0000 Subject: [PATCH 079/167] * debugger/trap-hooks.scm (debug-hook-membership): New, exported. * debugger/commands.scm (debug-trap-hooks): New, exported. --- ice-9/ChangeLog | 6 ++++++ ice-9/debugger/commands.scm | 8 +++++++- ice-9/debugger/trap-hooks.scm | 21 ++++++++++++++++++++- 3 files changed, 33 insertions(+), 2 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 570426117..f83e8865a 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,9 @@ +2004-02-09 Neil Jerram + + * debugger/trap-hooks.scm (debug-hook-membership): New, exported. + + * debugger/commands.scm (debug-trap-hooks): New, exported. + 2004-02-08 Mikael Djurfeldt * debugger/breakpoints/Makefile.am (TAGS_FILES), diff --git a/ice-9/debugger/commands.scm b/ice-9/debugger/commands.scm index 632d328f0..b72e06ef6 100644 --- a/ice-9/debugger/commands.scm +++ b/ice-9/debugger/commands.scm @@ -21,6 +21,7 @@ #:use-module (ice-9 debugger) #:use-module (ice-9 debugger behaviour) #:use-module (ice-9 debugger state) + #:use-module (ice-9 debugger trap-hooks) #:use-module (ice-9 debugger utils) #:export (backtrace evaluate @@ -34,7 +35,8 @@ finish trace-finish next - step)) + step + debug-trap-hooks)) (define (backtrace state n-frames) "Print backtrace of all stack frames, or innermost COUNT frames. @@ -149,6 +151,10 @@ An argument specifies the frame to select; it must be a stack-frame number." (if n (set-stack-index! state (frame-number->index n (state-stack state)))) (write-state-short state)) +(define (debug-trap-hooks state) + (debug-hook-membership) + state) + ;;;; Additional commands that make sense when debugging code that has ;;;; stopped at a breakpoint. diff --git a/ice-9/debugger/trap-hooks.scm b/ice-9/debugger/trap-hooks.scm index 97dbcbb60..77abc0df1 100644 --- a/ice-9/debugger/trap-hooks.scm +++ b/ice-9/debugger/trap-hooks.scm @@ -41,7 +41,8 @@ remove-breakpoint-hook! remove-enter-frame-hook! remove-exit-frame-hook! - remove-trace-hook!)) + remove-trace-hook! + debug-hook-membership)) ;;; The current low level traps interface is as follows. ;;; @@ -298,4 +299,22 @@ it twice." (remove-hook! trace-hook proc) (set-debug-and-trap-options)) +(define-public (debug-hook-membership) + (for-each (lambda (name+hook) + (format #t "~A:\n" (car name+hook)) + (for-each (lambda (proc) + (format #t " ~S\n" proc)) + (hook->list (cdr name+hook)))) + `((before-enter-frame-hook . ,before-enter-frame-hook) + (enter-frame-hook . ,enter-frame-hook ) + (breakpoint-hook . ,breakpoint-hook ) + (after-enter-frame-hook . ,after-enter-frame-hook ) + (before-exit-frame-hook . ,before-exit-frame-hook ) + (exit-frame-hook . ,exit-frame-hook ) + (after-exit-frame-hook . ,after-exit-frame-hook ) + (before-apply-frame-hook . ,before-apply-frame-hook) + (apply-frame-hook . ,apply-frame-hook ) + (trace-hook . ,trace-hook ) + (after-apply-frame-hook . ,after-apply-frame-hook )))) + ;;; (ice-9 debugger trap-hooks) ends here. From cd21f5eb1784ccb6ffcb520b51deaae5ebc62245 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 10 Feb 2004 19:44:10 +0000 Subject: [PATCH 080/167] * read.c (scm_read_opts): Change `escaped-parens' to `elisp-strings'. --- libguile/ChangeLog | 5 +++++ libguile/read.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 0aa4f1ccd..c650a0d35 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2004-02-10 Neil Jerram + + * read.c (scm_read_opts): Change `escaped-parens' to + `elisp-strings'. + 2004-02-08 Neil Jerram * read.c (scm_read_opts): New opts `elisp-vectors' and diff --git a/libguile/read.c b/libguile/read.c index dd37e8469..10e8d8264 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -56,7 +56,7 @@ scm_t_option scm_read_opts[] = { , { SCM_OPTION_BOOLEAN, "elisp-vectors", 0, "Support Elisp vector syntax, namely `[...]'."}, - { SCM_OPTION_BOOLEAN, "escaped-parens", 0, + { SCM_OPTION_BOOLEAN, "elisp-strings", 0, "Support `\\(' and `\\)' in strings."} #endif }; From 8418f0c74088ef24c4729e3b909acca95a599e56 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 11 Feb 2004 22:14:32 +0000 Subject: [PATCH 081/167] (SLIB): Index entry for replacement `system'. And use findex for `require'. --- doc/ref/slib.texi | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/ref/slib.texi b/doc/ref/slib.texi index eefb6f05b..6094a6dde 100644 --- a/doc/ref/slib.texi +++ b/doc/ref/slib.texi @@ -16,7 +16,7 @@ must be executed: (use-modules (ice-9 slib)) @end smalllisp -@cindex @code{require} +@findex require @code{require} can then be used in the usual way (@pxref{Requesting Features,,, slib, The SLIB Manual}). For example, @@ -27,6 +27,7 @@ Features,,, slib, The SLIB Manual}). For example, @result{} #t @end example +@findex system Note that @code{(ice-9 slib)} provides a new definition of @code{system}, one giving a plain exit code return value, as per the SLIB specification (@pxref{System Interface,,, slib, The SLIB From ac3c6ad6cf1cd62c2afe5161a8618ac5e1fefea8 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 11 Feb 2004 23:16:53 +0000 Subject: [PATCH 082/167] (scm_array_fill_x): For fvect and dvect, use scm_num2dbl to convert args the same way that array-set! does. --- libguile/ramap.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/libguile/ramap.c b/libguile/ramap.c index 40034bb48..c8f194a12 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1996,1998,2000,2001,2004 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 @@ -564,8 +564,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) case scm_tc7_fvect: { /* scope */ float f, *ve = (float *) SCM_VELTS (ra); - SCM_ASRTGO (SCM_REALP (fill), badarg2); - f = SCM_REAL_VALUE (fill); + f = (float) scm_num2dbl (fill, FUNC_NAME); for (i = base; n--; i += inc) ve[i] = f; break; @@ -573,8 +572,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) case scm_tc7_dvect: { /* scope */ double f, *ve = (double *) SCM_VELTS (ra); - SCM_ASRTGO (SCM_REALP (fill), badarg2); - f = SCM_REAL_VALUE (fill); + f = scm_num2dbl (fill, FUNC_NAME); for (i = base; n--; i += inc) ve[i] = f; break; From 7c183c95a4e8c4d92c57e04f9e9cf881323c568e Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 11 Feb 2004 23:20:26 +0000 Subject: [PATCH 083/167] (scm_make_uve, scm_array_p): Allow fraction 1/3 as prototype for dvect. (scm_array_p): Add missing "break"s in switch, fix llvect test look for "l" not "s", fix dvect to be false for singp(prot) since such a value is for fvect. (scm_array_prototype): Return 1/3 for dvect, rather than 0.33..33. --- libguile/unif.c | 29 +++++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/libguile/unif.c b/libguile/unif.c index ad9881cc0..f127dd833 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -72,6 +72,7 @@ */ scm_t_bits scm_tc16_array; +static SCM exactly_one_third; /* return the size of an element in a uniform array or 0 if type not found. */ @@ -175,6 +176,11 @@ scm_make_uve (long k, SCM prot) else type = scm_tc7_ivect; } + else if (SCM_FRACTIONP (prot)) + { + if (scm_num_eq_p (exactly_one_third, prot)) + goto dvect; + } else if (SCM_SYMBOLP (prot) && (1 == SCM_SYMBOL_LENGTH (prot))) { char s; @@ -213,6 +219,7 @@ scm_make_uve (long k, SCM prot) } else { + dvect: i = sizeof (double) * k; type = scm_tc7_dvect; } @@ -291,34 +298,46 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, { case scm_tc7_bvect: protp = (SCM_EQ_P (prot, SCM_BOOL_T)); + break; case scm_tc7_string: protp = SCM_CHARP(prot) && (SCM_CHAR (prot) != '\0'); + break; case scm_tc7_byvect: protp = SCM_EQ_P (prot, SCM_MAKE_CHAR ('\0')); + break; case scm_tc7_uvect: protp = SCM_INUMP(prot) && SCM_INUM(prot)>0; + break; case scm_tc7_ivect: protp = SCM_INUMP(prot) && SCM_INUM(prot)<=0; - + break; case scm_tc7_svect: protp = SCM_SYMBOLP (prot) && (1 == SCM_SYMBOL_LENGTH (prot)) && ('s' == SCM_SYMBOL_CHARS (prot)[0]); + break; #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: protp = SCM_SYMBOLP (prot) && (1 == SCM_SYMBOL_LENGTH (prot)) - && ('s' == SCM_SYMBOL_CHARS (prot)[0]); + && ('l' == SCM_SYMBOL_CHARS (prot)[0]); + break; #endif case scm_tc7_fvect: protp = singp (prot); + break; case scm_tc7_dvect: - protp = SCM_REALP(prot); + protp = ((SCM_REALP(prot) && ! singp (prot)) + || (SCM_FRACTIONP (prot) + && scm_num_eq_p (exactly_one_third, prot))); + break; case scm_tc7_cvect: protp = SCM_COMPLEXP(prot); + break; case scm_tc7_vector: case scm_tc7_wvect: protp = SCM_NULLP(prot); + break; default: /* no default */ ; @@ -2589,7 +2608,7 @@ loop: case scm_tc7_fvect: return scm_make_real (1.0); case scm_tc7_dvect: - return scm_make_real (1.0 / 3.0); + return exactly_one_third; case scm_tc7_cvect: return scm_make_complex (0.0, 1.0); } @@ -2622,6 +2641,8 @@ scm_init_unif () scm_set_smob_free (scm_tc16_array, array_free); scm_set_smob_print (scm_tc16_array, scm_raprin1); scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p); + exactly_one_third = scm_permanent_object (scm_make_ratio (SCM_MAKINUM (1), + SCM_MAKINUM (3))); scm_add_feature ("array"); #include "libguile/unif.x" } From 3da7f6b233cff15a97c1d915cd22db1ad07def33 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 11 Feb 2004 23:33:46 +0000 Subject: [PATCH 084/167] *** empty log message *** --- libguile/ChangeLog | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c650a0d35..74f0eb0ac 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,15 @@ +2004-02-12 Kevin Ryde + + * ramap.c (scm_array_fill_x): For fvect and dvect, use scm_num2dbl to + convert args the same way that array-set! does. + + * unif.c (scm_make_uve, scm_array_p): Allow fraction 1/3 as prototype + for dvect. + (scm_array_p): Add missing "break"s in switch, fix llvect test look + for "l" not "s", fix dvect to be false for singp(prot) since such a + value is for fvect. + (scm_array_prototype): Return 1/3 for dvect, rather than 0.33..33. + 2004-02-10 Neil Jerram * read.c (scm_read_opts): Change `escaped-parens' to From fd1517d8de8e8e4948f33d0a960623d43b5408fc Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 11 Feb 2004 23:36:58 +0000 Subject: [PATCH 085/167] Add copyright and license notice. (Note code was written in 2002, but only checked-in in 2004.) --- srfi/srfi-26.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/srfi/srfi-26.scm b/srfi/srfi-26.scm index b536311bd..83e79176e 100644 --- a/srfi/srfi-26.scm +++ b/srfi/srfi-26.scm @@ -1,3 +1,21 @@ +;;; srfi-26.scm --- specializing parameters without currying. + +;; Copyright (C) 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.1 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + (define-module (srfi srfi-26) :export (cut cute)) From 88531a74f38cf2dceea79c50e0a4efc8fa2dbcb0 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 11 Feb 2004 23:46:30 +0000 Subject: [PATCH 086/167] *** empty log message *** --- libguile/ChangeLog | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 74f0eb0ac..3c1afa0dc 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -9,6 +9,8 @@ for "l" not "s", fix dvect to be false for singp(prot) since such a value is for fvect. (scm_array_prototype): Return 1/3 for dvect, rather than 0.33..33. + (exactly_one_third): New variable. + (scm_init_unif): Initialize it. 2004-02-10 Neil Jerram From 9ad3bc119f6c5c175da8acfb467bd5a9419a3011 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Thu, 12 Feb 2004 00:02:30 +0000 Subject: [PATCH 087/167] (Conventional Arrays): Revise for clarity. In array-equal?, show multiple arguments allowed. (Uniform Arrays): Remove duplicate array?. --- doc/ref/scheme-compound.texi | 217 ++++++++++++++++++++--------------- 1 file changed, 122 insertions(+), 95 deletions(-) diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index 5137ecf01..8f0d4bf93 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -1186,91 +1186,115 @@ Return the vtable tag of the structure @var{handle}. @dfn{Conventional arrays} are a collection of cells organized into an arbitrary number of dimensions. Each cell can hold any kind of Scheme value and can be accessed in constant time by supplying an index for -each dimension. This contrasts with uniform arrays, which use memory -more efficiently but can hold data of only a single type, and lists -where inserting and deleting cells is more efficient, but more time -is usually required to access a particular cell. +each dimension. + +This contrasts with uniform arrays, which use memory more efficiently +but can hold data of only a single type. It contrasts also with lists +where inserting and deleting cells is more efficient, but more time is +usually required to access a particular cell. A conventional array is displayed as @code{#} followed by the @dfn{rank} (number of dimensions) followed by the cells, organized into dimensions using parentheses. The nesting depth of the parentheses is equal to the rank. -When an array is created, the number of dimensions and range of each -dimension must be specified, e.g., to create a 2x3 array with a -zero-based index: +When an array is created, the range of each dimension must be +specified, e.g., to create a 2@cross{}3 array with a zero-based index: @example -(make-array 'ho 2 3) @result{} -#2((ho ho ho) (ho ho ho)) +(make-array 'ho 2 3) @result{} #2((ho ho ho) (ho ho ho)) @end example The range of each dimension can also be given explicitly, e.g., another way to create the same array: @example -(make-array 'ho '(0 1) '(0 2)) @result{} -#2((ho ho ho) (ho ho ho)) +(make-array 'ho '(0 1) '(0 2)) @result{} #2((ho ho ho) (ho ho ho)) @end example A conventional array with one dimension based at zero is identical to a vector: @example -(make-array 'ho 3) @result{} -#(ho ho ho) +(make-array 'ho 3) @result{} #(ho ho ho) @end example -The following procedures can be used with conventional arrays (or vectors). +The following procedures can be used with conventional arrays (or +vectors). An argument shown as @var{idx}@dots{} means one parameter +for each dimension in the array. Or a @var{idxlist} is a list of such +values, one for each dimension. -@deffn {Scheme Procedure} array? v [prot] -@deffnx {C Function} scm_array_p (v, prot) +@deffn {Scheme Procedure} array? obj [prot] +@deffnx {C Function} scm_array_p (obj, prot) Return @code{#t} if the @var{obj} is an array, and @code{#f} if -not. The @var{prototype} argument is used with uniform arrays -and is described elsewhere. +not. + +The @var{prot} argument is used with uniform arrays (@pxref{Uniform +Arrays}). If given then the return is @code{#t} if @var{obj} is an +array and of that prototype. @end deffn -@deffn {Scheme Procedure} make-array initial-value bound1 bound2 @dots{} +@deffn {Scheme Procedure} make-array initial-value bound @dots{} Create and return an array that has as many dimensions as there are -@var{bound}s and fill it with @var{initial-value}. Each @var{bound} +@var{bound}s and fill it with @var{initial-value}. + +Each @var{bound} may be a positive non-zero integer @var{N}, in which case the index for that dimension can range from 0 through @var{N-1}; or an explicit index range specifier in the form @code{(LOWER UPPER)}, where both @var{lower} and @var{upper} are integers, possibly less than zero, and possibly the same number (however, @var{lower} cannot be greater than @var{upper}). +See examples above. @end deffn @c array-ref's type is `compiled-closure'. There's some weird stuff @c going on in array.c, too. Let's call it a primitive. -twp -@deffn {Scheme Procedure} uniform-vector-ref v args -@deffnx {Scheme Procedure} array-ref v . args -@deffnx {C Function} scm_uniform_vector_ref (v, args) -Return the element at the @code{(index1, index2)} element in -@var{array}. +@deffn {Scheme Procedure} array-ref array idx @dots{} +@deffnx {Scheme Procedure} uniform-vector-ref vec args +@deffnx {C Function} scm_uniform_vector_ref (vec, args) +Return the element at @code{(idx @dots{})} in @var{array}. + +@example +(define a (make-array 999 '(1 2) '(3 4))) +(array-ref a 2 4) @result{} 999 +@end example @end deffn -@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 +@deffn {Scheme Procedure} array-in-bounds? array idx @dots{} +@deffnx {C Function} scm_array_in_bounds_p (array, idxlist) +Return @code{#t} if the given index would be acceptable to @code{array-ref}. + +@example +(define a (make-array #f '(1 2) '(3 4))) +(array-in-bounds? a 2 3) @result{} #f +(array-in-bounds? a 0 0) @result{} #f +@end example @end deffn @c fixme: why do these sigs differ? -ttn 2001/07/19 01:14:12 -@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) -Set the element at the @code{(index1, index2)} element in @var{array} to -@var{new-value}. The value returned by array-set! is unspecified. +@deffn {Scheme Procedure} array-set! array obj idx @dots{} +@deffnx {Scheme Procedure} uniform-array-set1! array obj idxlist +@deffnx {C Function} scm_array_set_x (array, obj, idxlist) +Set the element at @code{(idx @dots{})} in @var{array} to @var{obj}. +The return value is unspecified. + +@example +(define a (make-array #f '(0 1) '(0 1))) +(array-set! a #t 1 1) +a @result{} #2((#f #f) (#f #t)) +@end example @end deffn -@deffn {Scheme Procedure} make-shared-array oldra mapfunc . dims -@deffnx {C Function} scm_make_shared_array (oldra, mapfunc, dims) +@deffn {Scheme Procedure} make-shared-array oldarray mapfunc bound @dots{} +@deffnx {C Function} scm_make_shared_array (oldarray, mapfunc, boundlist) @code{make-shared-array} can be used to create shared subarrays of other arrays. The @var{mapper} is a function that translates coordinates in the new array into coordinates in the old array. A @var{mapper} must be linear, and its range must stay within the bounds of the old array, but it can be otherwise arbitrary. A simple example: + @lisp (define fred (make-array #f 8 8)) (define freds-diagonal @@ -1283,32 +1307,32 @@ it can be otherwise arbitrary. A simple example: @end lisp @end deffn -@deffn {Scheme Procedure} shared-array-increments ra -@deffnx {C Function} scm_shared_array_increments (ra) +@deffn {Scheme Procedure} shared-array-increments array +@deffnx {C Function} scm_shared_array_increments (array) For each dimension, return the distance between elements in the root vector. @end deffn -@deffn {Scheme Procedure} shared-array-offset ra -@deffnx {C Function} scm_shared_array_offset (ra) +@deffn {Scheme Procedure} shared-array-offset array +@deffnx {C Function} scm_shared_array_offset (array) Return the root vector index of the first element in the array. @end deffn -@deffn {Scheme Procedure} shared-array-root ra -@deffnx {C Function} scm_shared_array_root (ra) +@deffn {Scheme Procedure} shared-array-root array +@deffnx {C Function} scm_shared_array_root (array) Return the root vector of a shared array. @end deffn -@deffn {Scheme Procedure} transpose-array ra . args -@deffnx {C Function} scm_transpose_array (ra, args) +@deffn {Scheme Procedure} transpose-array array dim1 @dots{} +@deffnx {C Function} scm_transpose_array (array, dimlist) Return an array sharing contents with @var{array}, but with dimensions arranged in a different order. There must be one @var{dim} argument for each dimension of @var{array}. -@var{dim0}, @var{dim1}, @dots{} should be integers between 0 +@var{dim1}, @var{dim2}, @dots{} should be integers between 0 and the rank of the array to be returned. Each integer in that range must appear at least once in the argument list. -The values of @var{dim0}, @var{dim1}, @dots{} correspond to -dimensions in the array to be returned, their positions in the +The values of @var{dim1}, @var{dim2}, @dots{} correspond to +dimensions in the array to be returned, and their positions in the argument list to dimensions of @var{array}. Several @var{dim}s may have the same value, in which case the returned array will have smaller rank than @var{array}. @@ -1321,10 +1345,10 @@ have smaller rank than @var{array}. @end lisp @end deffn -@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 -the rank of @var{array}. @var{enclose-array} returns an array +@deffn {Scheme Procedure} enclose-array array dim1 @dots{} +@deffnx {C Function} scm_enclose_array (array, dimlist) +@var{dim1}, @var{dim2} @dots{} should be nonnegative integers less than +the rank of @var{array}. @code{enclose-array} returns an array resembling an array of shared arrays. The dimensions of each shared array are the same as the @var{dim}th dimensions of the original array, the dimensions of the outer array are the same as those of the original @@ -1333,67 +1357,76 @@ array that did not match a @var{dim}. An enclosed array is not a general Scheme array. Its elements may not be set using @code{array-set!}. Two references to the same element of an enclosed array will be @code{equal?} but will not in general be -@code{eq?}. The value returned by @var{array-prototype} when given an +@code{eq?}. The value returned by @code{array-prototype} when given an enclosed array is unspecified. -examples: -@lisp -(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) @result{} - # +For example, -(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) @result{} - # +@lisp +(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) +@result{} +# + +(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) +@result{} +# @end lisp @end deffn @deffn {Scheme Procedure} array-shape array -Return a list of inclusive bounds of integers. +@deffnx {Scheme Procedure} array-dimensions array +@deffnx {C Function} scm_array_dimensions (array) +Return a list of the bounds for each dimenson of @var{array}. + +@code{array-shape} gives @code{(@var{lower} @var{upper})} for each +dimension. @code{array-dimensions} instead returns just +@math{@var{upper}+1} for dimensions with a 0 lower bound. Both are +suitable as input to @code{make-array}. + +For example, + @example -(array-shape (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) (0 4)) +(define a (make-array 'foo '(-1 3) 5)) +(array-shape a) @result{} ((-1 3) (0 4)) +(array-dimensions a) @result{} ((-1 3) 5) @end example @end deffn -@deffn {Scheme Procedure} array-dimensions ra -@deffnx {C Function} scm_array_dimensions (ra) -@code{Array-dimensions} is similar to @code{array-shape} but replaces -elements with a @code{0} minimum with one greater than the maximum. So: -@lisp -(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5) -@end lisp +@deffn {Scheme Procedure} array-rank obj +@deffnx {C Function} scm_array_rank (obj) +Return the number of dimensions of an array @var{obj}, or if @var{obj} +is not an array then return 0. @end deffn -@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 -not an array, @code{0} is returned. -@end deffn - -@deffn {Scheme Procedure} array->list v -@deffnx {C Function} scm_array_to_list (v) +@deffn {Scheme Procedure} array->list array +@deffnx {C Function} scm_array_to_list (array) Return a list consisting of all the elements, in order, of @var{array}. @end deffn +@c FIXME: Describe how the order affects the copying (it matters for +@c shared arrays with the same underlying root vector, presumably). +@c @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) -Copy every element from vector or array @var{source} to the -corresponding element of @var{destination}. @var{destination} must have -the same rank as @var{source}, and be at least as large in each -dimension. The order is unspecified. +Copy every element from vector or array @var{src} to the corresponding +element of @var{dst}. @var{dst} must have the same rank as @var{src}, +and be at least as large in each dimension. The return value is +unspecified. @end deffn -@deffn {Scheme Procedure} array-fill! ra fill -@deffnx {C Function} scm_array_fill_x (ra, fill) +@deffn {Scheme Procedure} array-fill! array fill +@deffnx {C Function} scm_array_fill_x (array, fill) Store @var{fill} in every element of @var{array}. The value returned is unspecified. @end deffn @c begin (texi-doc-string "guile" "array-equal?") -@deffn {Scheme Procedure} array-equal? ra0 ra1 -Return @code{#t} iff all arguments are arrays with the same shape, the +@deffn {Scheme Procedure} array-equal? array1 array2 @dots{} +Return @code{#t} if all arguments are arrays with the same shape, the same type, and have corresponding elements which are either -@code{equal?} or @code{array-equal?}. This function differs from +@code{equal?} or @code{array-equal?}. This function differs from @code{equal?} in that a one dimensional shared array may be @var{array-equal?} but not @var{equal?} to a vector or uniform vector. @end deffn @@ -1403,9 +1436,9 @@ same type, and have corresponding elements which are either If @var{array} may be @dfn{unrolled} into a one dimensional shared array without changing their order (last subscript changing fastest), then @code{array-contents} returns that shared array, otherwise it returns -@code{#f}. All arrays made by @var{make-array} and -@var{make-uniform-array} may be unrolled, some arrays made by -@var{make-shared-array} may not be. +@code{#f}. All arrays made by @code{make-array} and +@code{make-uniform-array} may be unrolled, some arrays made by +@code{make-shared-array} may not be. If the optional argument @var{strict} is provided, a shared array will be returned only if its elements are stored internally contiguous in @@ -1544,13 +1577,6 @@ except that a single character from the above table is put between @code{#} and @code{(}. For example, a uniform vector of signed long integers is displayed in the form @code{'#e(3 5 9)}. -@deffn {Scheme Procedure} array? v [prot] -Return @code{#t} if the @var{obj} is an array, and @code{#f} if not. - -The @var{prototype} argument is used with uniform arrays and is described -elsewhere. -@end deffn - @deffn {Scheme Procedure} make-uniform-array prototype bound1 bound2 @dots{} Create and return a uniform array of type corresponding to @var{prototype} that has as many dimensions as there are @var{bound}s @@ -1676,11 +1702,12 @@ Modify @var{bitvector} by replacing each element with its negation. @deffn {Scheme Procedure} bit-set*! bitvector uvec bool @deffnx {C Function} scm_bit_set_star_x (bitvector, uvec, bool) Set entries of @var{bitvector} to @var{bool}, with @var{uvec} -selecting the entries to change. +selecting the entries to change. The return value is unspecified. If @var{uvec} is a bit vector, then those entries where it has @code{#t} are the ones in @var{bitvector} which are set to @var{bool}. -When @var{bool} is @code{#t} it's like @var{uvec} is OR'ed into +@var{uvec} and @var{bitvector} must be the same length. When +@var{bool} is @code{#t} it's like @var{uvec} is OR'ed into @var{bitvector}. Or when @var{bool} is @code{#f} it can be seen as an ANDNOT. From b55d48bb0c981f31e609dfb35072db5b3cdd815d Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Thu, 12 Feb 2004 00:19:40 +0000 Subject: [PATCH 088/167] (Uniform Arrays): Note 1/3 prototype for doubles is now an exact fraction. --- doc/ref/scheme-compound.texi | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index 8f0d4bf93..f4406a8e4 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -1547,13 +1547,15 @@ prototype type printing character 'l signed long long (integer) l 1.0 float (single precision) s 1/3 double (double precision float) i -[FIXME: This (1/3) no longer works due to the - new support for rational numbers.] 0+i complex (double precision) c () conventional vector @end example -@noindent +Note that with the introduction of exact fractions in Guile 1.8, +@samp{1/3} here is now a fraction, where previously such an expression +was a double @samp{0.333@dots{}}. For most normal usages this should +be source code compatible. + Unshared uniform arrays of characters with a single zero-based dimension are identical to strings: From 27281a53e3cd576e02b662647d3f707056254b93 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Thu, 12 Feb 2004 00:21:26 +0000 Subject: [PATCH 089/167] (cross): New macro. --- doc/ref/guile.texi | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index 5cf44d40b..c2e250d99 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -76,6 +76,17 @@ this GNU Manual.'' @end macro +@c @cross{} is a \times symbol in tex, or an "x" in info. In tex it works +@c inside or outside $ $. +@tex +\gdef\cross{\ifmmode\times\else$\times$\fi} +@end tex +@ifnottex +@macro cross +x +@end macro +@end ifnottex + @c @m{T,N} is $T$ in tex or @math{N} otherwise. This is an easy way to give @c different forms for math in tex and info. @iftex @@ -120,7 +131,7 @@ this GNU Manual.'' @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.27 2004-01-21 22:43:36 mvo Exp $ +@subtitle $Id: guile.texi,v 1.28 2004-02-12 00:21:26 kryde Exp $ @c AUTHORS From d2866d6e2f6c6603d5e21f7b171874ba8c89e143 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Thu, 12 Feb 2004 00:23:42 +0000 Subject: [PATCH 090/167] (array?, array-fill!, array-prototype): Add tests. --- test-suite/tests/unif.test | 328 +++++++++++++++++++++++++++++++++++++ 1 file changed, 328 insertions(+) diff --git a/test-suite/tests/unif.test b/test-suite/tests/unif.test index 95bbe3e31..bbe02e063 100644 --- a/test-suite/tests/unif.test +++ b/test-suite/tests/unif.test @@ -19,6 +19,334 @@ (define-module (test-suite test-unif) #:use-module (test-suite lib)) +;; true if long long uniform arrays are available +(define have-llvect? (false-if-exception (make-uniform-vector 1 'l))) + + +;;; +;;; array? +;;; + +(with-test-prefix "array?" + + (let ((bool (make-uniform-array #t '(5 6))) + (char (make-uniform-array #\a '(5 6))) + (byte (make-uniform-array #\nul '(5 6))) + (short (make-uniform-array 's '(5 6))) + (ulong (make-uniform-array 1 '(5 6))) + (long (make-uniform-array -1 '(5 6))) + (longlong (and have-llvect? + (make-uniform-array 'l '(5 6)))) + (float (make-uniform-array 1.0 '(5 6))) + (double (make-uniform-array 1/3 '(5 6))) + (complex (make-uniform-array 0+i '(5 6))) + (scm (make-uniform-array '() '(5 6)))) + + (with-test-prefix "is bool" + (pass-if (eq? #t (array? bool #t))) + (pass-if (eq? #f (array? char #t))) + (pass-if (eq? #f (array? byte #t))) + (pass-if (eq? #f (array? short #t))) + (pass-if (eq? #f (array? ulong #t))) + (pass-if (eq? #f (array? long #t))) + (if have-llvect? + (pass-if (eq? #f (array? longlong #t)))) + (pass-if (eq? #f (array? float #t))) + (pass-if (eq? #f (array? double #t))) + (pass-if (eq? #f (array? complex #t))) + (pass-if (eq? #f (array? scm #t)))) + + (with-test-prefix "is char" + (pass-if (eq? #f (array? bool #\a))) + (pass-if (eq? #t (array? char #\a))) + (pass-if (eq? #f (array? byte #\a))) + (pass-if (eq? #f (array? short #\a))) + (pass-if (eq? #f (array? ulong #\a))) + (pass-if (eq? #f (array? long #\a))) + (if have-llvect? + (pass-if (eq? #f (array? longlong #\a)))) + (pass-if (eq? #f (array? float #\a))) + (pass-if (eq? #f (array? double #\a))) + (pass-if (eq? #f (array? complex #\a))) + (pass-if (eq? #f (array? scm #\a)))) + + (with-test-prefix "is byte" + (pass-if (eq? #f (array? bool #\nul))) + (pass-if (eq? #f (array? char #\nul))) + (pass-if (eq? #t (array? byte #\nul))) + (pass-if (eq? #f (array? short #\nul))) + (pass-if (eq? #f (array? ulong #\nul))) + (pass-if (eq? #f (array? long #\nul))) + (if have-llvect? + (pass-if (eq? #f (array? longlong #\nul)))) + (pass-if (eq? #f (array? float #\nul))) + (pass-if (eq? #f (array? double #\nul))) + (pass-if (eq? #f (array? complex #\nul))) + (pass-if (eq? #f (array? scm #\nul)))) + + (with-test-prefix "is short" + (pass-if (eq? #f (array? bool 's))) + (pass-if (eq? #f (array? char 's))) + (pass-if (eq? #f (array? byte 's))) + (pass-if (eq? #t (array? short 's))) + (pass-if (eq? #f (array? ulong 's))) + (pass-if (eq? #f (array? long 's))) + (if have-llvect? + (pass-if (eq? #f (array? longlong 's)))) + (pass-if (eq? #f (array? float 's))) + (pass-if (eq? #f (array? double 's))) + (pass-if (eq? #f (array? complex 's))) + (pass-if (eq? #f (array? scm 's)))) + + (with-test-prefix "is ulong" + (pass-if (eq? #f (array? bool 1))) + (pass-if (eq? #f (array? char 1))) + (pass-if (eq? #f (array? byte 1))) + (pass-if (eq? #f (array? short 1))) + (pass-if (eq? #t (array? ulong 1))) + (pass-if (eq? #f (array? long 1))) + (if have-llvect? + (pass-if (eq? #f (array? longlong 1)))) + (pass-if (eq? #f (array? float 1))) + (pass-if (eq? #f (array? double 1))) + (pass-if (eq? #f (array? complex 1))) + (pass-if (eq? #f (array? scm 1)))) + + (with-test-prefix "is long" + (pass-if (eq? #f (array? bool -1))) + (pass-if (eq? #f (array? char -1))) + (pass-if (eq? #f (array? byte -1))) + (pass-if (eq? #f (array? short -1))) + (pass-if (eq? #f (array? ulong -1))) + (pass-if (eq? #t (array? long -1))) + (if have-llvect? + (pass-if (eq? #f (array? longlong -1)))) + (pass-if (eq? #f (array? float -1))) + (pass-if (eq? #f (array? double -1))) + (pass-if (eq? #f (array? complex -1))) + (pass-if (eq? #f (array? scm -1)))) + + (with-test-prefix "is long long" + (pass-if (eq? #f (array? bool 'l))) + (pass-if (eq? #f (array? char 'l))) + (pass-if (eq? #f (array? byte 'l))) + (pass-if (eq? #f (array? short 'l))) + (pass-if (eq? #f (array? ulong 'l))) + (pass-if (eq? #f (array? long 'l))) + (if have-llvect? + (pass-if (eq? #t (array? longlong 'l)))) + (pass-if (eq? #f (array? float 'l))) + (pass-if (eq? #f (array? double 'l))) + (pass-if (eq? #f (array? complex 'l))) + (pass-if (eq? #f (array? scm 'l)))) + + (with-test-prefix "is float" + (pass-if (eq? #f (array? bool 1.0))) + (pass-if (eq? #f (array? char 1.0))) + (pass-if (eq? #f (array? byte 1.0))) + (pass-if (eq? #f (array? short 1.0))) + (pass-if (eq? #f (array? ulong 1.0))) + (pass-if (eq? #f (array? long 1.0))) + (if have-llvect? + (pass-if (eq? #f (array? longlong 1.0)))) + (pass-if (eq? #t (array? float 1.0))) + (pass-if (eq? #f (array? double 1.0))) + (pass-if (eq? #f (array? complex 1.0))) + (pass-if (eq? #f (array? scm 1.0)))) + + (with-test-prefix "is double" + (pass-if (eq? #f (array? bool 1/3))) + (pass-if (eq? #f (array? char 1/3))) + (pass-if (eq? #f (array? byte 1/3))) + (pass-if (eq? #f (array? short 1/3))) + (pass-if (eq? #f (array? ulong 1/3))) + (pass-if (eq? #f (array? long 1/3))) + (if have-llvect? + (pass-if (eq? #f (array? longlong 1/3)))) + (pass-if (eq? #f (array? float 1/3))) + (pass-if (eq? #t (array? double 1/3))) + (pass-if (eq? #f (array? complex 1/3))) + (pass-if (eq? #f (array? scm 1/3)))) + + (with-test-prefix "is complex" + (pass-if (eq? #f (array? bool 0+i))) + (pass-if (eq? #f (array? char 0+i))) + (pass-if (eq? #f (array? byte 0+i))) + (pass-if (eq? #f (array? short 0+i))) + (pass-if (eq? #f (array? ulong 0+i))) + (pass-if (eq? #f (array? long 0+i))) + (if have-llvect? + (pass-if (eq? #f (array? longlong 0+i)))) + (pass-if (eq? #f (array? float 0+i))) + (pass-if (eq? #f (array? double 0+i))) + (pass-if (eq? #t (array? complex 0+i))) + (pass-if (eq? #f (array? scm 0+i)))) + + (with-test-prefix "is scm" + (pass-if (eq? #f (array? bool '()))) + (pass-if (eq? #f (array? char '()))) + (pass-if (eq? #f (array? byte '()))) + (pass-if (eq? #f (array? short '()))) + (pass-if (eq? #f (array? ulong '()))) + (pass-if (eq? #f (array? long '()))) + (if have-llvect? + (pass-if (eq? #f (array? longlong '())))) + (pass-if (eq? #f (array? float '()))) + (pass-if (eq? #f (array? double '()))) + (pass-if (eq? #f (array? complex '()))) + (pass-if (eq? #t (array? scm '())))))) + +;;; +;;; array-fill! +;;; + +(with-test-prefix "array-fill!" + + (with-test-prefix "bool" + (let ((a (make-uniform-vector 1 #t))) + (pass-if "#f" (array-fill! a #f) #t) + (pass-if "#t" (array-fill! a #t) #t))) + + (with-test-prefix "char" + (let ((a (make-uniform-vector 1 #\a))) + (pass-if "x" (array-fill! a #\x) #t))) + + (with-test-prefix "byte" + (let ((a (make-uniform-vector 1 #\nul))) + (pass-if "0" (array-fill! a 0) #t) + (pass-if "127" (array-fill! a 127) #t) + (pass-if "-128" (array-fill! a -128) #t))) + + (with-test-prefix "short" + (let ((a (make-uniform-vector 1 's))) + (pass-if "0" (array-fill! a 0) #t) + (pass-if "123" (array-fill! a 123) #t) + (pass-if "-123" (array-fill! a -123) #t))) + + (with-test-prefix "ulong" + (let ((a (make-uniform-vector 1 1))) + (pass-if "0" (array-fill! a 0) #t) + (pass-if "123" (array-fill! a 123) #t) + (pass-if-exception "-123" exception:out-of-range + (array-fill! a -123) #t))) + + (with-test-prefix "long" + (let ((a (make-uniform-vector 1 -1))) + (pass-if "0" (array-fill! a 0) #t) + (pass-if "123" (array-fill! a 123) #t) + (pass-if "-123" (array-fill! a -123) #t))) + + (with-test-prefix "float" + (let ((a (make-uniform-vector 1 1.0))) + (pass-if "0.0" (array-fill! a 0) #t) + (pass-if "123.0" (array-fill! a 123.0) #t) + (pass-if "-123.0" (array-fill! a -123.0) #t) + (pass-if "0" (array-fill! a 0) #t) + (pass-if "123" (array-fill! a 123) #t) + (pass-if "-123" (array-fill! a -123) #t) + (pass-if "5/8" (array-fill! a 5/8) #t))) + + (with-test-prefix "double" + (let ((a (make-uniform-vector 1 1/3))) + (pass-if "0.0" (array-fill! a 0) #t) + (pass-if "123.0" (array-fill! a 123.0) #t) + (pass-if "-123.0" (array-fill! a -123.0) #t) + (pass-if "0" (array-fill! a 0) #t) + (pass-if "123" (array-fill! a 123) #t) + (pass-if "-123" (array-fill! a -123) #t) + (pass-if "5/8" (array-fill! a 5/8) #t)))) + +;;; +;;; array-prototype +;;; + +(with-test-prefix "array-prototype" + + (with-test-prefix "on make-uniform-vector" + + (pass-if "bool" + (eq? #t (array-prototype (make-uniform-vector 1 #t)))) + + (pass-if "char" + (char=? #\a (array-prototype (make-uniform-vector 1 #\a)))) + + (pass-if "byte" + (char=? #\nul (array-prototype (make-uniform-vector 1 #\nul)))) + + (pass-if "short" + (eq? 's (array-prototype (make-uniform-vector 1 's)))) + + (pass-if "ulong" + (let ((p (array-prototype (make-uniform-vector 1 1)))) + (and (= 1 p) + (exact? p)))) + + (pass-if "long" + (= -1 (array-prototype (make-uniform-vector 1 -1)))) + + (if have-llvect? + (pass-if "long long" + (eq? 'l (array-prototype (make-uniform-vector 1 'l))))) + + (pass-if "float" + (let ((p (array-prototype (make-uniform-vector 1 1.0)))) + (and (= 1.0 p) + (not (exact? p))))) + + (pass-if "double" + (let ((p (array-prototype (make-uniform-vector 1 1/3)))) + (and (= 1/3 p) + (exact? p)))) + + (pass-if "complex" + (= 0+i (array-prototype (make-uniform-vector 1 0+i)))) + + (pass-if "scm" + (eq? '() (array-prototype (make-uniform-vector 1 '()))))) + + (with-test-prefix "on make-uniform-array" + + (pass-if "bool" + (eq? #t (array-prototype (make-uniform-array #t '(5 6))))) + + (pass-if "char" + (char=? #\a (array-prototype (make-uniform-array #\a '(5 6))))) + + (pass-if "byte" + (char=? #\nul (array-prototype (make-uniform-array #\nul '(5 6))))) + + (pass-if "short" + (eq? 's (array-prototype (make-uniform-array 's '(5 6))))) + + (pass-if "ulong" + (let ((p (array-prototype (make-uniform-array 1 '(5 6))))) + (and (= 1 p) + (exact? p)))) + + (pass-if "long" + (let ((p (array-prototype (make-uniform-array -1 '(5 6))))) + (and (= -1 p) + (exact? p)))) + + (if have-llvect? + (pass-if "long long" + (eq? 'l (array-prototype (make-uniform-array 'l '(5 6)))))) + + (pass-if "float" + (let ((p (array-prototype (make-uniform-array 1.0 '(5 6))))) + (and (= 1.0 p) + (not (exact? p))))) + + (pass-if "double" + (let ((p (array-prototype (make-uniform-array 1/3 '(5 6))))) + (and (= 1/3 p) + (exact? p)))) + + (pass-if "complex" + (= 0+i (array-prototype (make-uniform-array 0+i '(5 6))))) + + (pass-if "scm" + (eq? '() (array-prototype (make-uniform-array '() '(5 6))))))) ;;; ;;; uniform-array-set1! From ad94d5ced540ca448515be426c69b65629badcaa Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Thu, 12 Feb 2004 00:24:18 +0000 Subject: [PATCH 091/167] *** empty log message *** --- doc/ref/ChangeLog | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 671df4911..abedc3d9f 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,15 @@ +2004-02-12 Kevin Ryde + + * scheme-compound.texi (Conventional Arrays): Revise for clarity. + In array-equal?, show multiple arguments allowed. + (Uniform Arrays): Remove duplicate array?. + * guile.texi (cross): New macro. + + * scheme-compound.texi (Uniform Arrays): Note 1/3 prototype for + doubles is now an exact fraction. + + * slib.texi (SLIB): Index entry for replacement `system'. + 2004-01-28 Mikael Djurfeldt * scheme-compound.texi (Uniform Arrays): Added a FIXME warning From 71f271b2bbaa6f3add17836a40c49333679bb850 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Thu, 12 Feb 2004 00:33:58 +0000 Subject: [PATCH 092/167] Refer to manual for details of new pretty-print options. --- NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 9dbbaba67..b6181d7bf 100644 --- a/NEWS +++ b/NEWS @@ -516,7 +516,7 @@ interned or not. The function pretty-print from the (ice-9 pretty-print) module can now also be invoked with keyword arguments that control things like -maximum output width. See its online documentation. +maximum output width. See the manual for details. ** Variables have no longer a special behavior for `equal?'. From a150979dabb2d49ccad9c95dd54b71e603d0ef38 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Thu, 12 Feb 2004 00:45:36 +0000 Subject: [PATCH 093/167] (scm_port_line): In docstring, note first line is 0. (scm_set_port_line_x): In docstring, note first line is 0. (scm_port_column): In docstring, there's no default to current input port, and remove shared port-line @defun. (scm_set_port_column_x): In docstring, there's no default to current input port, note first column is 0, remove shared set-port-line! @defun. --- libguile/ports.c | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/libguile/ports.c b/libguile/ports.c index 6e1446610..d92aaaa4e 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1450,7 +1450,12 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0, (SCM port), - "Return the current line number for @var{port}.") + "Return the current line number for @var{port}.\n" + "\n" + "The first line of a file is 0. But you might want to add 1\n" + "when printing line numbers, since starting from 1 is\n" + "traditional in error messages, and likely to be more natural to\n" + "non-programmers.") #define FUNC_NAME s_scm_port_line { port = SCM_COERCE_OUTPORT (port); @@ -1461,7 +1466,8 @@ SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0, SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0, (SCM port, SCM line), - "Set the current line number for @var{port} to @var{line}.") + "Set the current line number for @var{port} to @var{line}. The\n" + "first line of a file is 0.") #define FUNC_NAME s_scm_set_port_line_x { port = SCM_COERCE_OUTPORT (port); @@ -1474,9 +1480,8 @@ SCM_DEFINE (scm_set_port_line_x, "set-port-line!", 2, 0, 0, SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0, (SCM port), - "@deffnx {Scheme Procedure} port-line port\n" - "Return the current column number or line number of @var{port},\n" - "using the current input port if none is specified. If the number is\n" + "Return the current column number of @var{port}.\n" + "If the number is\n" "unknown, the result is #f. Otherwise, the result is a 0-origin integer\n" "- i.e. the first character of the first line is line 0, column 0.\n" "(However, when you display a file position, for example in an error\n" @@ -1493,9 +1498,8 @@ SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0, SCM_DEFINE (scm_set_port_column_x, "set-port-column!", 2, 0, 0, (SCM port, SCM column), - "@deffnx {Scheme Procedure} set-port-line! port line\n" - "Set the current column or line number of @var{port}, using the\n" - "current input port if none is specified.") + "Set the current column of @var{port}. Before reading the first\n" + "character on a line the column should be 0.") #define FUNC_NAME s_scm_set_port_column_x { port = SCM_COERCE_OUTPORT (port); From 711a9fd7ee82610f160c042141d6a34e041ea804 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Fri, 13 Feb 2004 23:15:37 +0000 Subject: [PATCH 094/167] * unif.c (scm_make_uve): Removed local variable and simplified code in order to avoid compiler used uninitialized warnings. * hashtab.c, hashtab.h (scm_hash_map_to_list): Renamed from scm_hash_map. (scm_hash_fold): Use scm_call_3 directly in the call to scm_internal_hash_fold instead of going via fold_proc (which is now removed). (scm_hash_for_each): Use a trampoline + scm_internal_hash_for_each_handle. (scm_internal_hash_for_each_handle, scm_hash_for_each_handle): New functions. --- ice-9/ChangeLog | 4 ++ ice-9/boot-9.scm | 2 +- libguile/ChangeLog | 15 ++++++ libguile/hashtab.c | 118 ++++++++++++++++++++++++++++++++------------- libguile/hashtab.h | 6 ++- libguile/unif.c | 82 +++++++++++-------------------- 6 files changed, 138 insertions(+), 89 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index f83e8865a..2af0e0281 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,7 @@ +2004-02-12 Mikael Djurfeldt + + * boot-9.scm (module-map): Renamed hash-map -> hash-map->list. + 2004-02-09 Neil Jerram * debugger/trap-hooks.scm (debug-hook-membership): New, exported. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 98a15c61b..cc2104667 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -1436,7 +1436,7 @@ (hash-for-each proc (module-obarray module))) (define (module-map proc module) - (hash-map proc (module-obarray module))) + (hash-map->list proc (module-obarray module))) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 3c1afa0dc..d974dd7c1 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,18 @@ +2004-02-13 Mikael Djurfeldt + + * unif.c (scm_make_uve): Removed local variable and simplified + code in order to avoid compiler used uninitialized warnings. + + * hashtab.c, hashtab.h (scm_hash_map_to_list): Renamed from + scm_hash_map. + (scm_hash_fold): Use scm_call_3 directly in the call to + scm_internal_hash_fold instead of going via fold_proc (which is + now removed). + (scm_hash_for_each): Use a trampoline + + scm_internal_hash_for_each_handle. + (scm_internal_hash_for_each_handle, scm_hash_for_each_handle): New + functions. + 2004-02-12 Kevin Ryde * ramap.c (scm_array_fill_x): For fvect and dvect, use scm_num2dbl to diff --git a/libguile/hashtab.c b/libguile/hashtab.c index f6cc26311..eadee95df 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004 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 @@ -904,30 +904,9 @@ scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj) return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx, scm_delx_x, 0); } -static SCM -fold_proc (void *proc, SCM key, SCM data, SCM value) -{ - return scm_call_3 (SCM_PACK (proc), key, data, value); -} +/* Hash table iterators */ -SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, - (SCM proc, SCM init, SCM table), - "An iterator over hash-table elements.\n" - "Accumulates and returns a result by applying PROC successively.\n" - "The arguments to PROC are \"(key value prior-result)\" where key\n" - "and value are successive pairs from the hash table TABLE, and\n" - "prior-result is either INIT (for the first application of PROC)\n" - "or the return value of the previous application of PROC.\n" - "For example, @code{(hash-fold acons '() tab)} will convert a hash\n" - "table into an a-list of key-value pairs.") -#define FUNC_NAME s_scm_hash_fold -{ - SCM_VALIDATE_PROC (1, proc); - if (!SCM_HASHTABLE_P (table)) - SCM_VALIDATE_VECTOR (3, table); - return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table); -} -#undef FUNC_NAME +static const char s_scm_hash_fold[]; SCM scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table) @@ -959,10 +938,65 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table) return result; } -static SCM -for_each_proc (void *proc, SCM key, SCM data, SCM value) +/* The following redundant code is here in order to be able to support + hash-for-each-handle. An alternative would have been to replace + this code and scm_internal_hash_fold above with a single + scm_internal_hash_fold_handles, but we don't want to promote such + an API. */ + +static const char s_scm_hash_for_each[]; + +void +scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table) { - return scm_call_2 (SCM_PACK (proc), key, data); + long i, n; + SCM buckets; + + if (SCM_HASHTABLE_P (table)) + buckets = SCM_HASHTABLE_VECTOR (table); + else + buckets = table; + + n = SCM_VECTOR_LENGTH (buckets); + for (i = 0; i < n; ++i) + { + SCM ls = SCM_VELTS (buckets)[i], handle; + while (!SCM_NULLP (ls)) + { + if (!SCM_CONSP (ls)) + scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets); + handle = SCM_CAR (ls); + if (!SCM_CONSP (handle)) + scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets); + fn (closure, handle); + ls = SCM_CDR (ls); + } + } +} + +SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, + (SCM proc, SCM init, SCM table), + "An iterator over hash-table elements.\n" + "Accumulates and returns a result by applying PROC successively.\n" + "The arguments to PROC are \"(key value prior-result)\" where key\n" + "and value are successive pairs from the hash table TABLE, and\n" + "prior-result is either INIT (for the first application of PROC)\n" + "or the return value of the previous application of PROC.\n" + "For example, @code{(hash-fold acons '() tab)} will convert a hash\n" + "table into an a-list of key-value pairs.") +#define FUNC_NAME s_scm_hash_fold +{ + SCM_VALIDATE_PROC (1, proc); + if (!SCM_HASHTABLE_P (table)) + SCM_VALIDATE_VECTOR (3, table); + return scm_internal_hash_fold (scm_call_3, (void *) SCM_UNPACK (proc), init, table); +} +#undef FUNC_NAME + +static SCM +for_each_proc (void *proc, SCM handle) +{ + return scm_call_2 (SCM_PACK (proc), SCM_CAR (handle), SCM_CDR (handle)); } SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0, @@ -976,10 +1010,28 @@ SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0, SCM_VALIDATE_PROC (1, proc); if (!SCM_HASHTABLE_P (table)) SCM_VALIDATE_VECTOR (2, table); - scm_internal_hash_fold (for_each_proc, - (void *) SCM_UNPACK (proc), - SCM_BOOL_F, - table); + + scm_internal_hash_for_each_handle (for_each_proc, + (void *) SCM_UNPACK (proc), + table); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_hash_for_each_handle, "hash-for-each-handle", 2, 0, 0, + (SCM proc, SCM table), + "An iterator over hash-table elements.\n" + "Applies PROC successively on all hash table handles.") +#define FUNC_NAME s_scm_hash_for_each_handle +{ + scm_t_trampoline_1 call = scm_trampoline_1 (proc); + SCM_ASSERT (call, proc, 1, FUNC_NAME); + if (!SCM_HASHTABLE_P (table)) + SCM_VALIDATE_VECTOR (2, table); + + scm_internal_hash_for_each_handle (call, + (void *) SCM_UNPACK (proc), + table); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -990,13 +1042,13 @@ map_proc (void *proc, SCM key, SCM data, SCM value) return scm_cons (scm_call_2 (SCM_PACK (proc), key, data), value); } -SCM_DEFINE (scm_hash_map, "hash-map", 2, 0, 0, +SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 0, 0, (SCM proc, SCM table), "An iterator over hash-table elements.\n" "Accumulates and returns as a list the results of applying PROC successively.\n" "The arguments to PROC are \"(key value)\" where key\n" "and value are successive pairs from the hash table TABLE.") -#define FUNC_NAME s_scm_hash_map +#define FUNC_NAME s_scm_hash_map_to_list { SCM_VALIDATE_PROC (1, proc); if (!SCM_HASHTABLE_P (table)) diff --git a/libguile/hashtab.h b/libguile/hashtab.h index 96d3e8715..3afc6b29f 100644 --- a/libguile/hashtab.h +++ b/libguile/hashtab.h @@ -3,7 +3,7 @@ #ifndef SCM_HASHTAB_H #define SCM_HASHTAB_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2003 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004 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 @@ -104,6 +104,7 @@ SCM_API SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned long (*hash_ SCM_API SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned long (*hash_fn) (), SCM (*assoc_fn) (), void * closure); SCM_API SCM scm_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*hash_fn) (), SCM (*assoc_fn) (), SCM (*delete_fn) (), void * closure); SCM_API SCM scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table); +SCM_API void scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table); SCM_API SCM scm_hash_clear_x (SCM table); SCM_API SCM scm_hashq_get_handle (SCM table, SCM obj); @@ -128,7 +129,8 @@ SCM_API SCM scm_hashx_set_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM val); SCM_API SCM scm_hashx_remove_x (SCM hash, SCM assoc, SCM del, SCM table, SCM obj); SCM_API SCM scm_hash_fold (SCM proc, SCM init, SCM hash); SCM_API SCM scm_hash_for_each (SCM proc, SCM hash); -SCM_API SCM scm_hash_map (SCM proc, SCM hash); +SCM_API SCM scm_hash_for_each_handle (SCM proc, SCM hash); +SCM_API SCM scm_hash_map_to_list (SCM proc, SCM hash); SCM_API void scm_hashtab_prehistory (void); SCM_API void scm_init_hashtab (void); diff --git a/libguile/unif.c b/libguile/unif.c index f127dd833..8944697d3 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -137,45 +137,45 @@ singp (SCM obj) } } +static const char s_scm_make_uve[]; + +static SCM +make_uve (long type, long k, size_t size) +#define FUNC_NAME "scm_make_uve" +{ + SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH); + + return scm_cell (SCM_MAKE_UVECTOR_TAG (k, type), + (scm_t_bits) scm_gc_malloc (k * size, "vector")); +} +#undef FUNC_NAME + SCM scm_make_uve (long k, SCM prot) #define FUNC_NAME "scm_make_uve" { - SCM v; - long i, type; - if (SCM_EQ_P (prot, SCM_BOOL_T)) { if (k > 0) { + long i; SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH); i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT); - v = scm_cell (SCM_MAKE_BITVECTOR_TAG (k), - (scm_t_bits) scm_gc_malloc (i, "vector")); + return scm_cell (SCM_MAKE_BITVECTOR_TAG (k), + (scm_t_bits) scm_gc_malloc (i, "vector")); } else - v = scm_cell (SCM_MAKE_BITVECTOR_TAG (0), 0); - return v; + return scm_cell (SCM_MAKE_BITVECTOR_TAG (0), 0); } else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0')) - { - i = sizeof (char) * k; - type = scm_tc7_byvect; - } + return make_uve (scm_tc7_byvect, k, sizeof (char)); else if (SCM_CHARP (prot)) - { - i = sizeof (char) * k; - return scm_allocate_string (i); - } + return scm_allocate_string (sizeof (char) * k); else if (SCM_INUMP (prot)) - { - i = sizeof (long) * k; - if (SCM_INUM (prot) > 0) - type = scm_tc7_uvect; - else - type = scm_tc7_ivect; - } + return make_uve (SCM_INUM (prot) > 0 ? scm_tc7_uvect : scm_tc7_ivect, + k, + sizeof (long)); else if (SCM_FRACTIONP (prot)) { if (scm_num_eq_p (exactly_one_third, prot)) @@ -187,51 +187,27 @@ scm_make_uve (long k, SCM prot) s = SCM_SYMBOL_CHARS (prot)[0]; if (s == 's') - { - i = sizeof (short) * k; - type = scm_tc7_svect; - } + return make_uve (scm_tc7_svect, k, sizeof (short)); #if SCM_SIZEOF_LONG_LONG != 0 else if (s == 'l') - { - i = sizeof (long long) * k; - type = scm_tc7_llvect; - } + return make_uve (scm_tc7_llvect, k, sizeof (long long)); #endif else - { - return scm_c_make_vector (k, SCM_UNDEFINED); - } + return scm_c_make_vector (k, SCM_UNDEFINED); } else if (!SCM_INEXACTP (prot)) /* Huge non-unif vectors are NOT supported. */ /* no special scm_vector */ return scm_c_make_vector (k, SCM_UNDEFINED); else if (singp (prot)) - { - i = sizeof (float) * k; - type = scm_tc7_fvect; - } + return make_uve (scm_tc7_fvect, k, sizeof (float)); else if (SCM_COMPLEXP (prot)) - { - i = 2 * sizeof (double) * k; - type = scm_tc7_cvect; - } - else - { - dvect: - i = sizeof (double) * k; - type = scm_tc7_dvect; - } - - SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH); - - return scm_cell (SCM_MAKE_UVECTOR_TAG (k, type), - (scm_t_bits) scm_gc_malloc (i, "vector")); + return make_uve (scm_tc7_cvect, k, 2 * sizeof (double)); + dvect: + return make_uve (scm_tc7_dvect, k, sizeof (double)); } #undef FUNC_NAME - SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, (SCM v), "Return the number of elements in @var{uve}.") From 0c7d588a7a9fd6407124fdf54f28760063c94ef2 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 14 Feb 2004 23:02:32 +0000 Subject: [PATCH 095/167] (Hash Table Reference): In scm_hash_ref etc, remove note that dflt must be given, it can be SCM_UNSPECIFIED. --- doc/ref/scheme-compound.texi | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index f4406a8e4..49dd5d939 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -2401,8 +2401,7 @@ added. @deffnx {C Function} scm_hashx_ref (hash, assoc, table, key, dflt) Lookup @var{key} in the given hash @var{table}, and return the associated value. If @var{key} is not found, return @var{dflt}, or -@code{#f} if @var{dflt} is not given. (For the C functions, -@var{dflt} must be given.) +@code{#f} if @var{dflt} is not given. @end deffn @deffn {Scheme Procedure} hash-set! table key val From 0e43f514aa3d58046aa105ca73312c7c439f4c76 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 14 Feb 2004 23:04:55 +0000 Subject: [PATCH 096/167] (while do): Expand and clarify `do', in particular note iterating binds fresh locations, rather than values "stored". --- doc/ref/scheme-control.texi | 71 +++++++++++++++++++++++++++++++------ 1 file changed, 60 insertions(+), 11 deletions(-) diff --git a/doc/ref/scheme-control.texi b/doc/ref/scheme-control.texi index 96f2daa08..7d7662c53 100644 --- a/doc/ref/scheme-control.texi +++ b/doc/ref/scheme-control.texi @@ -299,18 +299,67 @@ Scheme programs is normally expressed using recursion. Nevertheless, R5RS defines a construct for programming loops, calling @code{do}. In addition, Guile has an explicit looping syntax called @code{while}. -@deffn syntax do ((variable1 init1 step1) @dots{}) (test expr @dots{}) command @dots{} -The @var{init} expressions are evaluated and the @var{variables} are -bound to their values. Then looping starts with testing the @var{test} -expression. If @var{test} evaluates to a true value, the @var{expr} -following the @var{test} are evaluated and the value of the last -@var{expr} is returned as the value of the @code{do} expression. If -@var{test} evaluates to false, the @var{command}s are evaluated in -order, the @var{step}s are evaluated and stored into the @var{variables} -and the next iteration starts. +@deffn syntax do ((variable init [step]) @dots{}) (test [expr @dots{}]) body @dots{} +Bind @var{variable}s and evaluate @var{body} until @var{test} is true. +The return value is the last @var{expr} after @var{test}, if given. A +simple example will illustrate the basic form, -Any of the @var{step} expressions may be omitted, so that the -corresponding variable is not changed during looping. +@example +(do ((i 1 (1+ i))) + ((> i 4)) + (display i)) +@print{} 1234 +@end example + +@noindent +Or with two variables and a final return value, + +@example +(do ((i 1 (1+ i)) + (p 3 (* 3 p))) + ((> i 4) + p) + (format #t "3**~s is ~s\n" i p)) +@print{} +3**1 is 3 +3**2 is 9 +3**3 is 27 +3**4 is 81 +@result{} +789 +@end example + +The @var{variable} bindings are established like a @code{let}, in that +the expressions are all evaluated and then all bindings made. When +iterating, the optional @var{step} expressions are evaluated with the +previous bindings in scope, then new bindings all made. + +The @var{test} expression is a termination condition. Looping stops +when the @var{test} is true. It's evaluated before running the +@var{body} each time, so if it's true the first time then @var{body} +is not run at all. + +The optional @var{expr}s after the @var{test} are evaluated at the end +of looping, with the final @var{variable} bindings available. The +last @var{expr} gives the return value, or if there are no @var{expr}s +the return value is unspecified. + +Each iteration establishes bindings to fresh locations for the +@var{variable}s, like a new @code{let} for each iteration. This is +done for @var{variable}s without @var{step} expressions too. The +following illustrates this, showing how a new @code{i} is captured by +the @code{lambda} in each iteration (@pxref{About Closure,, The +Concept of Closure}). + +@example +(define lst '()) +(do ((i 1 (1+ i))) + ((> i 4)) + (set! lst (cons (lambda () i) lst))) +(map (lambda (proc) (proc)) lst) +@result{} +(4 3 2 1) +@end example @end deffn @deffn syntax while cond body @dots{} From f85f9591e0003d3448595d46d52fe04b3e41ec36 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 15 Feb 2004 00:18:24 +0000 Subject: [PATCH 097/167] (SRFI-4): Revise for clarity, give each function explicitly rather than showing TAG so Emacs info-look can find them, merge "SRFI-4 - Read Syntax" and "SRFI-4 - Procedures" into just one node. --- doc/ref/srfi-modules.texi | 212 ++++++++++++++++++++++---------------- 1 file changed, 123 insertions(+), 89 deletions(-) diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index e8c2677c6..6a679f044 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -973,127 +973,161 @@ from separate @code{and} and @code{let*}, or from @code{cond} with @node SRFI-4 -@section SRFI-4 - Homogeneous numeric vector datatypes. +@section SRFI-4 - Homogeneous numeric vector datatypes @cindex SRFI-4 @c FIXME::martin: Review me! -SRFI-4 defines a set of datatypes for vectors whose elements are all -of the same numeric type. Vectors for signed and unsigned exact -integer or inexact real numbers in several precisions are available. +SRFI-4 defines a set of datatypes and functions for vectors whose +elements are numbers, all of the same numeric type. Vectors for +signed and unsigned exact integers and inexact reals in several +precisions are available. Being homogeneous means they require less +memory than normal vectors. + +The functions and the read syntax in this section are made available +with + +@lisp +(use-modules (srfi srfi-4)) +@end lisp Procedures similar to the vector procedures (@pxref{Vectors}) are provided for handling these homogeneous vectors, but they are distinct -datatypes. - -The reason for providing this set of datatypes is that with the -limitation (all elements must have the same type), it is possible to -implement them much more memory-efficient than normal, heterogenous -vectors. - -If you want to use these datatypes and the corresponding procedures, -you have to use the module @code{(srfi srfi-4)}. +datatypes and the two cannot be inter-mixed. Ten vector data types are provided: Unsigned and signed integer values with 8, 16, 32 and 64 bits and floating point values with 32 and 64 -bits. In the following descriptions, the tags @code{u8}, @code{s8}, -@code{u16}, @code{s16}, @code{u32}, @code{s32}, @code{u64}, -@code{s64}, @code{f32}, @code{f64}, respectively, are used for -denoting the various types. +bits. The type is indicated by a tag in the function names, +@code{u8}, @code{s8}, @code{u16}, @code{s16}, @code{u32}, @code{s32}, +@code{u64}, @code{s64}, @code{f32}, @code{f64}. -@menu -* SRFI-4 - Read Syntax:: How to write homogeneous vector literals. -* SRFI-4 - Procedures:: Available homogeneous vector procedures. -@end menu - - -@node SRFI-4 - Read Syntax -@subsection SRFI-4 - Read Syntax - -Homogeneous numeric vectors have an external representation (read -syntax) similar to normal Scheme vectors, but with an additional tag -telling the vector's type. +The external representation (ie.@: read syntax) for these vectors is +similar to normal Scheme vectors, but with an additional tag +indiciating the vector's type. For example, @lisp #u16(1 2 3) -@end lisp - -denotes a homogeneous numeric vector of three elements, which are the -values 1, 2 and 3, represented as 16-bit unsigned integers. -Correspondingly, - -@lisp #f64(3.1415 2.71) @end lisp -denotes a vector of two elements, which are the values 3.1415 and -2.71, represented as floating-point values of 64 bit precision. +Note that the read syntax for floating-point here conflicts with +@code{#f} for false. In Standard Scheme one can write @code{(1 +#f3)} for a three element list @code{(1 #f 3)}, but with the SRFI-4 +module @code{(1 #f3)} is invalid. @code{(1 #f 3)} is almost certainly +what one should write anyway to make the intention clear, so this is +rarely a problem. -Please note that the read syntax for floating-point vectors conflicts -with Standard Scheme, because there @code{#f} is defined to be the -literal false value. That means, that with the loaded SRFI-4 module, -it is not possible to enter some list like - -@lisp -'(1 #f3) -@end lisp - -and hope that it will be parsed as a three-element list with the -elements 1, @code{#f} and 3. In normal use, this should be no -problem, because people tend to terminate tokens sensibly when writing -Scheme expressions. - -@node SRFI-4 - Procedures -@subsection SRFI-4 Procedures - -The procedures listed in this section are provided for all homogeneous -numeric vector datatypes. For brevity, they are not all documented, -but a summary of the procedures is given. In the following -descriptions, you can replace @code{TAG} by any of the datatype -indicators @code{u8}, @code{s8}, @code{u16}, @code{s16}, @code{u32}, -@code{s32}, @code{u64}, @code{s64}, @code{f32} and @code{f64}. - -For example, you can use the procedures @code{u8vector?}, -@code{make-s8vector}, @code{u16vector}, @code{u32vector-length}, -@code{s64vector-ref}, @code{f32vector-set!} or @code{f64vector->list}. - -@deffn {Scheme Procedure} TAGvector? obj -Return @code{#t} if @var{obj} is a homogeneous numeric vector of type -@code{TAG}. +@deffn {Scheme Procedure} u8vector? obj +@deffnx {Scheme Procedure} s8vector? obj +@deffnx {Scheme Procedure} u16vector? obj +@deffnx {Scheme Procedure} s16vector? obj +@deffnx {Scheme Procedure} u32vector? obj +@deffnx {Scheme Procedure} s32vector? obj +@deffnx {Scheme Procedure} u64vector? obj +@deffnx {Scheme Procedure} s64vector? obj +@deffnx {Scheme Procedure} f32vector? obj +@deffnx {Scheme Procedure} f64vector? obj +Return @code{#t} if @var{obj} is a homogeneous numeric vector of the +indicated type. @end deffn -@deffn {Scheme Procedure} make-TAGvector n [value] -Create a newly allocated homogeneous numeric vector of type -@code{TAG}, which can hold @var{n} elements. If @var{value} is given, -the vector is initialized with the value, otherwise, the contents of -the returned vector is not specified. +@deffn {Scheme Procedure} make-u8vector n [value] +@deffnx {Scheme Procedure} make-s8vector n [value] +@deffnx {Scheme Procedure} make-u16vector n [value] +@deffnx {Scheme Procedure} make-s16vector n [value] +@deffnx {Scheme Procedure} make-u32vector n [value] +@deffnx {Scheme Procedure} make-s32vector n [value] +@deffnx {Scheme Procedure} make-u64vector n [value] +@deffnx {Scheme Procedure} make-s64vector n [value] +@deffnx {Scheme Procedure} make-f32vector n [value] +@deffnx {Scheme Procedure} make-f64vector n [value] +Return a newly allocated homogeneous numeric vector holding @var{n} +elements of the indicated type. If @var{value} is given, the vector +is initialized with that value, otherwise the contents are +unspecified. @end deffn -@deffn {Scheme Procedure} TAGvector value1 @dots{} -Create a newly allocated homogeneous numeric vector of type -@code{TAG}. The returned vector is as long as the number of arguments -given, and is initialized with the argument values. +@deffn {Scheme Procedure} u8vector value @dots{} +@deffnx {Scheme Procedure} s8vector value @dots{} +@deffnx {Scheme Procedure} u16vector value @dots{} +@deffnx {Scheme Procedure} s16vector value @dots{} +@deffnx {Scheme Procedure} u32vector value @dots{} +@deffnx {Scheme Procedure} s32vector value @dots{} +@deffnx {Scheme Procedure} u64vector value @dots{} +@deffnx {Scheme Procedure} s64vector value @dots{} +@deffnx {Scheme Procedure} f32vector value @dots{} +@deffnx {Scheme Procedure} f64vector value @dots{} +Return a newly allocated homogeneous numeric vector of the indicated +type, holding the given parameter @var{value}s. The vector length is +the number of parameters given. @end deffn -@deffn {Scheme Procedure} TAGvector-length TAGvec -Return the number of elements in @var{TAGvec}. +@deffn {Scheme Procedure} u8vector-length vec +@deffnx {Scheme Procedure} s8vector-length vec +@deffnx {Scheme Procedure} u16vector-length vec +@deffnx {Scheme Procedure} s16vector-length vec +@deffnx {Scheme Procedure} u32vector-length vec +@deffnx {Scheme Procedure} s32vector-length vec +@deffnx {Scheme Procedure} u64vector-length vec +@deffnx {Scheme Procedure} s64vector-length vec +@deffnx {Scheme Procedure} f32vector-length vec +@deffnx {Scheme Procedure} f64vector-length vec +Return the number of elements in @var{vec}. @end deffn -@deffn {Scheme Procedure} TAGvector-ref TAGvec i -Return the element at index @var{i} in @var{TAGvec}. +@deffn {Scheme Procedure} u8vector-ref vec i +@deffnx {Scheme Procedure} s8vector-ref vec i +@deffnx {Scheme Procedure} u16vector-ref vec i +@deffnx {Scheme Procedure} s16vector-ref vec i +@deffnx {Scheme Procedure} u32vector-ref vec i +@deffnx {Scheme Procedure} s32vector-ref vec i +@deffnx {Scheme Procedure} u64vector-ref vec i +@deffnx {Scheme Procedure} s64vector-ref vec i +@deffnx {Scheme Procedure} f32vector-ref vec i +@deffnx {Scheme Procedure} f64vector-ref vec i +Return the element at index @var{i} in @var{vec}. The first element +in @var{vec} is index 0. @end deffn -@deffn {Scheme Procedure} TAGvector-ref TAGvec i value -Set the element at index @var{i} in @var{TAGvec} to @var{value}. The -return value is not specified. +@deffn {Scheme Procedure} u8vector-ref vec i value +@deffnx {Scheme Procedure} s8vector-ref vec i value +@deffnx {Scheme Procedure} u16vector-ref vec i value +@deffnx {Scheme Procedure} s16vector-ref vec i value +@deffnx {Scheme Procedure} u32vector-ref vec i value +@deffnx {Scheme Procedure} s32vector-ref vec i value +@deffnx {Scheme Procedure} u64vector-ref vec i value +@deffnx {Scheme Procedure} s64vector-ref vec i value +@deffnx {Scheme Procedure} f32vector-ref vec i value +@deffnx {Scheme Procedure} f64vector-ref vec i value +Set the element at index @var{i} in @var{vec} to @var{value}. The +first element in @var{vec} is index 0. The return value is +unspecified. @end deffn -@deffn {Scheme Procedure} TAGvector->list TAGvec -Return a newly allocated list holding all elements of @var{TAGvec}. +@deffn {Scheme Procedure} u8vector->list vec +@deffnx {Scheme Procedure} s8vector->list vec +@deffnx {Scheme Procedure} u16vector->list vec +@deffnx {Scheme Procedure} s16vector->list vec +@deffnx {Scheme Procedure} u32vector->list vec +@deffnx {Scheme Procedure} s32vector->list vec +@deffnx {Scheme Procedure} u64vector->list vec +@deffnx {Scheme Procedure} s64vector->list vec +@deffnx {Scheme Procedure} f32vector->list vec +@deffnx {Scheme Procedure} f64vector->list vec +Return a newly allocated list holding all elements of @var{vec}. @end deffn -@deffn {Scheme Procedure} list->TAGvector lst -Return a newly allocated homogeneous numeric vector of type @code{TAG}, +@deffn {Scheme Procedure} list->u8vector lst +@deffnx {Scheme Procedure} list->s8vector lst +@deffnx {Scheme Procedure} list->u16vector lst +@deffnx {Scheme Procedure} list->s16vector lst +@deffnx {Scheme Procedure} list->u32vector lst +@deffnx {Scheme Procedure} list->s32vector lst +@deffnx {Scheme Procedure} list->u64vector lst +@deffnx {Scheme Procedure} list->s64vector lst +@deffnx {Scheme Procedure} list->f32vector lst +@deffnx {Scheme Procedure} list->f64vector lst +Return a newly allocated homogeneous numeric vector of the indicated type, initialized with the elements of the list @var{lst}. @end deffn From c6e94bec5a99320ed79db827787c6d2718b6fd1c Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 15 Feb 2004 00:20:55 +0000 Subject: [PATCH 098/167] *** empty log message *** --- doc/ref/ChangeLog | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index abedc3d9f..941510096 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,17 @@ +2004-02-15 Kevin Ryde + + * scheme-compound.texi (Hash Table Reference): In scm_hash_ref etc, + remove note that dflt must be given, it can be SCM_UNSPECIFIED. + + * scheme-control.texi (while do): Expand and clarify `do', in + particular note iteration binds fresh locations, rather than values + "stored". + + * srfi-modules.texi (SRFI-4): Revise for clarity, give each function + explicitly rather than showing TAG so Emacs info-look can find them, + merge "SRFI-4 - Read Syntax" and "SRFI-4 - Procedures" into just one + node. + 2004-02-12 Kevin Ryde * scheme-compound.texi (Conventional Arrays): Revise for clarity. From 344a212fd1e7c20c650fd7aaa54045d748e7ee86 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 15 Feb 2004 00:37:52 +0000 Subject: [PATCH 099/167] *** empty log message *** --- libguile/ChangeLog | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d974dd7c1..bb75bbbdf 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -15,6 +15,14 @@ 2004-02-12 Kevin Ryde + * ports.c (scm_port_line): In docstring, note first line is 0. + (scm_set_port_line_x): In docstring, note first line is 0. + (scm_port_column): In docstring, there's no default to current input + port, and remove shared port-line @defun. + (scm_set_port_column_x): In docstring, there's no default to current + input port, note first column is 0, remove shared set-port-line! + @defun. + * ramap.c (scm_array_fill_x): For fvect and dvect, use scm_num2dbl to convert args the same way that array-set! does. From c78a96e0638a9b40d72dbdd1ad3677f7f8243b2a Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sun, 15 Feb 2004 18:27:31 +0000 Subject: [PATCH 100/167] * configure.in: Use AC_PROG_LIBTOOL instead of AM_PROG_LIBTOOL. * scheme-compound.texi (Hash Table Reference): Renamed hash-map --> hash-map->list. * configure.in: Use AC_PROG_LIBTOOL instead of AM_PROG_LIBTOOL. --- ChangeLog | 4 ++++ configure.in | 2 +- doc/ref/ChangeLog | 5 +++++ doc/ref/scheme-compound.texi | 10 +++++----- guile-readline/ChangeLog | 4 ++++ guile-readline/configure.in | 2 +- 6 files changed, 20 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1dda90b33..9f24837a1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2004-02-15 Mikael Djurfeldt + + * configure.in: Use AC_PROG_LIBTOOL instead of AM_PROG_LIBTOOL. + 2004-01-25 Neil Jerram * configure.in (GUILE_FUNC_DECLARED), acinclude.m4 diff --git a/configure.in b/configure.in index 923672f88..509ea8e32 100644 --- a/configure.in +++ b/configure.in @@ -56,7 +56,7 @@ AC_MINIX AM_PROG_CC_STDC AC_LIBTOOL_DLOPEN -AM_PROG_LIBTOOL +AC_PROG_LIBTOOL AC_LIB_LTDL AC_CHECK_PROG(have_makeinfo, makeinfo, yes, no) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 941510096..e0d55381a 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2004-02-15 Mikael Djurfeldt + + * scheme-compound.texi (Hash Table Reference): Renamed hash-map + --> hash-map->list. + 2004-02-15 Kevin Ryde * scheme-compound.texi (Hash Table Reference): In scm_hash_ref etc, diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index 49dd5d939..c74d4881d 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -2481,17 +2481,17 @@ create an entry for it with @var{init} as the value, and return that pair. @end deffn -@deffn {Scheme Procedure} hash-map proc table +@deffn {Scheme Procedure} hash-map->list proc table @deffnx {Scheme Procedure} hash-for-each proc table -@deffnx {C Function} scm_hash_map (proc, table) +@deffnx {C Function} scm_hash_map_to_list (proc, table) @deffnx {C Function} scm_hash_for_each (proc, table) Apply @var{proc} to the entries in the given hash @var{table}. Each -call is @code{(@var{proc} @var{key} @var{value})}. @code{hash-map} +call is @code{(@var{proc} @var{key} @var{value})}. @code{hash-map->list} returns a list of the results from these calls, @code{hash-for-each} discards the results and returns an unspecified value. Calls are made over the table entries in an unspecified order, and for -@code{hash-map} the order of the values in the returned list is +@code{hash-map->list} the order of the values in the returned list is unspecified. Results will be unpredictable if @var{table} is modified while iterating. @@ -2499,7 +2499,7 @@ For example the following returns a new alist comprising all the entries from @code{mytable}, in no particular order. @example -(hash-map cons mytable) +(hash-map->list cons mytable) @end example @end deffn diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index 8d94208bb..82ed015c3 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,7 @@ +2004-02-15 Mikael Djurfeldt + + * configure.in: Use AC_PROG_LIBTOOL instead of AM_PROG_LIBTOOL. + 2004-02-08 Mikael Djurfeldt * Makefile.am (TAGS_FILES): Use this variable instead of diff --git a/guile-readline/configure.in b/guile-readline/configure.in index 1d389752a..e9325ea3c 100644 --- a/guile-readline/configure.in +++ b/guile-readline/configure.in @@ -10,7 +10,7 @@ AC_PROG_INSTALL AC_PROG_CC AM_PROG_CC_STDC AC_LIBTOOL_WIN32_DLL -AM_PROG_LIBTOOL +AC_PROG_LIBTOOL dnl dnl Check for Winsock and other functionality on Win32 (*not* CygWin) From fd96f380d27c6a94fd16ca8f8ac15d4a45288a02 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 15 Feb 2004 21:49:55 +0000 Subject: [PATCH 101/167] (Sloppy Alist Functions): Amend error messages shown to match current guile output. --- doc/ref/scheme-compound.texi | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index c74d4881d..89de8b382 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -2137,8 +2137,7 @@ whole is not a proper list: (assoc "mary" '((1 . 2) ("key" . "door") . "open sesame")) @result{} ERROR: In procedure assoc in expression (assoc "mary" (quote #)): -ERROR: Wrong type argument in position 2 (expecting NULLP): "open sesame" -ABORT: (wrong-type-arg) +ERROR: Wrong type argument in position 2 (expecting association list): ((1 . 2) ("key" . "door") . "open sesame") (sloppy-assoc "mary" '((1 . 2) ("key" . "door") . "open sesame")) @result{} @@ -2152,8 +2151,7 @@ Secondly, if one of the entries in the specified alist is not a pair: (assoc 2 '((1 . 1) 2 (3 . 9))) @result{} ERROR: In procedure assoc in expression (assoc 2 (quote #)): -ERROR: Wrong type argument in position 2 (expecting CONSP): 2 -ABORT: (wrong-type-arg) +ERROR: Wrong type argument in position 2 (expecting association list): ((1 . 1) 2 (3 . 9)) (sloppy-assoc 2 '((1 . 1) 2 (3 . 9))) @result{} From 99fcc9405fe209523e2adc9c6b74ad674265226f Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 15 Feb 2004 21:51:00 +0000 Subject: [PATCH 102/167] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index e0d55381a..4e02f4c34 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2004-02-16 Kevin Ryde + + * scheme-compound.texi (Sloppy Alist Functions): Amend error messages + shown to match current guile output. + 2004-02-15 Mikael Djurfeldt * scheme-compound.texi (Hash Table Reference): Renamed hash-map From 411a674a2d00f527b64509fbf4bbc8bb80d380b5 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sun, 15 Feb 2004 22:07:33 +0000 Subject: [PATCH 103/167] (Hash Table Reference): Wrote a new entry for hash-for-each-handle. --- doc/ref/ChangeLog | 5 +++++ doc/ref/scheme-compound.texi | 10 ++++++++++ 2 files changed, 15 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 4e02f4c34..007da3727 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2004-02-15 Mikael Djurfeldt + + * scheme-compound.texi (Hash Table Reference): Wrote a new entry + for hash-for-each-handle. + 2004-02-16 Kevin Ryde * scheme-compound.texi (Sloppy Alist Functions): Amend error messages diff --git a/doc/ref/scheme-compound.texi b/doc/ref/scheme-compound.texi index 89de8b382..49e206161 100644 --- a/doc/ref/scheme-compound.texi +++ b/doc/ref/scheme-compound.texi @@ -2501,6 +2501,16 @@ entries from @code{mytable}, in no particular order. @end example @end deffn +@deffn {Scheme Procedure} hash-for-each-handle proc table +@deffnx {C Function} scm_hash_for_each_handle (proc, table) +Apply @var{proc} to the entries in the given hash @var{table}. Each +call is @code{(@var{proc} @var{handle})}, where @var{handle} is a +@code{(@var{key} . @var{value})} pair. Return an unspecified value. + +@code{hash-for-each-handle} differs from @code{hash-for-each} only in +the argument list of @var{proc}. +@end deffn + @deffn {Scheme Procedure} hash-fold proc init table @deffnx {C Function} scm_hash_fold (proc, init, table) Accumulate a result by applying @var{proc} to the elements of the From 292dfa7fbc711456ed66ca09356d56e15381f408 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 15 Feb 2004 23:44:15 +0000 Subject: [PATCH 104/167] *** empty log message *** --- libguile/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index bb75bbbdf..6d4c4577a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2004-02-16 Kevin Ryde + + * num2float.i.c (NUM2FLOAT): Expand isfinite to !xisinf, as per + previous change to numbers.c. + 2004-02-13 Mikael Djurfeldt * unif.c (scm_make_uve): Removed local variable and simplified From e69681aef46f42323e6daa26cccb60e6d8c24d3a Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sun, 15 Feb 2004 23:49:20 +0000 Subject: [PATCH 105/167] (scm_shell_usage): Print bug-guile email address, as per GNU standard. Reported by Han-Wen Nienhuys. --- libguile/script.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libguile/script.c b/libguile/script.c index 74a910db0..622836290 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -373,7 +373,9 @@ scm_shell_usage (int fatal, char *message) " which is a list of numbers like \"2,13,14\"\n" " -h, --help display this help and exit\n" " -v, --version display version information and exit\n" - " \\ read arguments from following script lines\n", + " \\ read arguments from following script lines\n" + "\n" + "Report bugs to bug-guile@gnu.org\n", scm_usage_name); if (fatal) From ae43d08ea0c556fd6aeb188287a8baa87f3f60a7 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 16 Feb 2004 00:03:44 +0000 Subject: [PATCH 106/167] *** empty log message *** --- libguile/ChangeLog | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 6d4c4577a..5b7a297b4 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,8 +1,11 @@ -2004-02-16 Kevin Ryde +2004-02-16 Kevin Ryde * num2float.i.c (NUM2FLOAT): Expand isfinite to !xisinf, as per previous change to numbers.c. + * script.c (scm_shell_usage): Print bug-guile email address, as per + GNU standard. Reported by Han-Wen Nienhuys. + 2004-02-13 Mikael Djurfeldt * unif.c (scm_make_uve): Removed local variable and simplified From 4cd3853f3717168dce92ec49a2d51b49abd27d9e Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 16 Feb 2004 00:45:55 +0000 Subject: [PATCH 107/167] (scm_done_malloc, scm_done_free): Allow negative sizes, which were permitted in the past for these. --- libguile/gc-malloc.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 8e2190cfb..6cfb62769 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004 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 @@ -447,7 +447,10 @@ scm_done_malloc (long size) ("scm_done_malloc is deprecated. " "Use scm_gc_register_collectable_memory instead."); - scm_gc_register_collectable_memory (NULL, size, "foreign mallocs"); + if (size >= 0) + scm_gc_register_collectable_memory (NULL, size, "foreign mallocs"); + else + scm_gc_unregister_collectable_memory (NULL, -size, "foreign mallocs"); } void @@ -457,7 +460,10 @@ scm_done_free (long size) ("scm_done_free is deprecated. " "Use scm_gc_unregister_collectable_memory instead."); - scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs"); + if (size >= 0) + scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs"); + else + scm_gc_register_collectable_memory (NULL, -size, "foreign mallocs"); } #endif /* SCM_ENABLE_DEPRECATED == 1 */ From 290e9e11e473869acf9933187cffa7313976f4f4 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 16 Feb 2004 00:50:23 +0000 Subject: [PATCH 108/167] Add a copyright year. --- libguile/gc-malloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 6cfb62769..ef7a4e473 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 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 From c9ea646268d9de1f05612d8a5bd8dbc978e949ec Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 16 Feb 2004 00:51:17 +0000 Subject: [PATCH 109/167] *** empty log message *** --- libguile/ChangeLog | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5b7a297b4..ac5ac5735 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,8 @@ 2004-02-16 Kevin Ryde + * gc-malloc.c (scm_done_malloc, scm_done_free): Allow negative sizes, + which were permitted in the past for these. + * num2float.i.c (NUM2FLOAT): Expand isfinite to !xisinf, as per previous change to numbers.c. From 3f12a4ec05014e0d78a755c05c96af991b7acd84 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 17 Feb 2004 21:18:53 +0000 Subject: [PATCH 110/167] Added LGPL terms. --- test-suite/tests/r5rs_pitfall.test | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/test-suite/tests/r5rs_pitfall.test b/test-suite/tests/r5rs_pitfall.test index 4c4bce6c4..65204ab15 100644 --- a/test-suite/tests/r5rs_pitfall.test +++ b/test-suite/tests/r5rs_pitfall.test @@ -1,8 +1,22 @@ ;;;; r5rs_pitfall.test --- tests some pitfalls in R5RS -*- scheme -*- -;;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2.1 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ;; These tests have been copied from -;; http://sisc.sourceforge.net/r5rs_pitfal.scm and the 'should-be' +;; http://sisc.sourceforge.net/r5rs_pitfall.scm and the 'should-be' ;; macro has been modified to fit into our test suite machinery. ;; ;; Test 1.1 fails, but we expect that. From 581e4579de67667eb1ace78be01b5b9ea59b8480 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 17 Feb 2004 21:37:47 +0000 Subject: [PATCH 111/167] Added GPL terms. --- test-suite/tests/fractions.test | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/test-suite/tests/fractions.test b/test-suite/tests/fractions.test index 02bfa22e8..802369f31 100644 --- a/test-suite/tests/fractions.test +++ b/test-suite/tests/fractions.test @@ -1,3 +1,20 @@ +;;;; Copyright (C) 2004 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 version 2 as +;;;; published by the Free Software Foundation; see file GNU-GPL. +;;;; +;;;; 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. + +;;; Based in part on code from GNU CLISP + (define-module (test-suite test-fractions) #:use-module (test-suite lib) #:use-module (ice-9 documentation) From 7b93c2e5b1f6ccd36b15038ccc3b6ece6b9a6a77 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 17 Feb 2004 21:39:10 +0000 Subject: [PATCH 112/167] (SCM_TESTS): Added test/fractions.test. --- test-suite/Makefile.am | 1 + 1 file changed, 1 insertion(+) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index ad232bd6b..945268c6d 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -32,6 +32,7 @@ SCM_TESTS = tests/alist.test \ tests/eval.test \ tests/exceptions.test \ tests/format.test \ + tests/fractions.test \ tests/gc.test \ tests/getopt-long.test \ tests/goops.test \ From 17f732e6fa6e72718a52a38b79153e9d6121fcd0 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Tue, 17 Feb 2004 21:39:21 +0000 Subject: [PATCH 113/167] *** empty log message *** --- test-suite/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index dfdb183a2..39bbbcabf 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2004-02-17 Marius Vollmer + + * Makefile.am (SCM_TESTS): Added test/fractions.test. + 2004-01-23 Marius Vollmer * tests/r5rs_pitfall.scm: Removed again. I was confused. The From afe199fe64a8a0e3c6779a333cbbed8a414f5a78 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 17 Feb 2004 23:27:27 +0000 Subject: [PATCH 114/167] *** empty log message *** --- test-suite/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 39bbbcabf..547ea071d 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -2,6 +2,10 @@ * Makefile.am (SCM_TESTS): Added test/fractions.test. +2004-02-12 Kevin Ryde + + * tests/unif.test (array?, array-fill!, array-prototype): Add tests. + 2004-01-23 Marius Vollmer * tests/r5rs_pitfall.scm: Removed again. I was confused. The From 73ae3b4cb5966d51df65a2e9f1fbe34bca9ba1bd Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Tue, 17 Feb 2004 23:37:06 +0000 Subject: [PATCH 115/167] (scm_localtime, scm_gmtime, scm_mktime): Provide a default errno EINVAL in case localtime and gmtime don't set it. (scm_mktime, scm_strptime): Forcibly use errno EINVAL for our SCM_SYSERROR, since mktime and strptime generally don't set errno. --- libguile/stime.c | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/libguile/stime.c b/libguile/stime.c index 6bf212210..ded4bb51a 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -327,6 +327,9 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, #ifdef LOCALTIME_CACHE tzset (); #endif + /* POSIX says localtime sets errno, but C99 doesn't say that. + Give a sensible default value in case localtime doesn't set it. */ + errno = EINVAL; ltptr = localtime (&itime); err = errno; if (ltptr) @@ -347,6 +350,9 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, /* the struct is copied in case localtime and gmtime share a buffer. */ if (ltptr) lt = *ltptr; + /* POSIX says gmtime sets errno, but C99 doesn't say that. + Give a sensible default value in case gmtime doesn't set it. */ + errno = EINVAL; utc = gmtime (&itime); if (utc == NULL) err = errno; @@ -389,6 +395,9 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0, itime = SCM_NUM2LONG (1, time); SCM_DEFER_INTS; + /* POSIX says gmtime sets errno, but C99 doesn't say that. + Give a sensible default value in case gmtime doesn't set it. */ + errno = EINVAL; bd_time = gmtime (&itime); if (bd_time == NULL) SCM_SYSERROR; @@ -461,7 +470,9 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, tzset (); #endif itime = mktime (<); - err = errno; + /* POSIX doesn't say mktime sets errno, and on glibc 2.3.2 for instance it + doesn't. Force a sensible value for our error message. */ + err = EINVAL; if (itime != -1) { @@ -480,6 +491,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, } /* get timezone offset in seconds west of UTC. */ + /* POSIX says gmtime sets errno, but C99 doesn't say that. + Give a sensible default value in case gmtime doesn't set it. */ utc = gmtime (&itime); if (utc == NULL) err = errno; @@ -660,7 +673,13 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0, t.tm_isdst = -1; SCM_DEFER_INTS; if ((rest = strptime (str, fmt, &t)) == NULL) - SCM_SYSERROR; + { + /* POSIX doesn't say strptime sets errno, and on glibc 2.3.2 for + instance it doesn't. Force a sensible value for our error + message. */ + errno = EINVAL; + SCM_SYSERROR; + } SCM_ALLOW_INTS; return scm_cons (filltime (&t, 0, NULL), SCM_MAKINUM (rest - str)); From ef73a2a0e9c78c73c2f084f50aeae7b47d56df5d Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:06:10 +0000 Subject: [PATCH 116/167] (AC_CHECK_HEADERS): Add crt_externs.h. (AC_CHECK_FUNCS): Add _NSGetEnviron. --- configure.in | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/configure.in b/configure.in index 509ea8e32..40584387c 100644 --- a/configure.in +++ b/configure.in @@ -582,9 +582,15 @@ AC_SUBST(EXTRA_DEFS) AC_SUBST(DLPREOPEN) -AC_CHECK_HEADERS([assert.h]) +# Reasons for testing: +# crt_externs.h - Darwin specific +# +AC_CHECK_HEADERS([assert.h crt_externs.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 unsetenv]) +# Reasons for testing: +# _NSGetEnviron - Darwin specific +# +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 unsetenv _NSGetEnviron]) AC_CHECK_HEADERS(crypt.h sys/resource.h sys/file.h) AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname) From 424d0540f263a9099afe103139979860877c727d Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:11:34 +0000 Subject: [PATCH 117/167] *** empty log message *** --- ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ChangeLog b/ChangeLog index 9f24837a1..1335aac1a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2004-02-18 Kevin Ryde + + * configure.in (AC_CHECK_HEADERS): Add crt_externs.h. + (AC_CHECK_FUNCS): Add _NSGetEnviron. + 2004-02-15 Mikael Djurfeldt * configure.in: Use AC_PROG_LIBTOOL instead of AM_PROG_LIBTOOL. From eb7e1603ad497d0efff686e26e23af987c567721 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:20:08 +0000 Subject: [PATCH 118/167] (environ): Use _NSGetEnviron in Darwin shared library, since environ is not directly available there. --- libguile/posix.c | 22 +++++++++++++++++++++- libguile/putenv.c | 13 ++++++++++++- libguile/stime.c | 15 ++++++++++++++- 3 files changed, 47 insertions(+), 3 deletions(-) diff --git a/libguile/posix.c b/libguile/posix.c index 04113e3f2..38835bcca 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -122,6 +122,10 @@ extern char ** environ; # include #endif +#if HAVE_CRT_EXTERNS_H +#include /* for Darwin _NSGetEnviron */ +#endif + /* Some Unix systems don't define these. CPP hair is dangerous, but this seems safe enough... */ #ifndef R_OK @@ -157,7 +161,23 @@ extern char ** environ; /* Please don't add any more #includes or #defines here. The hack above means that _POSIX_SOURCE may be #defined, which will - encourage header files to do strange things. */ + encourage header files to do strange things. + + FIXME: Maybe should undef _POSIX_SOURCE after it's done its job. + + FIXME: Probably should do all the includes first, then all the fallback + declarations and defines, in case things are not in the header we + imagine. */ + + + + +/* On Apple Darwin in a shared library there's no "environ" to access + directly, instead the address of that variable must be obtained with + _NSGetEnviron(). */ +#if HAVE__NSGETENVIRON && defined (PIC) +#define environ (*_NSGetEnviron()) +#endif SCM_SYMBOL (sym_read_pipe, "read pipe"); diff --git a/libguile/putenv.c b/libguile/putenv.c index ebd720242..cc6d27b72 100644 --- a/libguile/putenv.c +++ b/libguile/putenv.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1991, 2000, 2001 Free Software Foundation, Inc. +/* Copyright (C) 1991, 2000, 2001, 2004 Free Software Foundation, Inc. * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -51,12 +51,23 @@ char *malloc (); #include #endif +#if HAVE_CRT_EXTERNS_H +#include /* for Darwin _NSGetEnviron */ +#endif + #ifndef NULL #define NULL 0 #endif extern char **environ; +/* On Apple Darwin in a shared library there's no "environ" to access + directly, instead the address of that variable must be obtained with + _NSGetEnviron(). */ +#if HAVE__NSGETENVIRON && defined (PIC) +#define environ (*_NSGetEnviron()) +#endif + /* Put STRING, which is of the form "NAME=VALUE", in the environment. */ int putenv (const char *string) diff --git a/libguile/stime.c b/libguile/stime.c index ded4bb51a..8ba1ced8e 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -54,6 +54,10 @@ # include #endif +#if HAVE_CRT_EXTERNS_H +#include /* for Darwin _NSGetEnviron */ +#endif + #ifndef tzname /* For SGI. */ extern char *tzname[]; /* RS6000 and others reject char **tzname. */ #endif @@ -71,6 +75,16 @@ extern char *strptime (); # define timet long #endif +extern char ** environ; + +/* On Apple Darwin in a shared library there's no "environ" to access + directly, instead the address of that variable must be obtained with + _NSGetEnviron(). */ +#if HAVE__NSGETENVIRON && defined (PIC) +#define environ (*_NSGetEnviron()) +#endif + + #ifdef HAVE_TIMES static timet mytime() @@ -260,7 +274,6 @@ filltime (struct tm *bd_time, int zoff, char *zname) } static char tzvar[3] = "TZ"; -extern char ** environ; /* if zone is set, create a temporary environment with only a TZ string. other threads or interrupt handlers shouldn't be allowed From d8b95e27aba936a909fcfb4bac7accb14d383fdb Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:21:11 +0000 Subject: [PATCH 119/167] (scm_num_eq_p): For real==frac, complex==frac, frac==real and frac==complex, make an exact comparison rather than converting with fraction2double. --- libguile/numbers.c | 49 ++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 43 insertions(+), 6 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index b34528deb..62515edae 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -2945,6 +2945,7 @@ SCM_GPROC1 (s_eq_p, "=", scm_tc7_rpsubr, scm_num_eq_p, g_eq_p); SCM scm_num_eq_p (SCM x, SCM y) { + again: if (SCM_INUMP (x)) { long xx = SCM_INUM (x); @@ -3019,7 +3020,15 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)) && (0.0 == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) == scm_i_fraction2double (y)); + { + double xx = SCM_REAL_VALUE (x); + if (xisnan (xx)) + return SCM_BOOL_F; + if (xisinf (xx)) + return SCM_BOOL (xx < 0.0); + x = scm_inexact_to_exact (x); /* with x as frac or int */ + goto again; + } else SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p); } @@ -3046,8 +3055,18 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)) && (SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) - return SCM_BOOL ((SCM_COMPLEX_REAL (x) == scm_i_fraction2double (y)) - && (SCM_COMPLEX_IMAG (x) == 0.0)); + { + double xx; + if (SCM_COMPLEX_IMAG (x) != 0.0) + return SCM_BOOL_F; + xx = SCM_COMPLEX_REAL (x); + if (xisnan (xx)) + return SCM_BOOL_F; + if (xisinf (xx)) + return SCM_BOOL (xx < 0.0); + x = scm_inexact_to_exact (x); /* with x as frac or int */ + goto again; + } else SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p); } @@ -3058,10 +3077,28 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_BIGP (y)) return SCM_BOOL_F; else if (SCM_REALP (y)) - return SCM_BOOL (scm_i_fraction2double (x) == SCM_REAL_VALUE (y)); + { + double yy = SCM_REAL_VALUE (y); + if (xisnan (yy)) + return SCM_BOOL_F; + if (xisinf (yy)) + return SCM_BOOL (0.0 < yy); + y = scm_inexact_to_exact (y); /* with y as frac or int */ + goto again; + } else if (SCM_COMPLEXP (y)) - return SCM_BOOL ((scm_i_fraction2double (x) == SCM_COMPLEX_REAL (y)) - && (0.0 == SCM_COMPLEX_IMAG (y))); + { + double yy; + if (SCM_COMPLEX_IMAG (y) != 0.0) + return SCM_BOOL_F; + yy = SCM_COMPLEX_REAL (y); + if (xisnan (yy)) + return SCM_BOOL_F; + if (xisinf (yy)) + return SCM_BOOL (0.0 < yy); + y = scm_inexact_to_exact (y); /* with y as frac or int */ + goto again; + } else if (SCM_FRACTIONP (y)) return scm_i_fraction_equalp (x, y); else From 48dc9f349d9cc78dddad08727c810bc2e9c34826 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:22:28 +0000 Subject: [PATCH 120/167] (scm_shell_usage): Print to stdout for --help, per GNU standard. --- libguile/script.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/libguile/script.c b/libguile/script.c index 622836290..a5f9e5f9e 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004 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 @@ -345,10 +345,12 @@ char *scm_usage_name = 0; void scm_shell_usage (int fatal, char *message) { - if (message) - fprintf (stderr, "%s\n", message); + FILE *fp = (fatal ? stderr : stdout); - fprintf (stderr, + if (message) + fprintf (fp, "%s\n", message); + + fprintf (fp, "Usage: %s OPTION ...\n" "Evaluate Scheme code, interactively or from a script.\n" "\n" From 29c560674bae3189b61b9c6836e0ea0e6615cf11 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:25:39 +0000 Subject: [PATCH 121/167] (INTEGRAL2BIG): WORDS_BIGENDIAN not right for word order parameter to mpz_import, in fact with just one word there's no order to worry about at all. --- libguile/num2integral.i.c | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/libguile/num2integral.i.c b/libguile/num2integral.i.c index 31dd81fed..85cd4b10b 100644 --- a/libguile/num2integral.i.c +++ b/libguile/num2integral.i.c @@ -204,15 +204,11 @@ INTEGRAL2BIG (ITYPE n) #endif mpz_import (SCM_I_BIG_MPZ (result), - 1, -#ifdef WORDS_BIGENDIAN - 1, -#else - -1, -#endif - SIZEOF_ITYPE, - 0, - 0, + 1, /* one word */ + 1, /* word order irrelevant when just one word */ + SIZEOF_ITYPE, /* word size */ + 0, /* native endianness within word */ + 0, /* no nails */ &n); /* mpz_import doesn't handle sign */ From 26bdd45f0811e72a5d9a973f20a9216cd8513999 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:28:41 +0000 Subject: [PATCH 122/167] Remove 1/3 == 1.0/3.0, not true. --- test-suite/tests/fractions.test | 1 - 1 file changed, 1 deletion(-) diff --git a/test-suite/tests/fractions.test b/test-suite/tests/fractions.test index 802369f31..d025fedee 100644 --- a/test-suite/tests/fractions.test +++ b/test-suite/tests/fractions.test @@ -41,7 +41,6 @@ (testeqv 3/4 6/8) (testeqv 3/4 3000000000000/4000000000000) (testeqv 3 3/1) - (test= 1/3 (/ 1.0 3.0)) (test= -1 (/ most-negative-fixnum (- most-negative-fixnum))) (testeq #t (integer? (/ most-negative-fixnum (- most-negative-fixnum)))) From 2a8b5e045fc7e4561f1be95794e8a760922c8d6e Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:29:16 +0000 Subject: [PATCH 123/167] (=): Exercise frac+real and frac+complex. --- test-suite/tests/numbers.test | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 28364f96f..d779873d4 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1308,7 +1308,25 @@ ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make ;; sure we've avoided that (pass-if (not (= (ash 3 1023) +nan.0))) - (pass-if (not (= +nan.0 (ash 3 1023))))) + (pass-if (not (= +nan.0 (ash 3 1023)))) + + (pass-if (= 1/2 0.5)) + (pass-if (not (= 1/3 0.333333333333333333333333333333333))) + (pass-if (not (= 2/3 0.5))) + (pass-if (not (= 0.5 (+ 1/2 (/ 1 (ash 1 1000)))))) + + (pass-if (= 1/2 0.5+0i)) + (pass-if (not (= 0.333333333333333333333333333333333 1/3))) + (pass-if (not (= 2/3 0.5+0i))) + (pass-if (not (= 1/2 0+0.5i))) + + (pass-if (= 0.5 1/2)) + (pass-if (not (= 0.5 2/3))) + (pass-if (not (= (+ 1/2 (/ 1 (ash 1 1000))) 0.5))) + + (pass-if (= 0.5+0i 1/2)) + (pass-if (not (= 0.5+0i 2/3))) + (pass-if (not (= 0+0.5i 1/2)))) ;;; ;;; < From ef861eadbab134543eb794b79df9d97973d729cb Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:30:37 +0000 Subject: [PATCH 124/167] *** empty log message *** --- libguile/ChangeLog | 21 +++++++++++++++++++++ test-suite/ChangeLog | 6 ++++++ 2 files changed, 27 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index ac5ac5735..f329c6b5b 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,24 @@ +2004-02-18 Kevin Ryde + + * num2integral.i.c (INTEGRAL2BIG): WORDS_BIGENDIAN not right for word + order parameter to mpz_import, in fact with just one word there's no + order to worry about at all. + + * numbers.c (scm_num_eq_p): For real==frac, complex==frac, frac==real + and frac==complex, make an exact comparison rather than converting + with fraction2double. + + * posix.c, putenv.c, stime.c (environ): Use _NSGetEnviron in Darwin + shared library, since environ is not directly available there. + + * script.c (scm_shell_usage): Print to stdout for --help, per GNU + standard. + + * stime.c (scm_localtime, scm_gmtime, scm_mktime): Provide a default + errno EINVAL in case localtime and gmtime don't set it. + (scm_mktime, scm_strptime): Forcibly use errno EINVAL for our + SCM_SYSERROR, since mktime and strptime generally don't set errno. + 2004-02-16 Kevin Ryde * gc-malloc.c (scm_done_malloc, scm_done_free): Allow negative sizes, diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 547ea071d..940ab9556 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2004-02-18 Kevin Ryde + + * tests/fractions.test: Remove 1/3 == 1.0/3.0, not true. + + * tests/numbers.test (=): Exercise frac+real and frac+complex. + 2004-02-17 Marius Vollmer * Makefile.am (SCM_TESTS): Added test/fractions.test. From 676483a68a8d7bc99fe4d2251d6e9b38029d1397 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:38:39 +0000 Subject: [PATCH 125/167] (Expression Syntax): Fill section with function calling etc, and quote and quasiquote. --- doc/ref/scheme-evaluation.texi | 122 +++++++++++++++++++++++++++++++++ 1 file changed, 122 insertions(+) diff --git a/doc/ref/scheme-evaluation.texi b/doc/ref/scheme-evaluation.texi index 738dc4de6..38338e9f2 100644 --- a/doc/ref/scheme-evaluation.texi +++ b/doc/ref/scheme-evaluation.texi @@ -38,6 +38,128 @@ loading and evaluating Scheme code at run time. @node Expression Syntax @subsection Expression Syntax +An expression to be evaluated takes one of the following forms. + +@deffn syntax +A symbol is evaluated by dereferencing. A binding of that symbol is +sought and the value there used. For example, + +@example +(define x 123) +x @result{} 123 +@end example +@end deffn + +@deffn syntax (proc [args @dots{}]) +A parenthesised expression is a function call. @var{proc} and each +argument are evaluated, then the function (which @var{proc} evaluated +to) is called with those arguments. + +The order in which @var{proc} and the arguments are evaluated is +unspecified, so be careful when using expressions with side effects. + +@example +(max 1 2 3) @result{} 3 + +(define (get-some-proc) min) +((get-some-proc) 1 2 3) @result{} 1 +@end example + +The same sort of parenthesised form is used for a macro invocation, +but in that case the arguments are not evaluated. See the +descriptions of macros for more on this (@pxref{Macros}, and +@pxref{Syntax Rules}). +@end deffn + +@deffn syntax +Number, string, character and boolean constants evaluate ``to +themselves'', so can appear as literals. + +@example +123 @result{} 123 +99.9 @result{} 99.9 +"hello" @result{} "hello" +#\z @result{} #\z +#t @result{} #t +@end example + +Note that an application must not attempt to modify literal strings, +since they may be in read-only memory. +@end deffn + +@deffn syntax quote data +@deffnx syntax ' data +Quoting is used to obtain a literal symbol (instead of a variable +reference), a literal list (instead of a function call), or a literal +vector. @nicode{'} is simply a shorthand for a @code{quote} form. +For example, + +@example +'x @result{} x +'(1 2 3) @result{} (1 2 3) +'#(1 (2 3) 4) @result{} #(1 (2 3) 4) +(quote x) @result{} x +(quote (1 2 3)) @result{} (1 2 3) +(quote #(1 (2 3) 4)) @result{} #(1 (2 3) 4) +@end example + +Note that an application must not attempt to modify literal lists or +vectors obtained from a @code{quote} form, since they may be in +read-only memory. +@end deffn + +@deffn syntax quasiquote data +@deffnx syntax ` data +Backquote quasi-quotation is like @code{quote}, but selected +sub-expressions are evaluated. This is a convenient way to construct +a list or vector structure most of which is constant, but at certain +points should have expressions substituted. + +The same effect can always be had with suitable @code{list}, +@code{cons} or @code{vector} calls, but quasi-quoting is often easier. + +@deffn syntax unquote expr +@deffnx syntax , expr +Within the quasiquote @var{data}, @code{unquote} or @code{,} indicates +an expression to be evaluated and inserted. The comma syntax @code{,} +is simply a shorthand for an @code{unquote} form. For example, + +@example +`(1 2 ,(* 9 9) 3 4) @result{} (1 2 81 3 4) +`(1 (unquote (+ 1 1)) 3) @result{} (1 2 3) +`#(1 ,(/ 12 2)) @result{} #(1 6) +@end example +@end deffn + +@deffn syntax unquote-splicing expr +@deffnx syntax ,@ expr +Within the quasiquote @var{data}, @code{unquote-splicing} or +@code{,@@} indicates an expression to be evaluated and the elements of +the returned list inserted. @var{expr} must evaluate to a list. The +``comma-at'' syntax @code{,@@} is simply a shorthand for an +@code{unquote-splicing} form. + +@example +(define x '(2 3)) +`(1 ,@@x 4) @result{} (1 2 3 4) +`(1 (unquote-splicing (map 1+ x))) @result{} (1 3 4) +`#(9 ,@@x 9) @result{} #(9 2 3 9) +@end example + +Notice @code{,@@} differs from plain @code{,} in the way one level of +nesting is stripped. For @code{,@@} the elements of a returned list +are inserted, whereas with @code{,} it would be the list itself +inserted. +@end deffn +@c +@c FIXME: What can we say about the mutability of a quasiquote +@c result? R5RS doesn't seem to specify anything, though where it +@c says backquote without commas is the same as plain quote then +@c presumably the "fixed" portions of a quasiquote expression must be +@c treated as immutable. +@c +@end deffn + @node Comments @subsection Comments From 6afe385d12bb0f3fb980d647aa8d8b2bbc5fa272 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:42:32 +0000 Subject: [PATCH 126/167] (SRFI-9): Revise for detail and clarity. Don't use ":foo" for example type name, since that depends on the keyword reading option. --- doc/ref/srfi-modules.texi | 103 +++++++++++++++++++++++--------------- 1 file changed, 64 insertions(+), 39 deletions(-) diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 6a679f044..aa96ed08f 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -1154,54 +1154,79 @@ procedures easier. It is documented in @xref{Multiple Values}. @node SRFI-9 @section SRFI-9 - define-record-type @cindex SRFI-9 -@findex define-record-type -This is the SRFI way for defining record types. The Guile -implementation is a layer above Guile's normal record construction -procedures (@pxref{Records}). The nice thing about this kind of record -definition method is that no new names are implicitly created, all -constructor, accessor and predicates are explicitly given. This reduces -the risk of variable capture. - -The syntax of a record type definition is: +This SRFI is a syntax for defining new record types and creating +predicate, constructor, and field getter and setter functions. In +Guile this is simply an alternate interface to the core record +functionality (@pxref{Records}). It can be used with, @example -@group - - -> (define-record-type - ( ...) - - ...) - -> ( ) - -> ( ) - -> -<... name> -> -@end group +(use-modules (srfi srfi-9)) @end example -Usage example: +@deffn {library syntax} define-record-type type @* (constructor fieldname @dots{}) @* predicate @* (fieldname accessor [modifier]) @dots{} +@sp 1 +Create a new record type, and make various @code{define}s for using +it. This syntax can only occur at the top-level, not nested within +some other form. + +@var{type} is bound to the record type, which is as per the return +from the core @code{make-record-type}. @var{type} also provides the +name for the record, as per @code{record-type-name}. + +@var{constructor} is bound to a function to be called as +@code{(@var{constructor} fieldval @dots{})} to create a new record of +this type. The arguments are initial values for the fields, one +argument for each field, in the order they appear in the +@code{define-record-type} form. + +The @var{fieldname}s provide the names for the record fields, as per +the core @code{record-type-fields} etc, and are referred to in the +subsequent accessor/modifier forms. + +@var{predictate} is bound to a function to be called as +@code{(@var{predicate} obj)}. It returns @code{#t} or @code{#f} +according to whether @var{obj} is a record of this type. + +Each @var{accessor} is bound to a function to be called +@code{(@var{accessor} record)} to retrieve the respective field from a +@var{record}. Similarly each @var{modifier} is bound to a function to +be called @code{(@var{modifier} record val)} to set the respective +field in a @var{record}. +@end deffn + +@noindent +An example will illustrate typical usage, @example -guile> (use-modules (srfi srfi-9)) -guile> (define-record-type :foo (make-foo x) foo? - (x get-x) (y get-y set-y!)) -guile> (define f (make-foo 1)) -guile> f -#<:foo x: 1 y: #f> -guile> (get-x f) -1 -guile> (set-y! f 2) -2 -guile> (get-y f) -2 -guile> f -#<:foo x: 1 y: 2> -guile> (foo? f) -#t -guile> (foo? 1) -#f +(define-record-type employee-type + (make-employee name age salary) + employee? + (name get-employee-name) + (age get-employee-age set-employee-age) + (salary get-employee-salary set-employee-salary)) @end example +This creates a new employee data type, with name, age and salary +fields. Accessor functions are created for each field, but no +modifier function for the name (the intention in this example being +that it's established only when an employee object is created). These +can all then be used as for example, + +@example +employee-type @result{} # + +(define fred (make-employee "Fred" 45 20000.00)) + +(employee? fred) @result{} #t +(get-employee-age fred) @result{} 45 +(set-employee-salary fred 25000.00) ;; pay rise +@end example + +The functions created by @code{define-record-type} are ordinary +top-level @code{define}s. They can be redefined or @code{set!} as +desired, exported from a module, etc. + @node SRFI-10 @section SRFI-10 - Hash-Comma Reader Extension From 573bc47306310eccdb8016c498920ae612ee5a34 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 18 Feb 2004 00:43:09 +0000 Subject: [PATCH 127/167] *** empty log message *** --- doc/ref/ChangeLog | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 007da3727..bdc80415a 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,12 @@ +2004-02-18 Kevin Ryde + + * scheme-evaluation.texi (Expression Syntax): Fill section with + function calling etc, and quote and quasiquote. + + * srfi-modules.texi (SRFI-9): Revise for detail and clarity. Don't + use ":foo" for example type name, since that depends on the keyword + reading option. + 2004-02-15 Mikael Djurfeldt * scheme-compound.texi (Hash Table Reference): Wrote a new entry From 6140be99ba2b7c5c64327c747df987078c4542c2 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 19:29:16 +0000 Subject: [PATCH 128/167] Added copyright notice of Michael Stoll, who probably wrote the original CLISP code. --- test-suite/tests/fractions.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test-suite/tests/fractions.test b/test-suite/tests/fractions.test index d025fedee..ae900a256 100644 --- a/test-suite/tests/fractions.test +++ b/test-suite/tests/fractions.test @@ -13,7 +13,7 @@ ;;;; along with this program; if not, write to the Free Software Foundation, ;;;; Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. -;;; Based in part on code from GNU CLISP +;;;; Based in part on code from GNU CLISP, Copyright (C) 1993 Michael Stoll (define-module (test-suite test-fractions) #:use-module (test-suite lib) From 8cad6491e6c50acab83d6ffd4d868ff251ae73d0 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 19:29:40 +0000 Subject: [PATCH 129/167] *** empty log message *** --- test-suite/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 940ab9556..4f1ccbec7 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2004-02-18 Marius Vollmer + + * tests/fractions.test: Added copyright notice of Michael Stoll, + who probably wrote the original CLISP code. + 2004-02-18 Kevin Ryde * tests/fractions.test: Remove 1/3 == 1.0/3.0, not true. From b6f9dbaeeedf00f7440d6a9e57587bda223299f9 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 20:01:57 +0000 Subject: [PATCH 130/167] (Expression Syntax): Use an empty name for the function call syntax definition. Otherwise, TeX complains about unbalanced parenthesis. --- doc/ref/scheme-evaluation.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ref/scheme-evaluation.texi b/doc/ref/scheme-evaluation.texi index 38338e9f2..3d9664a44 100644 --- a/doc/ref/scheme-evaluation.texi +++ b/doc/ref/scheme-evaluation.texi @@ -40,7 +40,7 @@ loading and evaluating Scheme code at run time. An expression to be evaluated takes one of the following forms. -@deffn syntax +@deffn syntax {} A symbol is evaluated by dereferencing. A binding of that symbol is sought and the value there used. For example, @@ -50,7 +50,7 @@ x @result{} 123 @end example @end deffn -@deffn syntax (proc [args @dots{}]) +@deffn {syntax} {} (proc [args @dots{}]) A parenthesised expression is a function call. @var{proc} and each argument are evaluated, then the function (which @var{proc} evaluated to) is called with those arguments. From 391b4ae044e4091c61c40995862f3d0725e486f0 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 20:07:19 +0000 Subject: [PATCH 131/167] * guile.texi: Replaced list of authors with "The Guile Developers". * preface.texi (Contributors to the Manual): New section. --- doc/ref/guile.texi | 58 ++++---------------------------------------- doc/ref/preface.texi | 39 +++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+), 53 deletions(-) diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index c2e250d99..35e3a22bb 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -131,59 +131,10 @@ x @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.28 2004-02-12 00:21:26 kryde Exp $ +@subtitle $Id: guile.texi,v 1.29 2004-02-18 20:07:19 mvo Exp $ -@c AUTHORS - -@c The Guile reference and tutorial manuals were written and edited -@c largely by Mark Galassi and Jim Blandy. In particular, Jim wrote the -@c original tutorial on Guile's data representation and the C API for -@c accessing Guile objects. - -@c Significant portions were contributed by Gary Houston (contributions -@c to POSIX system calls and networking, expect, I/O internals and -@c extensions, slib installation, error handling) and Tim Pierce -@c (sections on script interpreter triggers, alists, function tracing). - -@c Tom Lord contributed a great deal of material with early Guile -@c snapshots; although most of this text has been rewritten, all of it -@c was important, and some of the structure remains. - -@c Aubrey Jaffer wrote the SCM Scheme implementation and manual upon -@c which the Guile program and manual are based. Some portions of the -@c SCM and SLIB manuals have been included here verbatim. - -@c Since Guile 1.4, Neil Jerram has been maintaining and improving the -@c reference manual. Among other contributions, he wrote the Basic -@c Ideas chapter, developed the tools for keeping the manual in sync -@c with snarfed libguile docstrings, and reorganized the structure so as -@c to accommodate docstrings for all Guile's primitives. - -@c Martin Grabmueller has made substantial contributions throughout the -@c reference manual in preparation for the Guile 1.6 release, including -@c filling out a lot of the documentation of Scheme data types, control -@c mechanisms and procedures. In addition, he wrote the documentation -@c for Guile's SRFI modules and modules associated with the Guile REPL. - -@author Mark Galassi -@author Cygnus Solution and Los Alamos National Laboratory -@author @email{rosalia@@cygnus.com} -@author -@author Jim Blandy -@author Free Software Foundation and MIT AI Lab -@author @email{jimb@@red-bean.com} -@author -@author Gary Houston -@author @email{ghouston@@arglist.com} -@author -@author Tim Pierce -@author @email{twp@@skepsis.com} -@author -@author Neil Jerram -@author @email{neil@@ossau.uklinux.net} -@author -@author Martin Grabmueller -@author @email{mgrabmue@@cs.tu-berlin.de} +@c See preface.texi for the list of authors +@author The Guile Developers @c The following two commands start the copyright page. @page @@ -200,7 +151,7 @@ x @set example-dir doc/examples @ifnottex -@node Top, Guile License, (dir), (dir) +@node Top, Contributors, (dir), (dir) @top The Guile Reference Manual @insertcopying @@ -210,6 +161,7 @@ x @menu Preface +* Contributors:: Contributors to this manual. * Guile License:: Conditions for copying and using Guile. * Manual Layout:: How to read the rest of this manual. * Manual Conventions:: Conventional terminology. diff --git a/doc/ref/preface.texi b/doc/ref/preface.texi index 9841e3673..eb7764646 100644 --- a/doc/ref/preface.texi +++ b/doc/ref/preface.texi @@ -17,6 +17,45 @@ corresponds to Guile version @value{VERSION}. @end iftex +@iftex +@section Contributors to this Manual +@end iftex + +@ifnottex +@node Contributors +@chapter Contributors to this Manual +@end ifnottex + +The Guile reference and tutorial manuals were written and edited +largely by Mark Galassi and Jim Blandy. In particular, Jim wrote the +original tutorial on Guile's data representation and the C API for +accessing Guile objects. + +Significant portions were contributed by Gary Houston (contributions +to POSIX system calls and networking, expect, I/O internals and +extensions, slib installation, error handling) and Tim Pierce +(sections on script interpreter triggers, alists, function tracing). + +Tom Lord contributed a great deal of material with early Guile +snapshots; although most of this text has been rewritten, all of it +was important, and some of the structure remains. + +Aubrey Jaffer wrote the SCM Scheme implementation and manual upon +which the Guile program and manual are based. Some portions of the +SCM and SLIB manuals have been included here verbatim. + +Since Guile 1.4, Neil Jerram has been maintaining and improving the +reference manual. Among other contributions, he wrote the Basic +Ideas chapter, developed the tools for keeping the manual in sync +with snarfed libguile docstrings, and reorganized the structure so as +to accommodate docstrings for all Guile's primitives. + +Martin Grabmueller has made substantial contributions throughout the +reference manual in preparation for the Guile 1.6 release, including +filling out a lot of the documentation of Scheme data types, control +mechanisms and procedures. In addition, he wrote the documentation +for Guile's SRFI modules and modules associated with the Guile REPL. + @iftex @section The Guile License @end iftex From ab32bd34156e5768454405e673940ead001118b7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 20:08:48 +0000 Subject: [PATCH 132/167] *** empty log message *** --- doc/ref/ChangeLog | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index bdc80415a..922a8d1bd 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,14 @@ +2004-02-18 Marius Vollmer + + * guile.texi: Replaced list of authors with "The Guile + Developers". + + * preface.texi (Contributors to the Manual): New section. + + * scheme-evaluation.texi (Expression Syntax): Use an empty name + for the function call syntax definition. Otherwise, TeX complains + about unbalanced parenthesis. + 2004-02-18 Kevin Ryde * scheme-evaluation.texi (Expression Syntax): Fill section with From 0d558fbb953efee75ab492211ed3ff405619ed04 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 21:14:35 +0000 Subject: [PATCH 133/167] * gc.h (scm_gc_cells_collected): Removed duplicated declaration. Thanks to Bill Schottstaedt! * socket.h (scm_gethost): Removed prototype it is already in "net_db.h". Thanks to Bill Schottstaedt! --- libguile/gc.h | 3 +-- libguile/socket.h | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/libguile/gc.h b/libguile/gc.h index 3f1556575..aab4bb648 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -3,7 +3,7 @@ #ifndef SCM_GC_H #define SCM_GC_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004 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 @@ -269,7 +269,6 @@ 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_malloc_collected; SCM_API unsigned long scm_gc_ports_collected; SCM_API unsigned long scm_cells_allocated; diff --git a/libguile/socket.h b/libguile/socket.h index 13f4eca89..bd661f77b 100644 --- a/libguile/socket.h +++ b/libguile/socket.h @@ -3,7 +3,7 @@ #ifndef SCM_SOCKET_H #define SCM_SOCKET_H -/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000,2001, 2004 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 @@ -30,7 +30,6 @@ SCM_API SCM scm_htons (SCM in); SCM_API SCM scm_ntohs (SCM in); SCM_API SCM scm_htonl (SCM in); SCM_API SCM scm_ntohl (SCM in); -SCM_API SCM scm_gethost (SCM name); SCM_API SCM scm_inet_aton (SCM address); SCM_API SCM scm_inet_ntoa (SCM inetid); SCM_API SCM scm_inet_netof (SCM address); From 4e28ba5efd4d6735dc04176d97590fee021ec64c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 21:16:01 +0000 Subject: [PATCH 134/167] *** empty log message *** --- libguile/ChangeLog | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f329c6b5b..8d2516ca2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,11 @@ +2004-02-18 Marius Vollmer + + * gc.h (scm_gc_cells_collected): Removed duplicated declaration. + Thanks to Bill Schottstaedt! + + * socket.h (scm_gethost): Removed prototype it is already in + "net_db.h". Thanks to Bill Schottstaedt! + 2004-02-18 Kevin Ryde * num2integral.i.c (INTEGRAL2BIG): WORDS_BIGENDIAN not right for word From fa2803b92bd18717d4c8ae3b77cc11c4b68bc5a4 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 22:29:45 +0000 Subject: [PATCH 135/167] (top-repl): Make the (guile-user) module use the (ice-9 r5rs) module. --- ice-9/boot-9.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index cc2104667..092d1f4d8 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -3277,6 +3277,7 @@ (module-use! guile-user-module (resolve-interface '(ice-9 session))) (module-use! guile-user-module (resolve-interface '(ice-9 debug))) ;; so that builtin bindings will be checked first + (module-use! guile-user-module (resolve-interface '(ice-9 r5rs))) (module-use! guile-user-module (resolve-interface '(guile))) (set-current-module guile-user-module) From 9b792a7ec00f34050b6a4724686cf4f1d7beff28 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 18 Feb 2004 22:32:08 +0000 Subject: [PATCH 136/167] *** empty log message *** --- ice-9/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 2af0e0281..e4be5ecf6 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2004-02-18 Marius Vollmer + + * boot-9.scm (top-repl): Make the (guile-user) module use the + (ice-9 r5rs) module. + 2004-02-12 Mikael Djurfeldt * boot-9.scm (module-map): Renamed hash-map -> hash-map->list. From a8551448a35b5aced07340f9ee5ac6a1cfab0e86 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 20 Feb 2004 17:14:41 +0000 Subject: [PATCH 137/167] (Expression Syntax): Turned syntax description into a table, @deffn is not really up to the task. --- doc/ref/scheme-evaluation.texi | 37 +++++++++++++++++----------------- 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/doc/ref/scheme-evaluation.texi b/doc/ref/scheme-evaluation.texi index 3d9664a44..1ca0b2c7c 100644 --- a/doc/ref/scheme-evaluation.texi +++ b/doc/ref/scheme-evaluation.texi @@ -40,7 +40,9 @@ loading and evaluating Scheme code at run time. An expression to be evaluated takes one of the following forms. -@deffn syntax {} +@table @nicode + +@item @var{symbol} A symbol is evaluated by dereferencing. A binding of that symbol is sought and the value there used. For example, @@ -48,9 +50,8 @@ sought and the value there used. For example, (define x 123) x @result{} 123 @end example -@end deffn -@deffn {syntax} {} (proc [args @dots{}]) +@item (@var{proc} @var{args}@dots{}) A parenthesised expression is a function call. @var{proc} and each argument are evaluated, then the function (which @var{proc} evaluated to) is called with those arguments. @@ -69,9 +70,8 @@ The same sort of parenthesised form is used for a macro invocation, but in that case the arguments are not evaluated. See the descriptions of macros for more on this (@pxref{Macros}, and @pxref{Syntax Rules}). -@end deffn -@deffn syntax +@item @var{constant} Number, string, character and boolean constants evaluate ``to themselves'', so can appear as literals. @@ -85,10 +85,9 @@ themselves'', so can appear as literals. Note that an application must not attempt to modify literal strings, since they may be in read-only memory. -@end deffn -@deffn syntax quote data -@deffnx syntax ' data +@item (quote @var{data}) +@itemx '@var{data} Quoting is used to obtain a literal symbol (instead of a variable reference), a literal list (instead of a function call), or a literal vector. @nicode{'} is simply a shorthand for a @code{quote} form. @@ -106,10 +105,9 @@ For example, Note that an application must not attempt to modify literal lists or vectors obtained from a @code{quote} form, since they may be in read-only memory. -@end deffn -@deffn syntax quasiquote data -@deffnx syntax ` data +@item (quasiquote @var{data}) +@itemx `@var{data} Backquote quasi-quotation is like @code{quote}, but selected sub-expressions are evaluated. This is a convenient way to construct a list or vector structure most of which is constant, but at certain @@ -118,8 +116,10 @@ points should have expressions substituted. The same effect can always be had with suitable @code{list}, @code{cons} or @code{vector} calls, but quasi-quoting is often easier. -@deffn syntax unquote expr -@deffnx syntax , expr +@table @nicode + +@item (unquote @var{expr}) +@itemx ,@var{expr} Within the quasiquote @var{data}, @code{unquote} or @code{,} indicates an expression to be evaluated and inserted. The comma syntax @code{,} is simply a shorthand for an @code{unquote} form. For example, @@ -129,10 +129,9 @@ is simply a shorthand for an @code{unquote} form. For example, `(1 (unquote (+ 1 1)) 3) @result{} (1 2 3) `#(1 ,(/ 12 2)) @result{} #(1 6) @end example -@end deffn -@deffn syntax unquote-splicing expr -@deffnx syntax ,@ expr +@item (unquote-splicing @var{expr}) +@itemx ,@@@var{expr} Within the quasiquote @var{data}, @code{unquote-splicing} or @code{,@@} indicates an expression to be evaluated and the elements of the returned list inserted. @var{expr} must evaluate to a list. The @@ -150,7 +149,8 @@ Notice @code{,@@} differs from plain @code{,} in the way one level of nesting is stripped. For @code{,@@} the elements of a returned list are inserted, whereas with @code{,} it would be the list itself inserted. -@end deffn +@end table + @c @c FIXME: What can we say about the mutability of a quasiquote @c result? R5RS doesn't seem to specify anything, though where it @@ -158,7 +158,8 @@ inserted. @c presumably the "fixed" portions of a quasiquote expression must be @c treated as immutable. @c -@end deffn + +@end table @node Comments From 83078c1ebdfd085e93dccd86d3d0dd2b074c2275 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Fri, 20 Feb 2004 17:15:06 +0000 Subject: [PATCH 138/167] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 922a8d1bd..ed961e22a 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2004-02-20 Marius Vollmer + + * scheme-evaluation.texi (Expression Syntax): Turned syntax + description into a table, @deffn is not really up to the task. + 2004-02-18 Marius Vollmer * guile.texi: Replaced list of authors with "The Guile From eb741d98e2f898974923cb0c1b3c8b1913878cd2 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 20 Feb 2004 21:15:56 +0000 Subject: [PATCH 139/167] (scm_list_n): check validate non-immediate arguments; this will catch forgotten a SCM_UNDEFINED. --- libguile/ChangeLog | 5 +++++ libguile/list.c | 3 +++ 2 files changed, 8 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 8d2516ca2..e7d61a612 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2004-02-20 Han-Wen Nienhuys + + * list.c (scm_list_n): validate non-immediate arguments; + this will catch forgotten a SCM_UNDEFINED. + 2004-02-18 Marius Vollmer * gc.h (scm_gc_cells_collected): Removed duplicated declaration. diff --git a/libguile/list.c b/libguile/list.c index 74bb2cc3e..e36797f4a 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -90,6 +90,9 @@ scm_list_n (SCM elt, ...) var_start (foo, elt); while (! SCM_UNBNDP (elt)) { + if (SCM_NIMP (elt)) + SCM_VALIDATE_CELL(elt, 0); + *pos = scm_cons (elt, SCM_EOL); pos = SCM_CDRLOC (*pos); elt = va_arg (foo, SCM); From 1e55d28813c6dba90ea05ba3e7703eea191be691 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 20 Feb 2004 22:04:24 +0000 Subject: [PATCH 140/167] * list.c (scm_list_n): Add #if SCM_DEBUG_CELL_ACCESSES_P around validation. * read.c (scm_lreadparen): Removed. (scm_lreadparen1): Renamed scm_i_lreadparen. --- libguile/ChangeLog | 8 ++++++++ libguile/list.c | 3 ++- libguile/read.c | 18 ++++++------------ libguile/read.h | 1 - 4 files changed, 16 insertions(+), 14 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index e7d61a612..68fbd2aa3 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,11 @@ +2004-02-20 Neil Jerram + + * list.c (scm_list_n): Add #if SCM_DEBUG_CELL_ACCESSES_P around + validation. + + * read.c (scm_lreadparen): Removed. + (scm_lreadparen1): Renamed scm_i_lreadparen. + 2004-02-20 Han-Wen Nienhuys * list.c (scm_list_n): validate non-immediate arguments; diff --git a/libguile/list.c b/libguile/list.c index e36797f4a..0088bb39f 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -90,9 +90,10 @@ scm_list_n (SCM elt, ...) var_start (foo, elt); while (! SCM_UNBNDP (elt)) { +#if (SCM_DEBUG_CELL_ACCESSES == 1) if (SCM_NIMP (elt)) SCM_VALIDATE_CELL(elt, 0); - +#endif *pos = scm_cons (elt, SCM_EOL); pos = SCM_CDRLOC (*pos); elt = va_arg (foo, SCM); diff --git a/libguile/read.c b/libguile/read.c index 10e8d8264..8a90b33ec 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -298,7 +298,7 @@ skip_scsh_block_comment (SCM port) static SCM scm_get_hash_procedure(int c); -static SCM scm_lreadparen1 (SCM *, SCM, char *, SCM *, char); +static SCM scm_i_lreadparen (SCM *, SCM, char *, SCM *, char); static char s_list[]="list"; static char s_vector[]="vector"; @@ -322,7 +322,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) case '(': return SCM_RECORD_POSITIONS_P ? scm_lreadrecparen (tok_buf, port, s_list, copy) - : scm_lreadparen1 (tok_buf, port, s_list, copy, ')'); + : scm_i_lreadparen (tok_buf, port, s_list, copy, ')'); case ')': scm_input_error (FUNC_NAME, port,"unexpected \")\"", SCM_EOL); goto tryagain; @@ -331,7 +331,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) case '[': if (SCM_ELISP_VECTORS_P) { - p = scm_lreadparen1 (tok_buf, port, s_vector, copy, ']'); + p = scm_i_lreadparen (tok_buf, port, s_vector, copy, ']'); return SCM_NULLP (p) ? scm_nullvect : scm_vector (p); } goto read_token; @@ -395,7 +395,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) switch (c) { case '(': - p = scm_lreadparen1 (tok_buf, port, s_vector, copy, ')'); + p = scm_i_lreadparen (tok_buf, port, s_vector, copy, ')'); return SCM_NULLP (p) ? scm_nullvect : scm_vector (p); case 't': @@ -723,15 +723,9 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) _Pragma ("opt"); /* # pragma _CRI opt */ #endif -SCM -scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy) -{ - return scm_lreadparen1 (tok_buf, port, name, copy, ')'); -} - static SCM -scm_lreadparen1 (SCM *tok_buf, SCM port, char *name, SCM *copy, char term_char) -#define FUNC_NAME "scm_lreadparen" +scm_i_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy, char term_char) +#define FUNC_NAME "scm_i_lreadparen" { SCM tmp; SCM tl; diff --git a/libguile/read.h b/libguile/read.h index 2f7251492..70f6521eb 100644 --- a/libguile/read.h +++ b/libguile/read.h @@ -70,7 +70,6 @@ SCM_API int scm_flush_ws (SCM port, const char *eoferr); SCM_API int scm_casei_streq (char * s1, char * s2); SCM_API SCM scm_lreadr (SCM * tok_buf, SCM port, SCM *copy); SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird); -SCM_API SCM scm_lreadparen (SCM * tok_buf, SCM port, char *name, SCM *copy); SCM_API SCM scm_lreadrecparen (SCM * tok_buf, SCM port, char *name, SCM *copy); SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc); SCM_API void scm_init_read (void); From 548b104750e6c1b01e0d1421355565e5a4903af5 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 20 Feb 2004 23:04:04 +0000 Subject: [PATCH 141/167] (Expression Syntax): Add findex entries for quote and quasiquote no longer using @deffn. --- doc/ref/scheme-evaluation.texi | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/ref/scheme-evaluation.texi b/doc/ref/scheme-evaluation.texi index 1ca0b2c7c..5c453397b 100644 --- a/doc/ref/scheme-evaluation.texi +++ b/doc/ref/scheme-evaluation.texi @@ -88,6 +88,8 @@ since they may be in read-only memory. @item (quote @var{data}) @itemx '@var{data} +@findex quote +@findex ' Quoting is used to obtain a literal symbol (instead of a variable reference), a literal list (instead of a function call), or a literal vector. @nicode{'} is simply a shorthand for a @code{quote} form. @@ -108,6 +110,8 @@ read-only memory. @item (quasiquote @var{data}) @itemx `@var{data} +@findex quasiquote +@findex ` Backquote quasi-quotation is like @code{quote}, but selected sub-expressions are evaluated. This is a convenient way to construct a list or vector structure most of which is constant, but at certain @@ -120,6 +124,8 @@ The same effect can always be had with suitable @code{list}, @item (unquote @var{expr}) @itemx ,@var{expr} +@findex unquote +@findex , Within the quasiquote @var{data}, @code{unquote} or @code{,} indicates an expression to be evaluated and inserted. The comma syntax @code{,} is simply a shorthand for an @code{unquote} form. For example, @@ -132,6 +138,8 @@ is simply a shorthand for an @code{unquote} form. For example, @item (unquote-splicing @var{expr}) @itemx ,@@@var{expr} +@findex unquote-splicing +@findex ,@@ Within the quasiquote @var{data}, @code{unquote-splicing} or @code{,@@} indicates an expression to be evaluated and the elements of the returned list inserted. @var{expr} must evaluate to a list. The From 2c1433817c73b4ea66019d8b43b8bb1db5ab6add Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 20 Feb 2004 23:05:51 +0000 Subject: [PATCH 142/167] *** empty log message *** --- doc/ref/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index ed961e22a..a11b8e171 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2004-02-21 Kevin Ryde + + * scheme-evaluation.texi (Expression Syntax): Add findex entries for + quote and quasiquote no longer using @deffn. + 2004-02-20 Marius Vollmer * scheme-evaluation.texi (Expression Syntax): Turned syntax From 63271ac5a2761ed3d0e1ce7f3732fd48ba83312a Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 20 Feb 2004 23:16:57 +0000 Subject: [PATCH 143/167] (crypt): Test with AC_SEARCH_LIBS, for the benefit of HP-UX. Define HAVE_CRYPT rather than HAVE_LIBCRYPT. Reported by Andreas Voegele. --- configure.in | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/configure.in b/configure.in index 40584387c..54e24ec38 100644 --- a/configure.in +++ b/configure.in @@ -594,7 +594,23 @@ AC_CHECK_FUNCS([ctermid ftime fchown getcwd geteuid gettimeofday lstat mkdir mkn AC_CHECK_HEADERS(crypt.h sys/resource.h sys/file.h) AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname) -AC_CHECK_LIB(crypt, crypt) + +# crypt() may or may not be available, for instance in some countries there +# are restrictions on cryptography. +# +# crypt() might be in libc (eg. OpenBSD), or it might be in a separate +# -lcrypt library (eg. Debian GNU/Linux). +# +# On HP-UX 11, crypt() is in libc and there's a dummy libcrypt.a. We must +# be careful to avoid -lcrypt in this case, since libtool will see there's +# only a static libcrypt and decide to build only a static libguile. +# +# AC_SEARCH_LIBS lets us add -lcrypt to LIBS only if crypt() is not in the +# libraries already in that list. +# +AC_SEARCH_LIBS(crypt, crypt, + [AC_DEFINE(HAVE_CRYPT,1, + [Define to 1 if you have the `crypt' function.])]) dnl GMP tests AC_CHECK_LIB([gmp], [__gmpz_init], , From b9a7b725a87d6a06eaf177e4b2abe0bcb94108e2 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 20 Feb 2004 23:18:10 +0000 Subject: [PATCH 144/167] (scm_crypt): Use new HAVE_CRYPT. (): Remove HAVE_LIBCRYPT condition. --- libguile/posix.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libguile/posix.c b/libguile/posix.c index 38835bcca..b49bce1e1 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -110,7 +110,7 @@ extern char ** environ; #include #endif -#if HAVE_LIBCRYPT && HAVE_CRYPT_H +#if HAVE_CRYPT_H # include #endif @@ -1420,7 +1420,7 @@ SCM_DEFINE (scm_sync, "sync", 0, 0, 0, #undef FUNC_NAME #endif /* HAVE_SYNC */ -#if HAVE_LIBCRYPT && HAVE_CRYPT_H +#if HAVE_CRYPT SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0, (SCM key, SCM salt), "Encrypt @var{key} using @var{salt} as the salt value to the\n" @@ -1436,7 +1436,7 @@ SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0, return scm_makfrom0str (p); } #undef FUNC_NAME -#endif /* HAVE_LIBCRYPT && HAVE_CRYPT_H */ +#endif /* HAVE_CRYPT */ #if HAVE_CHROOT SCM_DEFINE (scm_chroot, "chroot", 1, 0, 0, From e60923476f932cf1a124f0813335c20ea13e39aa Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 20 Feb 2004 23:19:03 +0000 Subject: [PATCH 145/167] Add a copyright year. --- libguile/posix.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/posix.c b/libguile/posix.c index b49bce1e1..4d61d0cf5 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004 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 From d675a50f53354a7586d199144cb3ec6fb6b477b0 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 20 Feb 2004 23:20:15 +0000 Subject: [PATCH 146/167] Add copyright year 2002, which appears in the ChangeLog. --- libguile/posix.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/posix.c b/libguile/posix.c index 4d61d0cf5..14c80f3eb 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 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 From b114eafe802de9189f627e41d9b6a5294dc84311 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 20 Feb 2004 23:24:27 +0000 Subject: [PATCH 147/167] *** empty log message *** --- ChangeLog | 6 ++++++ libguile/ChangeLog | 5 +++++ 2 files changed, 11 insertions(+) diff --git a/ChangeLog b/ChangeLog index 1335aac1a..ab3f92c91 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2004-02-21 Kevin Ryde + + * configure.in (crypt): Test with AC_SEARCH_LIBS, for the benefit of + HP-UX. Define HAVE_CRYPT rather than HAVE_LIBCRYPT. Reported by + Andreas Voegele. + 2004-02-18 Kevin Ryde * configure.in (AC_CHECK_HEADERS): Add crt_externs.h. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 68fbd2aa3..33808287c 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2004-02-21 Kevin Ryde + + * posix.c (scm_crypt): Use new HAVE_CRYPT. + (): Remove HAVE_LIBCRYPT condition. + 2004-02-20 Neil Jerram * list.c (scm_list_n): Add #if SCM_DEBUG_CELL_ACCESSES_P around From 2c0334eccd91e1c4f593135b9e75e0e5c7dd4277 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 21 Feb 2004 00:10:47 +0000 Subject: [PATCH 148/167] (NUM2FLOAT): Expand isfinite to !xisinf, as per previous change to numbers.c. --- libguile/num2float.i.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/num2float.i.c b/libguile/num2float.i.c index 5ef3a30cf..bfcf4bd10 100644 --- a/libguile/num2float.i.c +++ b/libguile/num2float.i.c @@ -8,7 +8,7 @@ NUM2FLOAT (SCM num, unsigned long int pos, const char *s_caller) else if (SCM_BIGP (num)) { /* bignum */ FTYPE res = mpz_get_d (SCM_I_BIG_MPZ (num)); - if (isfinite (res)) + if (! xisinf (res)) return res; else scm_out_of_range (s_caller, num); From 580987cf4b237da12dced75958b362ecdb19d0ce Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sat, 21 Feb 2004 14:53:07 +0000 Subject: [PATCH 149/167] * gds.el: Add requirements: cl, comint, info. (gds-guile-program): New. (gds-start): When starting or restarting, kill captive if it exists. Use gds-guile-program instead of just "guile". (gds-mode): Use widget minor mode. (gds-client-ref): New optional client arg. (gds-update-buffers): Don't call widget-setup. (gds-heading-face): New. (gds-insert-interaction): Various prettifications. (gds-heading-insert): New. (gds-choose-client): Check that numbers in client and gds-client are still valid. (gds-eval-expression, gds-apropos): Remove text properties from expression to evaluate. (gds-mode-map): Don't set widget-mode-map as parent. (gds-start-captive): Use gds-guile-program instead of just "guile". * gds-client.scm (install-breakpoints): Bugfix: avoid null lists in traversal. (eval-thread, gds-eval): Where expression has multiple parts, modify output to say which part is being evaluated. --- emacs/ChangeLog | 25 +++++++++++++ emacs/gds-client.scm | 24 +++++++++---- emacs/gds.el | 86 +++++++++++++++++++++++++++++++------------- 3 files changed, 104 insertions(+), 31 deletions(-) diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 3ddf384d1..b649bd434 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,28 @@ +2004-02-21 Neil Jerram + + * gds.el: Add requirements: cl, comint, info. + (gds-guile-program): New. + (gds-start): When starting or restarting, kill captive if it + exists. Use gds-guile-program instead of just "guile". + (gds-mode): Use widget minor mode. + (gds-client-ref): New optional client arg. + (gds-update-buffers): Don't call widget-setup. + (gds-heading-face): New. + (gds-insert-interaction): Various prettifications. + (gds-heading-insert): New. + (gds-choose-client): Check that numbers in client and gds-client + are still valid. + (gds-eval-expression, gds-apropos): Remove text properties from + expression to evaluate. + (gds-mode-map): Don't set widget-mode-map as parent. + (gds-start-captive): Use gds-guile-program instead of just + "guile". + + * gds-client.scm (install-breakpoints): Bugfix: avoid null lists + in traversal. + (eval-thread, gds-eval): Where expression has multiple parts, + modify output to say which part is being evaluated. + 2004-02-08 Mikael Djurfeldt * Makefile.am (TAGS_FILES): Use this variable instead of diff --git a/emacs/gds-client.scm b/emacs/gds-client.scm index ba4d58737..12ab234f8 100644 --- a/emacs/gds-client.scm +++ b/emacs/gds-client.scm @@ -523,7 +523,7 @@ decimal IP address where the UI server is running; default is (define (install-breakpoints x bpinfo) (define (install-recursive x) - (if (list? x) + (if (and (list? x) (not (null? x))) (begin ;; Check source properties of x itself. (let* ((infokey (cons (source-property x 'line) @@ -619,12 +619,17 @@ decimal IP address where the UI server is running; default is ;; Do the evaluation(s). (let loop2 ((m (cadr work)) (exprs (cddr work)) - (results '())) + (results '()) + (n 1)) (if (null? exprs) (write-form `(eval-results ,correlator ,@results)) (loop2 m (cdr exprs) - (append results (gds-eval (car exprs) m)))))) + (append results (gds-eval (car exprs) m + (if (and (null? (cdr exprs)) + (= n 1)) + #f n))) + (+ n 1))))) (trc 'eval-thread depth thread-number "work done") ;; Tell the subthread that it should now exit. (set! subthread-needed? #f) @@ -643,7 +648,7 @@ decimal IP address where the UI server is running; default is ;; Tell the front end this thread is ready. (write-form `(thread-status eval ,thread-number exiting))))) -(define (gds-eval x m) +(define (gds-eval x m part) ;; Consumer to accept possibly multiple values and present them for ;; Emacs as a list of strings. (define (value-consumer . values) @@ -653,10 +658,14 @@ decimal IP address where the UI server is running; default is (with-output-to-string (lambda () (write value)))) values))) ;; Now do evaluation. - (let ((value #f)) + (let ((intro (if part + (format #f ";;; Evaluating subexpression ~A" part) + ";;; Evaluating")) + (value #f)) (let* ((do-eval (if m (lambda () - (display "Evaluating in module ") + (display intro) + (display " in module ") (write (module-name m)) (newline) (set! value @@ -665,7 +674,8 @@ decimal IP address where the UI server is running; default is (eval x m))) value-consumer))) (lambda () - (display "Evaluating in current module ") + (display intro) + (display " in current module ") (write (module-name (current-module))) (newline) (set! value diff --git a/emacs/gds.el b/emacs/gds.el index 2c0d80f58..50d08ec76 100644 --- a/emacs/gds.el +++ b/emacs/gds.el @@ -24,6 +24,9 @@ (require 'widget) (require 'wid-edit) (require 'scheme) +(require 'cl) +(require 'comint) +(require 'info) ;;;; Customization group setup. @@ -43,9 +46,18 @@ ;; the buffer position of the start of the next unread form. (defvar gds-read-cursor nil) +;; The guile executable used by the GDS server and captive client +;; processes. +(defcustom gds-guile-program "guile" + "*The guile executable used by GDS, specifically by its server and +captive client processes." + :type 'string + :group 'gds) + (defun gds-start () "Start (or restart, if already running) the GDS subprocess." (interactive) + (gds-kill-captive) (if gds-process (gds-shutdown)) (with-current-buffer (get-buffer-create "*GDS Process*") (erase-buffer) @@ -53,7 +65,7 @@ (let ((process-connection-type nil)) ; use a pipe (start-process "gds" (current-buffer) - "guile" + gds-guile-program "-q" "--debug" "-c" @@ -364,7 +376,8 @@ The function is called with one argument, the CLIENT in question." (define-derived-mode gds-mode scheme-mode "Guile Interaction" - "Major mode for interacting with a Guile client application.") + "Major mode for interacting with a Guile client application." + (widget-minor-mode 1)) (defvar gds-client nil "GDS client's port number.") @@ -409,9 +422,9 @@ The function is called with one argument, the CLIENT in question." (gds-client-buffer client 'name '("(GDS buffer killed)")))))) ;; Get the current buffer's associated client's value of SYM. -(defun gds-client-ref (sym) - (and gds-client - (let ((buf (assq gds-client gds-buffers))) +(defun gds-client-ref (sym &optional client) + (and (or client gds-client) + (let ((buf (assq (or client gds-client) gds-buffers))) (and buf (cdr buf) (buffer-live-p (cdr buf)) @@ -449,7 +462,6 @@ The function is called with one argument, the CLIENT in question." (t (error "Bad GDS view %S" view))) ;; Finish off. - (widget-setup) (force-mode-line-update t))) (defun gds-update-buffers-in-a-while () @@ -549,12 +561,17 @@ the following symbols. "Last help or evaluation results.") (make-variable-buffer-local 'gds-results) +(defcustom gds-heading-face 'info-menu-header + "*Face used for headings in Guile Interaction buffers." + :type 'face + :group 'gds) + (defun gds-insert-interaction () (erase-buffer) ;; Insert stuff for interacting with a running (non-blocked) Guile ;; client. - (widget-insert (buffer-name) - ", " + (gds-heading-insert (buffer-name)) + (widget-insert " " (cdr (assq gds-status '((running . "running (cannot accept input)") (waiting-for-input . "waiting for input") @@ -562,7 +579,7 @@ the following symbols. (closed . "closed")))) ", in " gds-current-module - "\n") + "\n\n") (widget-create 'push-button :notify (function gds-sigint) "SIGINT") @@ -578,18 +595,28 @@ the following symbols. (widget-create 'editable-field :notify (function gds-set-exception-keys) gds-exception-keys) + ;; Evaluation report area. + (widget-insert "\n") + (gds-heading-insert "Recent Evaluations") + (widget-insert " To run an evaluation, see the Guile->Evaluate menu.\n") + (if gds-results + (widget-insert "\n" (cdr gds-results))) (let ((evals gds-evals-in-progress)) - (if evals - (widget-insert "\nEvaluations in progress:\n")) (while evals + (widget-insert "\n" (cddar evals) " - running ") (let ((w (widget-create 'push-button :notify (function gds-interrupt-eval) "Interrupt"))) - (widget-put w :thread-number (caar evals)) - (widget-insert " " (cddar evals) "\n")) - (setq evals (cdr evals)))) - (if gds-results - (widget-insert "\n" (cdr gds-results)))) + (widget-put w :thread-number (caar evals))) + (widget-insert "\n") + (setq evals (cdr evals))))) + +(defun gds-heading-insert (text) + (let ((start (point))) + (widget-insert text) + (let ((o (make-overlay start (point)))) + (overlay-put o 'face gds-heading-face) + (overlay-put o 'evaporate t)))) (defun gds-sigint (w &rest ignore) (interactive) @@ -1113,6 +1140,14 @@ isn't yet known to Guile." client))) (defun gds-choose-client (client) + ;; Only keep the supplied client number if it is still valid. + (if (integerp client) + (setq client (gds-client-ref 'gds-client client))) + ;; Only keep the current buffer's setting of `gds-client' if it is + ;; still valid. + (if gds-client + (setq gds-client (gds-client-ref 'gds-client))) + (or ;; If client is an integer, it is the port number of the ;; intended client. (if (integerp client) @@ -1196,6 +1231,7 @@ region's code." "Evaluate the supplied EXPR (a string)." (interactive "sEvaluate expression: \nP") (setq client (gds-choose-client client)) + (set-text-properties 0 (length expr) nil expr) (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 () %S" (or correlator 'expression) (gds-abbreviated expr) @@ -1264,6 +1300,7 @@ region's code." "Guile apropos (regexp): "))) (list (if (zerop (length val)) sym val) current-prefix-arg))) + (set-text-properties 0 (length regex) nil regex) (gds-eval-expression (format "(apropos %S)" regex) client 'help)) (defvar gds-completion-results nil) @@ -1386,9 +1423,7 @@ Used for determining the default for the next `gds-load-file'.") (define-key scheme-mode-map "\C-x\e " 'gds-delete-source-breakpoint) -;;;; GDS (Guile Interaction) mode keymap and menu items. - -(set-keymap-parent gds-mode-map widget-keymap) +;;;; Guile Interaction mode keymap and menu items. (define-key gds-mode-map "M" (function gds-query-modules)) @@ -1541,10 +1576,6 @@ Used for determining the default for the next `gds-load-file'.") :type 'boolean :group 'gds) -(if (and gds-autostart-server - (not gds-process)) - (gds-start)) - ;;;; `Captive' Guile - a Guile process that is started when needed to ;;;; provide help, completion, evaluations etc. @@ -1566,7 +1597,7 @@ Used for determining the default for the next `gds-load-file'.") nil (let ((process-connection-type nil)) (setq gds-captive (make-comint "captive-guile" - "guile" + gds-guile-program nil "-q"))) (let ((proc (get-buffer-process gds-captive))) @@ -1585,6 +1616,13 @@ Used for determining the default for the next `gds-load-file'.") (error)))) +;;;; If requested, autostart the server after loading. + +(if (and gds-autostart-server + (not gds-process)) + (gds-start)) + + ;;;; The end! (provide 'gds) From db752bb5cf49cfe21b549e85212b379f74101e3e Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 21 Feb 2004 21:21:29 +0000 Subject: [PATCH 150/167] *** empty log message *** --- libguile/ChangeLog | 1 + 1 file changed, 1 insertion(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 33808287c..8d9b88d47 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -2,6 +2,7 @@ * posix.c (scm_crypt): Use new HAVE_CRYPT. (): Remove HAVE_LIBCRYPT condition. + Reported by Andreas Voegele. 2004-02-20 Neil Jerram From dab4e67a0a71f1f1b871a0ed5908238cd28c19bf Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 21 Feb 2004 21:58:30 +0000 Subject: [PATCH 151/167] (scm_max, scm_min): For one arg, dispatch to generic for complex, same as for two args. (Handle only inum, big, real, frac). --- libguile/numbers.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 62515edae..8c7c87c02 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -3383,7 +3383,7 @@ scm_max (SCM x, SCM y) { if (SCM_UNBNDP (x)) SCM_WTA_DISPATCH_0 (g_max, s_max); - else if (SCM_NUMBERP (x)) + else if (SCM_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) return x; else SCM_WTA_DISPATCH_1 (g_max, x, SCM_ARG1, s_max); @@ -3532,7 +3532,7 @@ scm_min (SCM x, SCM y) { if (SCM_UNBNDP (x)) SCM_WTA_DISPATCH_0 (g_min, s_min); - else if (SCM_NUMBERP (x)) + else if (SCM_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) return x; else SCM_WTA_DISPATCH_1 (g_min, x, SCM_ARG1, s_min); From 2af0602e45d0d675a32db20dbe70e44249b36755 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 21 Feb 2004 21:59:34 +0000 Subject: [PATCH 152/167] *** empty log message *** --- libguile/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 8d9b88d47..ac18bf8fa 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2004-02-22 Kevin Ryde + + * numbers.c (scm_max, scm_min): For one arg, dispatch to generic for + complex, same as for two args. (Handle only inum, big, real, frac). + 2004-02-21 Kevin Ryde * posix.c (scm_crypt): Use new HAVE_CRYPT. From 593a4c2f90b6a4fde881a33667f75e60f0d282b3 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 21 Feb 2004 22:03:57 +0000 Subject: [PATCH 153/167] (max, min): Exercise some complex num cases. --- test-suite/tests/numbers.test | 50 ++++++++++++++++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index d779873d4..329686180 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1,5 +1,5 @@ ;;;; numbers.test --- tests guile's numbers -*- scheme -*- -;;;; Copyright (C) 2000, 2001, 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2003, 2004 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 @@ -1863,6 +1863,30 @@ ;;; (with-test-prefix "max" + (pass-if-exception "no args" exception:wrong-num-args + (max)) + + (pass-if-exception "one complex" exception:wrong-type-arg + (max 1+i)) + + (pass-if-exception "inum/complex" exception:wrong-type-arg + (max 123 1+i)) + (pass-if-exception "big/complex" exception:wrong-type-arg + (max 9999999999999999999999999999999999999999 1+i)) + (pass-if-exception "real/complex" exception:wrong-type-arg + (max 123.0 1+i)) + (pass-if-exception "frac/complex" exception:wrong-type-arg + (max 123/456 1+i)) + + (pass-if-exception "complex/inum" exception:wrong-type-arg + (max 1+i 123)) + (pass-if-exception "complex/big" exception:wrong-type-arg + (max 1+i 9999999999999999999999999999999999999999)) + (pass-if-exception "complex/real" exception:wrong-type-arg + (max 1+i 123.0)) + (pass-if-exception "complex/frac" exception:wrong-type-arg + (max 1+i 123/456)) + (pass-if (= 456.0 (max 123.0 456.0))) (pass-if (= 456.0 (max 456.0 123.0))) @@ -1914,6 +1938,30 @@ ;; FIXME: unfinished... (with-test-prefix "min" + (pass-if-exception "no args" exception:wrong-num-args + (min)) + + (pass-if-exception "one complex" exception:wrong-type-arg + (min 1+i)) + + (pass-if-exception "inum/complex" exception:wrong-type-arg + (min 123 1+i)) + (pass-if-exception "big/complex" exception:wrong-type-arg + (min 9999999999999999999999999999999999999999 1+i)) + (pass-if-exception "real/complex" exception:wrong-type-arg + (min 123.0 1+i)) + (pass-if-exception "frac/complex" exception:wrong-type-arg + (min 123/456 1+i)) + + (pass-if-exception "complex/inum" exception:wrong-type-arg + (min 1+i 123)) + (pass-if-exception "complex/big" exception:wrong-type-arg + (min 1+i 9999999999999999999999999999999999999999)) + (pass-if-exception "complex/real" exception:wrong-type-arg + (min 1+i 123.0)) + (pass-if-exception "complex/frac" exception:wrong-type-arg + (min 1+i 123/456)) + (pass-if (= 123.0 (min 123.0 456.0))) (pass-if (= 123.0 (min 456.0 123.0))) From 9593c679b94e7af874eef2d25cf22b85aeeaaa50 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 21 Feb 2004 22:04:42 +0000 Subject: [PATCH 154/167] *** empty log message *** --- test-suite/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 4f1ccbec7..f1e727757 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2004-02-22 Kevin Ryde + + * tests/numbers.test (max, min): Exercise some complex num cases. + 2004-02-18 Marius Vollmer * tests/fractions.test: Added copyright notice of Michael Stoll, From 9de7b7abb4abafc7b3ff21c2dd32bfc60650a7fd Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 22 Feb 2004 11:11:17 +0000 Subject: [PATCH 155/167] * gds-tutorial.txt, gds-problems.txt: New files. --- emacs/ChangeLog | 6 ++++++ emacs/Makefile.am | 2 +- emacs/gds-problems.txt | 20 ++++++++++++++++++++ emacs/gds-tutorial.txt | 0 4 files changed, 27 insertions(+), 1 deletion(-) create mode 100644 emacs/gds-problems.txt create mode 100644 emacs/gds-tutorial.txt diff --git a/emacs/ChangeLog b/emacs/ChangeLog index b649bd434..4e3f8c79b 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,9 @@ +2004-02-22 Neil Jerram + + * Makefile.am (EXTRA_DIST): Distribute new files. + + * gds-tutorial.txt, gds-problems.txt: New files. + 2004-02-21 Neil Jerram * gds.el: Add requirements: cl, comint, info. diff --git a/emacs/Makefile.am b/emacs/Makefile.am index c85ad1ca5..bef23935c 100644 --- a/emacs/Makefile.am +++ b/emacs/Makefile.am @@ -35,4 +35,4 @@ info_TEXINFOS = gds.texi TEXINFO_TEX = ../doc/ref/texinfo.tex TAGS_FILES = $(subpkgdata_DATA) $(lisp_LISP) -EXTRA_DIST = $(subpkgdata_DATA) $(lisp_LISP) +EXTRA_DIST = $(subpkgdata_DATA) $(lisp_LISP) gds-tutorial.txt gds-problems.txt diff --git a/emacs/gds-problems.txt b/emacs/gds-problems.txt new file mode 100644 index 000000000..a3d2423c3 --- /dev/null +++ b/emacs/gds-problems.txt @@ -0,0 +1,20 @@ + -*- outline -*- +Known GDS problems + +* gds-load-file (C-c C-l) doesn't work + +This is because it isn't yet implemented in gds-client.scm. + +* Incomplete expressions aren't reported nicely + +In code sent for evaluation, that is. Currently this is reported as a +GDS Internal Error. It should be reported like error-in-evaluation +and, in cases where the code evaluated contained multiple expressions, +should correctly show the results of evaluating the expressions that +were read before the read error was noticed.. + +* In the debugger, `e' (gds-evaluate) isn't easy to use + +Because it doesn't pop up the result! (You can see the result with `v +m', but these extra keys shouldn't be needed.) + diff --git a/emacs/gds-tutorial.txt b/emacs/gds-tutorial.txt new file mode 100644 index 000000000..e69de29bb From 1b317eb1967beeb1f305485c091d8088b8fd346b Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 23 Feb 2004 22:05:37 +0000 Subject: [PATCH 156/167] (scm_cuserid): Use a private result buffer, for thread safe. --- libguile/posix.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libguile/posix.c b/libguile/posix.c index 14c80f3eb..bed16a057 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1498,9 +1498,10 @@ SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0, "information cannot be obtained.") #define FUNC_NAME s_scm_cuserid { + char buf[L_cuserid]; char * p; - p = cuserid (NULL); + p = cuserid (buf); if (!p || !*p) return SCM_BOOL_F; return scm_makfrom0str (p); From 72ea45ac4c7343fc62368dbc46d4f8f9fc0853a4 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Mon, 23 Feb 2004 22:59:20 +0000 Subject: [PATCH 157/167] *** empty log message *** --- libguile/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index ac18bf8fa..717ce0471 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2004-02-24 Kevin Ryde + + * posix.c (scm_cuserid): Use a private result buffer, for thread safe. + 2004-02-22 Kevin Ryde * numbers.c (scm_max, scm_min): For one arg, dispatch to generic for From 7f05d32538e599de5130feb9eb21fe2dd1a43a2f Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 25 Feb 2004 19:10:07 +0000 Subject: [PATCH 158/167] * gds-client.scm (handle-instruction-1): In `eval' protocol, catch and report read errors nicely. * gds.el (gds-display-buffers): Don't select the GDS window. --- emacs/ChangeLog | 7 ++++++ emacs/gds-client.scm | 57 ++++++++++++++++++++++++++++---------------- emacs/gds.el | 6 +---- 3 files changed, 45 insertions(+), 25 deletions(-) diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 4e3f8c79b..00f6ad007 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,10 @@ +2004-02-25 Neil Jerram + + * gds-client.scm (handle-instruction-1): In `eval' protocol, catch + and report read errors nicely. + + * gds.el (gds-display-buffers): Don't select the GDS window. + 2004-02-22 Neil Jerram * Makefile.am (EXTRA_DIST): Distribute new files. diff --git a/emacs/gds-client.scm b/emacs/gds-client.scm index 12ab234f8..c1714a22d 100644 --- a/emacs/gds-client.scm +++ b/emacs/gds-client.scm @@ -411,26 +411,43 @@ decimal IP address where the UI server is running; default is (set-port-line! (current-input-port) line) (set-port-column! (current-input-port) column) (let ((m (and module (resolve-module-from-root module)))) - (let loop ((exprs '()) (x (read))) - (if (eof-object? x) - ;; Expressions to be evaluated have all been - ;; read. Now hand them off to an - ;; eval-thread for the actual evaluation. - (with-mutex eval-work-mutex - (trc 'protocol-thread "evaluation work available") - (set! eval-work (cons* correlator m (reverse! exprs))) - (set! eval-work-available #t) - (broadcast-condition-variable eval-work-changed) - (wait-condition-variable eval-work-taken - eval-work-mutex) - (assert (not eval-work-available)) - (trc 'protocol-thread "evaluation work underway")) - ;; Another complete expression read. Set - ;; breakpoints in the read code as specified - ;; by bpinfo, and add it to the list. - (begin - (install-breakpoints x bpinfo) - (loop (cons x exprs) (read))))))))) + (catch 'read-error + (lambda () + (let loop ((exprs '()) (x (read))) + (if (eof-object? x) + ;; Expressions to be evaluated have all + ;; been read. Now hand them off to an + ;; eval-thread for the actual + ;; evaluation. + (with-mutex eval-work-mutex + (trc 'protocol-thread + "evaluation work available") + (set! eval-work + (cons* correlator m (reverse! exprs))) + (set! eval-work-available #t) + (broadcast-condition-variable eval-work-changed) + (wait-condition-variable eval-work-taken + eval-work-mutex) + (assert (not eval-work-available)) + (trc 'protocol-thread + "evaluation work underway")) + ;; Another complete expression read. + ;; Set breakpoints in the read code as + ;; specified by bpinfo, and add it to + ;; the list. + (begin + (install-breakpoints x bpinfo) + (loop (cons x exprs) (read)))))) + (lambda (key . args) + (write-form `(eval-results + ,correlator + ,(with-output-to-string + (lambda () + (display ";;; Reading expressions") + (display " to evaluate\n") + (apply display-error #f + (current-output-port) args))) + ("error-in-read"))))))))) (cdr ins)) state) ((complete) diff --git a/emacs/gds.el b/emacs/gds.el index 50d08ec76..d5f607a32 100644 --- a/emacs/gds.el +++ b/emacs/gds.el @@ -478,11 +478,7 @@ The function is called with one argument, the CLIENT in question." ;; If there's already a window showing the buffer, use it. (let ((window (get-buffer-window buf t))) (if window - (progn - (make-frame-visible (window-frame window)) - (select-frame (window-frame window)) - (select-window window)) - ;;(select-window (display-buffer buf)) + (make-frame-visible (window-frame window)) (display-buffer buf))) ;; If there is an associated source buffer, display it as well. (if (and (eq (car gds-views) 'stack) From 6841205b19c6856f5cac14015d73d8a12beb985b Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 25 Feb 2004 19:11:33 +0000 Subject: [PATCH 159/167] *** empty log message *** --- emacs/gds-problems.txt | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/emacs/gds-problems.txt b/emacs/gds-problems.txt index a3d2423c3..e69de29bb 100644 --- a/emacs/gds-problems.txt +++ b/emacs/gds-problems.txt @@ -1,20 +0,0 @@ - -*- outline -*- -Known GDS problems - -* gds-load-file (C-c C-l) doesn't work - -This is because it isn't yet implemented in gds-client.scm. - -* Incomplete expressions aren't reported nicely - -In code sent for evaluation, that is. Currently this is reported as a -GDS Internal Error. It should be reported like error-in-evaluation -and, in cases where the code evaluated contained multiple expressions, -should correctly show the results of evaluating the expressions that -were read before the read error was noticed.. - -* In the debugger, `e' (gds-evaluate) isn't easy to use - -Because it doesn't pop up the result! (You can see the result with `v -m', but these extra keys shouldn't be needed.) - From 807f353fedf52ad5f591b652175bf3101c121d98 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 28 Feb 2004 19:16:26 +0000 Subject: [PATCH 160/167] (scm_execl, scm_execlp, scm_execle): Avoid memory leak under error throw. --- libguile/posix.c | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/libguile/posix.c b/libguile/posix.c index bed16a057..1745903dd 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -909,9 +909,13 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1, #define FUNC_NAME s_scm_execl { char **execargv; + int save_errno; SCM_VALIDATE_STRING (1, filename); execargv = allocate_string_pointers (args); execv (SCM_STRING_CHARS (filename), execargv); + save_errno = errno; + free (execargv); + errno = save_errno; SCM_SYSERROR; /* not reached. */ return SCM_BOOL_F; @@ -929,9 +933,13 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1, #define FUNC_NAME s_scm_execlp { char **execargv; + int save_errno; SCM_VALIDATE_STRING (1, filename); execargv = allocate_string_pointers (args); execvp (SCM_STRING_CHARS (filename), execargv); + save_errno = errno; + free (execargv); + errno = save_errno; SCM_SYSERROR; /* not reached. */ return SCM_BOOL_F; @@ -969,6 +977,9 @@ environ_list_to_c (SCM envlist, int arg, const char *proc) return result; } +/* OPTIMIZE-ME: scm_execle doesn't need malloced copies of the environment + list strings the way environ_list_to_c gives. */ + SCM_DEFINE (scm_execle, "execle", 2, 0, 1, (SCM filename, SCM env, SCM args), "Similar to @code{execl}, but the environment of the new process is\n" @@ -980,12 +991,19 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1, { char **execargv; char **exec_env; + int save_errno, i; SCM_VALIDATE_STRING (1, filename); execargv = allocate_string_pointers (args); exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME); execve (SCM_STRING_CHARS (filename), execargv, exec_env); + save_errno = errno; + free (execargv); + for (i = 0; exec_env[i] != NULL; i++) + free (exec_env[i]); + free (exec_env); + errno = save_errno; SCM_SYSERROR; /* not reached. */ return SCM_BOOL_F; From 240a27d2c5c4c7bf612fd037e4f7b0f1afcdb5e6 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 28 Feb 2004 20:01:13 +0000 Subject: [PATCH 161/167] (guile_ieee_init): Use C99 INFINITY and NAN when available. Test HAVE_DINFINITY and HAVE_DQNAN for those globals, in particular don't assume "defined (__alpha__) && ! defined (linux)" means OSF. Remove "SCO" code, which was not really SCO specific and which John W. Eaton advises should be long past being needed. --- libguile/numbers.c | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 8c7c87c02..613b9114d 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -560,10 +560,15 @@ guile_ieee_init (void) /* Some version of gcc on some old version of Linux used to crash when trying to make Inf and NaN. */ -#if defined (SCO) - double tmp = 1.0; - guile_Inf = 1.0 / (tmp - tmp); -#elif defined (__alpha__) && ! defined (linux) +#ifdef INFINITY + /* C99 INFINITY, when available. + FIXME: The standard allows for INFINITY to be something that overflows + at compile time. We ought to have a configure test to check for that + before trying to use it. (But in practice we believe this is not a + problem on any system guile is likely to target.) */ + guile_Inf = INFINITY; +#elif HAVE_DINFINITY + /* OSF */ extern unsigned int DINFINITY[2]; guile_Inf = (*(X_CAST(double *, DINFINITY))); #else @@ -582,7 +587,11 @@ guile_ieee_init (void) #if defined (HAVE_ISNAN) -#if defined (__alpha__) && ! defined (linux) +#ifdef NAN + /* C99 NAN, when available */ + guile_NaN = NAN; +#elif HAVE_DQNAN + /* OSF */ extern unsigned int DQNAN[2]; guile_NaN = (*(X_CAST(double *, DQNAN))); #else From a73256d0181d97b1b8743e0e9e27467735867994 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 28 Feb 2004 20:03:18 +0000 Subject: [PATCH 162/167] Use AC_COPYRIGHT and AH_TOP to get copyright notice into generated configure and config.h.in. --- configure.in | 43 +++++++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/configure.in b/configure.in index 54e24ec38..0fe842e01 100644 --- a/configure.in +++ b/configure.in @@ -1,33 +1,40 @@ dnl configuration script for Guile dnl Process this file with autoconf to produce configure. dnl -dnl Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. -dnl -dnl This file is part of GUILE -dnl -dnl GUILE is free software; you can redistribute it and/or modify it -dnl under the terms of the GNU General Public License as published by -dnl the Free Software Foundation; either version 2, or (at your -dnl option) any later version. -dnl -dnl GUILE is distributed in the hope that it will be useful, but -dnl WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -dnl General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public License -dnl along with GUILE; see the file COPYING. If not, write to the -dnl Free Software Foundation, Inc., 59 Temple Place - Suite 330, -dnl Boston, MA 02111-1307, USA. + +define(GUILE_CONFIGURE_COPYRIGHT,[[ + +Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 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. + +]]) AC_PREREQ(2.53) AC_INIT +AC_COPYRIGHT(GUILE_CONFIGURE_COPYRIGHT) AC_CONFIG_SRCDIR([GUILE-VERSION]) . $srcdir/GUILE-VERSION AM_INIT_AUTOMAKE($PACKAGE, $VERSION, no-define) AM_MAINTAINER_MODE AM_CONFIG_HEADER([config.h]) +AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/) #-------------------------------------------------------------------- # From 1df728345b13480fba5b8bbf8db91ec122b9a5c6 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 28 Feb 2004 20:08:08 +0000 Subject: [PATCH 163/167] (AC_CHECK_FUNCS): Add DINFINITY and DQNAN. --- configure.in | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/configure.in b/configure.in index 0fe842e01..a2dd4b33b 100644 --- a/configure.in +++ b/configure.in @@ -595,9 +595,12 @@ AC_SUBST(DLPREOPEN) AC_CHECK_HEADERS([assert.h crt_externs.h]) # Reasons for testing: +# DINFINITY - OSF specific +# DQNAN - OSF specific +# (DINFINITY and DQNAN are actually global variables, not functions) # _NSGetEnviron - Darwin specific # -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 unsetenv _NSGetEnviron]) +AC_CHECK_FUNCS([DINFINITY DQNAN 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 unsetenv _NSGetEnviron]) AC_CHECK_HEADERS(crypt.h sys/resource.h sys/file.h) AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname) From 004ad931309bc8098cfc198d5e1296835517e4f2 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 28 Feb 2004 20:11:14 +0000 Subject: [PATCH 164/167] *** empty log message *** --- ChangeLog | 7 +++++++ libguile/ChangeLog | 11 +++++++++++ 2 files changed, 18 insertions(+) diff --git a/ChangeLog b/ChangeLog index ab3f92c91..21fbc8b9f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2004-02-29 Kevin Ryde + + * configure.in: Use AC_COPYRIGHT and AH_TOP to get copyright notice + into generated configure and config.h.in. + + * configure.in (AC_CHECK_FUNCS): Add DINFINITY and DQNAN. + 2004-02-21 Kevin Ryde * configure.in (crypt): Test with AC_SEARCH_LIBS, for the benefit of diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 717ce0471..dc809067e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,14 @@ +2004-02-29 Kevin Ryde + + * numbers.c (guile_ieee_init): Use C99 INFINITY and NAN when + available. Test HAVE_DINFINITY and HAVE_DQNAN for those globals, in + particular don't assume "defined (__alpha__) && ! defined (linux)" + means OSF. Remove "SCO" code, which was not really SCO specific and + which John W. Eaton advises should be long past being needed. + + * posix.c (scm_execl, scm_execlp, scm_execle): Avoid memory leak under + error throw. + 2004-02-24 Kevin Ryde * posix.c (scm_cuserid): Use a private result buffer, for thread safe. From 32bb5bd88c719861375528da70440f15c9edf9c7 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 28 Feb 2004 21:37:41 +0000 Subject: [PATCH 165/167] (execl, execlp, execle): Exercise errors where program not found. --- test-suite/tests/posix.test | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index a4c9ee362..d00fca3f6 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -1,6 +1,6 @@ ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*- ;;;; -;;;; Copyright 2003 Free Software Foundation, Inc. +;;;; Copyright 2003, 2004 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 @@ -20,6 +20,32 @@ (use-modules (test-suite lib)) +;; +;; execl +;; + +(with-test-prefix "execl" + (pass-if-exception "./nosuchprog" '(system-error . ".*") + (execl "./nosuchprog" "./nosuchprog" "some arg"))) + +;; +;; execlp +;; + +(with-test-prefix "execlp" + (pass-if-exception "./nosuchprog" '(system-error . ".*") + (execlp "./nosuchprog" "./nosuchprog" "some arg"))) + +;; +;; execle +;; + +(with-test-prefix "execle" + (pass-if-exception "./nosuchprog" '(system-error . ".*") + (execle "./nosuchprog" '() "./nosuchprog" "some arg")) + (pass-if-exception "./nosuchprog" '(system-error . ".*") + (execle "./nosuchprog" '("FOO=1" "BAR=2") "./nosuchprog" "some arg"))) + ;; ;; putenv ;; From 2a61284af558555399ceb03b4044b136176bcd95 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 28 Feb 2004 21:38:37 +0000 Subject: [PATCH 166/167] *** empty log message *** --- test-suite/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index f1e727757..b927a8673 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2004-02-29 Kevin Ryde + + * tests/posix.test (execl, execlp, execle): Exercise errors where + program not found. + 2004-02-22 Kevin Ryde * tests/numbers.test (max, min): Exercise some complex num cases. From c2d31141dcd8eb4aad0fa5238ed3ce23952bc332 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 28 Feb 2004 23:07:56 +0000 Subject: [PATCH 167/167] (execl, execlp, execle): Exercise errors where program not found. [But disabled, due to problems with threading.] --- test-suite/tests/posix.test | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index d00fca3f6..7ed564b81 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -20,31 +20,38 @@ (use-modules (test-suite lib)) +;; FIXME: The following exec tests are disabled since on an i386 debian with +;; glibc 2.3.2 they seem to interact badly with threads.test, the latter +;; dies with signal 32 (one of the SIGRTs). Don't know how or why, or who's +;; at fault (though it seems to happen with or without the recent memory +;; leak fix in these error cases). + ;; ;; execl ;; -(with-test-prefix "execl" - (pass-if-exception "./nosuchprog" '(system-error . ".*") - (execl "./nosuchprog" "./nosuchprog" "some arg"))) +;; (with-test-prefix "execl" +;; (pass-if-exception "./nosuchprog" '(system-error . ".*") +;; (execl "./nosuchprog" "./nosuchprog" "some arg"))) ;; ;; execlp ;; -(with-test-prefix "execlp" - (pass-if-exception "./nosuchprog" '(system-error . ".*") - (execlp "./nosuchprog" "./nosuchprog" "some arg"))) +;; (with-test-prefix "execlp" +;; (pass-if-exception "./nosuchprog" '(system-error . ".*") +;; (execlp "./nosuchprog" "./nosuchprog" "some arg"))) ;; ;; execle ;; -(with-test-prefix "execle" - (pass-if-exception "./nosuchprog" '(system-error . ".*") - (execle "./nosuchprog" '() "./nosuchprog" "some arg")) - (pass-if-exception "./nosuchprog" '(system-error . ".*") - (execle "./nosuchprog" '("FOO=1" "BAR=2") "./nosuchprog" "some arg"))) +;; (with-test-prefix "execle" +;; (pass-if-exception "./nosuchprog" '(system-error . ".*") +;; (execle "./nosuchprog" '() "./nosuchprog" "some arg")) +;; (pass-if-exception "./nosuchprog" '(system-error . ".*") +;; (execle "./nosuchprog" '("FOO=1" "BAR=2") "./nosuchprog" "some arg"))) + ;; ;; putenv