mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 16:30:19 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Marius Vollmer 2004-09-22 17:41:37 +00:00
parent a61f4e0c61
commit d2e53ed6f8
56 changed files with 392 additions and 923 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/ChangeLog
View file

@ -1,7 +1,17 @@
2004-09-22 Marius Vollmer <marius.vollmer@uni-dortmund.de>
2004-09-22 Marius Vollmer <mvo@zagadka.de>
* pairs.h (scm_car, scm_cdr, scm_i_chase_pairs, SCM_I_A_PAT,
SCM_I_D_PAT, etc, scm_caar, scm_cadr, etc): New.
* discouraged.h, tags.h (SCM_CONSP, SCM_NCONSP): Moved to
discouraged.h. Replaced all uses with scm_is_pair.
(SCM_I_CONSP): New name for SCM_CONSP.
* pairs.h, pairs.c (scm_is_pair, scm_is_null, scm_car, scm_cdr,
scm_i_chase_pairs, SCM_I_A_PAT, SCM_I_D_PAT, etc, scm_caar,
scm_cadr, etc): New.
(SCM_NULLP, SCM_NNULLP): Moved to discouraged.h. Replaced all
uses with scm_is_null.
* eval.c (scm_eval, scm_apply, call_cxr_1): Use scm_i_chase_pairs
instead of explicit code.
2004-09-22 Marius Vollmer <mvo@zagadka.de>

45
libguile/alist.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
/* Copyright (C) 1995, 96, 97, 98, 99, 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
@ -23,6 +23,7 @@
#include "libguile/lang.h"
#include "libguile/validate.h"
#include "libguile/pairs.h"
#include "libguile/alist.h"
@ -49,10 +50,10 @@ SCM_DEFINE (scm_sloppy_assq, "sloppy-assq", 2, 0, 0,
"Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assq
{
for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
for (; scm_is_pair (alist); alist = SCM_CDR (alist))
{
SCM tmp = SCM_CAR (alist);
if (SCM_CONSP (tmp) && scm_is_eq (SCM_CAR (tmp), key))
if (scm_is_pair (tmp) && scm_is_eq (SCM_CAR (tmp), key))
return tmp;
}
return SCM_BOOL_F;
@ -67,10 +68,10 @@ SCM_DEFINE (scm_sloppy_assv, "sloppy-assv", 2, 0, 0,
"Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assv
{
for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
for (; scm_is_pair (alist); alist = SCM_CDR (alist))
{
SCM tmp = SCM_CAR (alist);
if (SCM_CONSP (tmp)
if (scm_is_pair (tmp)
&& scm_is_true (scm_eqv_p (SCM_CAR (tmp), key)))
return tmp;
}
@ -85,10 +86,10 @@ SCM_DEFINE (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0,
"Recommended only for use in Guile internals.")
#define FUNC_NAME s_scm_sloppy_assoc
{
for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
for (; scm_is_pair (alist); alist = SCM_CDR (alist))
{
SCM tmp = SCM_CAR (alist);
if (SCM_CONSP (tmp)
if (scm_is_pair (tmp)
&& scm_is_true (scm_equal_p (SCM_CAR (tmp), key)))
return tmp;
}
@ -113,10 +114,10 @@ SCM_DEFINE (scm_assq, "assq", 2, 0, 0,
#define FUNC_NAME s_scm_assq
{
SCM ls = alist;
for (; SCM_CONSP (ls); ls = SCM_CDR (ls))
for(; scm_is_pair (ls); ls = SCM_CDR (ls))
{
SCM tmp = SCM_CAR (ls);
SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
"association list");
if (scm_is_eq (SCM_CAR (tmp), key))
return tmp;
@ -134,10 +135,10 @@ SCM_DEFINE (scm_assv, "assv", 2, 0, 0,
#define FUNC_NAME s_scm_assv
{
SCM ls = alist;
for(; SCM_CONSP (ls); ls = SCM_CDR (ls))
for(; scm_is_pair (ls); ls = SCM_CDR (ls))
{
SCM tmp = SCM_CAR (ls);
SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
"association list");
if (scm_is_true (scm_eqv_p (SCM_CAR (tmp), key)))
return tmp;
@ -155,10 +156,10 @@ SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0,
#define FUNC_NAME s_scm_assoc
{
SCM ls = alist;
for(; SCM_CONSP (ls); ls = SCM_CDR (ls))
for(; scm_is_pair (ls); ls = SCM_CDR (ls))
{
SCM tmp = SCM_CAR (ls);
SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
"association list");
if (scm_is_true (scm_equal_p (SCM_CAR (tmp), key)))
return tmp;
@ -201,7 +202,7 @@ SCM_DEFINE (scm_assq_ref, "assq-ref", 2, 0, 0,
SCM handle;
handle = scm_sloppy_assq (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
{
return SCM_CDR (handle);
}
@ -218,7 +219,7 @@ SCM_DEFINE (scm_assv_ref, "assv-ref", 2, 0, 0,
SCM handle;
handle = scm_sloppy_assv (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
{
return SCM_CDR (handle);
}
@ -235,7 +236,7 @@ SCM_DEFINE (scm_assoc_ref, "assoc-ref", 2, 0, 0,
SCM handle;
handle = scm_sloppy_assoc (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
{
return SCM_CDR (handle);
}
@ -264,7 +265,7 @@ SCM_DEFINE (scm_assq_set_x, "assq-set!", 3, 0, 0,
SCM handle;
handle = scm_sloppy_assq (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
{
SCM_SETCDR (handle, val);
return alist;
@ -282,7 +283,7 @@ SCM_DEFINE (scm_assv_set_x, "assv-set!", 3, 0, 0,
SCM handle;
handle = scm_sloppy_assv (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
{
SCM_SETCDR (handle, val);
return alist;
@ -300,7 +301,7 @@ SCM_DEFINE (scm_assoc_set_x, "assoc-set!", 3, 0, 0,
SCM handle;
handle = scm_sloppy_assoc (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
{
SCM_SETCDR (handle, val);
return alist;
@ -324,7 +325,7 @@ SCM_DEFINE (scm_assq_remove_x, "assq-remove!", 2, 0, 0,
SCM handle;
handle = scm_sloppy_assq (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
alist = scm_delq1_x (handle, alist);
return alist;
@ -340,7 +341,7 @@ SCM_DEFINE (scm_assv_remove_x, "assv-remove!", 2, 0, 0,
SCM handle;
handle = scm_sloppy_assv (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
alist = scm_delq1_x (handle, alist);
return alist;
@ -356,7 +357,7 @@ SCM_DEFINE (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0,
SCM handle;
handle = scm_sloppy_assoc (key, alist);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
alist = scm_delq1_x (handle, alist);
return alist;

6
libguile/async.c
View file

@ -149,7 +149,7 @@ scm_async_click ()
if (scm_root->block_asyncs == 0)
{
SCM asyncs;
while (!SCM_NULLP(asyncs = scm_root->active_asyncs))
while (!scm_is_null(asyncs = scm_root->active_asyncs))
{
scm_root->active_asyncs = SCM_EOL;
do
@ -157,9 +157,9 @@ scm_async_click ()
scm_call_0 (SCM_CAR (asyncs));
asyncs = SCM_CDR (asyncs);
}
while (!SCM_NULLP(asyncs));
while (!scm_is_null(asyncs));
}
for (asyncs = scm_root->signal_asyncs; !SCM_NULLP(asyncs);
for (asyncs = scm_root->signal_asyncs; !scm_is_null(asyncs);
asyncs = SCM_CDR (asyncs))
{
if (scm_is_true (SCM_CAR (asyncs)))

6
libguile/backtrace.c
View file

@ -381,7 +381,7 @@ display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, S
{
pstate->length = print_params[i].length;
ptob->seek (sport, 0, SEEK_SET);
if (SCM_CONSP (exp))
if (scm_is_pair (exp))
{
pstate->level = print_params[i].level - 1;
scm_iprlist (hdr, exp, tlr[0], sport, pstate);
@ -607,14 +607,14 @@ display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_
/* Display a special form. */
{
SCM source = SCM_FRAME_SOURCE (frame);
SCM copy = (SCM_CONSP (source)
SCM copy = (scm_is_pair (source)
? scm_source_property (source, scm_sym_copy)
: SCM_BOOL_F);
SCM umcopy = (SCM_MEMOIZEDP (source)
? scm_i_unmemoize_expr (source)
: SCM_BOOL_F);
display_frame_expr ("(",
SCM_CONSP (copy) ? copy : umcopy,
scm_is_pair (copy) ? copy : umcopy,
")",
nfield + 1 + indentation,
sport,

16
libguile/coop-pthreads.c
View file

@ -46,7 +46,7 @@ static void
enqueue (SCM q, SCM t)
{
SCM c = scm_cons (t, SCM_EOL);
if (SCM_NULLP (SCM_CAR (q)))
if (scm_is_null (SCM_CAR (q)))
SCM_SETCAR (q, c);
else
SCM_SETCDR (SCM_CDR (q), c);
@ -57,12 +57,12 @@ static SCM
dequeue (SCM q)
{
SCM c = SCM_CAR (q);
if (SCM_NULLP (c))
if (scm_is_null (c))
return SCM_BOOL_F;
else
{
SCM_SETCAR (q, SCM_CDR (c));
if (SCM_NULLP (SCM_CAR (q)))
if (scm_is_null (SCM_CAR (q)))
SCM_SETCDR (q, SCM_EOL);
return SCM_CAR (c);
}
@ -546,7 +546,7 @@ scm_call_with_new_thread (SCM argl)
/* Check arguments. */
{
register SCM args = argl;
if (!SCM_CONSP (args))
if (!scm_is_pair (args))
SCM_WRONG_NUM_ARGS ();
thunk = SCM_CAR (args);
SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)),
@ -554,14 +554,14 @@ scm_call_with_new_thread (SCM argl)
SCM_ARG1,
s_call_with_new_thread);
args = SCM_CDR (args);
if (!SCM_CONSP (args))
if (!scm_is_pair (args))
SCM_WRONG_NUM_ARGS ();
handler = SCM_CAR (args);
SCM_ASSERT (scm_is_true (scm_procedure_p (handler)),
handler,
SCM_ARG2,
s_call_with_new_thread);
if (!SCM_NULLP (SCM_CDR (args)))
if (!scm_is_null (SCM_CDR (args)))
SCM_WRONG_NUM_ARGS ();
}
@ -738,7 +738,7 @@ scm_timed_wait_condition_variable (SCM cv, SCM mx, SCM t)
s_wait_condition_variable);
if (!SCM_UNBNDP (t))
{
if (SCM_CONSP (t))
if (scm_is_pair (t))
{
SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_nsec);
@ -858,7 +858,7 @@ void
scm_threads_mark_stacks (void)
{
volatile SCM c;
for (c = all_threads; !SCM_NULLP (c); c = SCM_CDR (c))
for (c = all_threads; !scm_is_null (c); c = SCM_CDR (c))
{
scm_copt_thread *t = SCM_THREAD_DATA (SCM_CAR (c));
if (t->base == NULL)

549
libguile/coop-threads.c
View file

@ -1,549 +0,0 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 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
*/
#include "libguile/_scm.h"
#include "libguile/validate.h"
#include "libguile/coop-threads.h"
#include "libguile/root.h"
/* A counter of the current number of threads */
size_t scm_thread_count = 0;
/* This is included rather than compiled separately in order
to simplify the configuration mechanism. */
#include "libguile/coop.c"
/* A count-down counter used to determine when to switch
contexts */
size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
coop_m scm_critical_section_mutex;
static SCM all_threads;
void
scm_threads_init (SCM_STACKITEM *i)
{
coop_init();
scm_tc16_thread = scm_make_smob_type ("thread", 0);
scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (coop_m));
scm_tc16_condvar = scm_make_smob_type ("condition-variable",
sizeof (coop_c));
scm_thread_count = 1;
#ifndef GUILE_PTHREAD_COMPAT
coop_global_main.sto = i;
#endif
coop_global_main.base = i;
coop_global_curr = &coop_global_main;
coop_all_qput (&coop_global_allq, coop_global_curr);
coop_mutex_init (&scm_critical_section_mutex);
coop_global_main.data = 0; /* Initialized in init.c */
coop_global_main.handle = scm_cell (scm_tc16_thread,
(scm_t_bits) &coop_global_main);
scm_gc_register_root (&all_threads);
all_threads = scm_cons (coop_global_main.handle, SCM_EOL);
}
void
scm_threads_mark_stacks (void)
{
coop_t *thread;
for (thread = coop_global_allq.t.all_next;
thread != NULL; thread = thread->all_next)
{
if (thread == coop_global_curr)
{
/* Active thread */
/* stack_len is long rather than sizet in order to guarantee
that &stack_len is long aligned */
#if SCM_STACK_GROWS_UP
long stack_len = ((SCM_STACKITEM *) (&thread) -
(SCM_STACKITEM *) thread->base);
/* Protect from the C stack. This must be the first marking
* done because it provides information about what objects
* are "in-use" by the C code. "in-use" objects are those
* for which the information about length and base address must
* remain usable. This requirement is stricter than a liveness
* requirement -- in particular, it constrains the implementation
* of scm_resizuve.
*/
SCM_FLUSH_REGISTER_WINDOWS;
/* This assumes that all registers are saved into the jmp_buf */
setjmp (scm_save_regs_gc_mark);
scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
((size_t) sizeof scm_save_regs_gc_mark
/ sizeof (SCM_STACKITEM)));
scm_mark_locations (((size_t) thread->base,
(sizet) stack_len));
#else
long stack_len = ((SCM_STACKITEM *) thread->base -
(SCM_STACKITEM *) (&thread));
/* Protect from the C stack. This must be the first marking
* done because it provides information about what objects
* are "in-use" by the C code. "in-use" objects are those
* for which the information about length and base address must
* remain usable. This requirement is stricter than a liveness
* requirement -- in particular, it constrains the implementation
* of scm_resizuve.
*/
SCM_FLUSH_REGISTER_WINDOWS;
/* This assumes that all registers are saved into the jmp_buf */
setjmp (scm_save_regs_gc_mark);
scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
((size_t) sizeof scm_save_regs_gc_mark
/ sizeof (SCM_STACKITEM)));
scm_mark_locations ((SCM_STACKITEM *) &thread,
stack_len);
#endif
}
else
{
/* Suspended thread */
#if SCM_STACK_GROWS_UP
long stack_len = ((SCM_STACKITEM *) (thread->sp) -
(SCM_STACKITEM *) thread->base);
scm_mark_locations ((size_t)thread->base,
(sizet) stack_len);
#else
long stack_len = ((SCM_STACKITEM *) thread->base -
(SCM_STACKITEM *) (thread->sp));
/* Registers are already on the stack. No need to mark. */
scm_mark_locations ((SCM_STACKITEM *) (size_t)thread->sp,
stack_len);
#endif
}
/* Mark this thread's root */
scm_gc_mark (((scm_root_state *) thread->data) -> handle);
}
}
/* NOTE: There are TWO mechanisms for starting a thread: The first one
is used when spawning a thread from Scheme, while the second one is
used from C.
It might be argued that the first should be implemented in terms of
the second. The reason it isn't is that that would require an
extra unnecessary malloc (the thread_args structure). By providing
one pair of extra functions (c_launch_thread, scm_spawn_thread) the
Scheme threads are started more efficiently. */
/* This is the first thread spawning mechanism: threads from Scheme */
typedef struct scheme_launch_data {
SCM rootcont;
SCM body;
SCM handler;
} scheme_launch_data;
static SCM
scheme_body_bootstrip (scheme_launch_data* data)
{
/* First save the new root continuation */
data->rootcont = scm_root->rootcont;
return scm_call_0 (data->body);
}
static SCM
scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args)
{
scm_root->rootcont = data->rootcont;
return scm_apply_1 (data->handler, tag, throw_args);
}
static void
scheme_launch_thread (void *p)
{
/* The thread object will be GC protected by being a member of the
list given as argument to launch_thread. It will be marked
during the conservative sweep of the stack. */
register SCM argl = (SCM) p;
SCM thread = SCM_CAR (argl);
scheme_launch_data data;
data.rootcont = SCM_BOOL_F;
data.body = SCM_CADR (argl);
data.handler = SCM_CADDR (argl);
scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip,
&data,
(scm_t_catch_handler) scheme_handler_bootstrip,
&data,
(SCM_STACKITEM *) &thread);
SCM_SET_CELL_WORD_1 (thread, 0);
scm_thread_count--;
all_threads = scm_delq (thread, all_threads);
SCM_DEFER_INTS;
}
SCM
scm_call_with_new_thread (SCM argl)
#define FUNC_NAME s_call_with_new_thread
{
SCM thread;
/* Check arguments. */
{
register SCM args = argl;
SCM thunk, handler;
if (!SCM_CONSP (args))
SCM_WRONG_NUM_ARGS ();
thunk = SCM_CAR (args);
SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)),
thunk,
SCM_ARG1,
s_call_with_new_thread);
args = SCM_CDR (args);
if (!SCM_CONSP (args))
SCM_WRONG_NUM_ARGS ();
handler = SCM_CAR (args);
SCM_ASSERT (scm_is_true (scm_procedure_p (handler)),
handler,
SCM_ARG2,
s_call_with_new_thread);
if (!SCM_NULLP (SCM_CDR (args)))
SCM_WRONG_NUM_ARGS ();
}
/* Make new thread. */
{
coop_t *t;
SCM root, old_winds;
/* Unwind wind chain. */
old_winds = scm_dynwinds;
scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds));
/* Allocate thread locals. */
root = scm_make_root (scm_root->handle);
/* Make thread. */
thread = scm_cell (scm_tc16_thread, 0);
SCM_DEFER_INTS;
argl = scm_cons (thread, argl);
/* Note that we couldn't pass a pointer to argl as data since the
argl variable may not exist in memory when the thread starts. */
t = coop_create (scheme_launch_thread, (void *) argl);
t->data = SCM_ROOT_STATE (root);
t->handle = thread;
SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t);
scm_thread_count++;
all_threads = scm_cons (thread, all_threads);
/* Note that the following statement also could cause coop_yield.*/
SCM_ALLOW_INTS;
/* We're now ready for the thread to begin. */
coop_yield();
/* Return to old dynamic context. */
scm_dowinds (old_winds, - scm_ilength (old_winds));
}
return thread;
}
#undef FUNC_NAME
/* This is the second thread spawning mechanism: threads from C */
typedef struct c_launch_data {
union {
SCM thread;
SCM rootcont;
} u;
scm_t_catch_body body;
void *body_data;
scm_t_catch_handler handler;
void *handler_data;
} c_launch_data;
static SCM
c_body_bootstrip (c_launch_data* data)
{
/* First save the new root continuation */
data->u.rootcont = scm_root->rootcont;
return (data->body) (data->body_data);
}
static SCM
c_handler_bootstrip (c_launch_data* data, SCM tag, SCM throw_args)
{
scm_root->rootcont = data->u.rootcont;
return (data->handler) (data->handler_data, tag, throw_args);
}
static void
c_launch_thread (void *p)
{
register c_launch_data *data = (c_launch_data *) p;
/* The thread object will be GC protected by being on this stack */
SCM thread = data->u.thread;
/* We must use the address of `thread', otherwise the compiler will
optimize it away. This is OK since the longest SCM_STACKITEM
also is a long. */
scm_internal_cwdr ((scm_t_catch_body) c_body_bootstrip,
data,
(scm_t_catch_handler) c_handler_bootstrip,
data,
(SCM_STACKITEM *) &thread);
scm_thread_count--;
free ((char *) data);
}
SCM
scm_spawn_thread (scm_t_catch_body body, void *body_data,
scm_t_catch_handler handler, void *handler_data)
{
SCM thread;
coop_t *t;
SCM root, old_winds;
c_launch_data *data = (c_launch_data *) scm_malloc (sizeof (*data));
/* Unwind wind chain. */
old_winds = scm_dynwinds;
scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds));
/* Allocate thread locals. */
root = scm_make_root (scm_root->handle);
/* Make thread. */
thread = scm_cell (scm_tc16_thread, 0);
SCM_DEFER_INTS;
data->u.thread = thread;
data->body = body;
data->body_data = body_data;
data->handler = handler;
data->handler_data = handler_data;
t = coop_create (c_launch_thread, (void *) data);
t->data = SCM_ROOT_STATE (root);
t->handle = thread;
SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t);
scm_thread_count++;
all_threads = scm_cons (thread, all_threads);
/* Note that the following statement also could cause coop_yield.*/
SCM_ALLOW_INTS;
/* We're now ready for the thread to begin. */
coop_yield();
/* Return to old dynamic context. */
scm_dowinds (old_winds, - scm_ilength (old_winds));
return thread;
}
SCM
scm_current_thread (void)
{
return coop_global_curr->handle;
}
SCM
scm_all_threads (void)
{
return all_threads;
}
scm_root_state *
scm_i_thread_root (SCM thread)
{
return (scm_root_state *)((coop_t *)SCM_THREAD_DATA (thread))->data;
}
SCM
scm_join_thread (SCM thread)
#define FUNC_NAME s_join_thread
{
coop_t *thread_data;
SCM_VALIDATE_THREAD (1, thread);
/* Dirk:FIXME:: SCM_THREAD_DATA is a handle for a thread. It may be that a
* certain thread implementation uses a value of 0 as a valid thread handle.
* With the following code, this thread would always be considered finished.
*/
/* Dirk:FIXME:: With preemptive threading, a thread may finish immediately
* after SCM_THREAD_DATA is read. Thus, it must be guaranteed that the
* handle remains valid until the thread-object is garbage collected, or
* a mutex has to be used for reading and modifying SCM_THREAD_DATA.
*/
thread_data = SCM_THREAD_DATA (thread);
if (thread_data)
/* The thread is still alive */
coop_join (thread_data);
/* XXX - return real result. */
return SCM_BOOL_T;
}
#undef FUNC_NAME
int
scm_c_thread_exited_p (SCM thread)
#define FUNC_NAME s_scm_thread_exited_p
{
SCM_VALIDATE_THREAD (1, thread);
return SCM_THREAD_DATA (thread) != NULL;
}
#undef FUNC_NAME
SCM
scm_yield (void)
{
/* Yield early */
scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
coop_yield();
return SCM_BOOL_T;
}
SCM
scm_single_thread_p (void)
{
return (coop_global_runq.tail == &coop_global_runq.t
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM
scm_make_mutex (void)
{
SCM m = scm_make_smob (scm_tc16_mutex);
coop_mutex_init (SCM_MUTEX_DATA (m));
return m;
}
SCM
scm_lock_mutex (SCM m)
{
SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
coop_mutex_lock (SCM_MUTEX_DATA (m));
return SCM_BOOL_T;
}
SCM
scm_try_mutex (SCM m)
{
SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
return scm_from_bool (coop_mutex_trylock (SCM_MUTEX_DATA (m)));
}
SCM
scm_unlock_mutex (SCM m)
{
SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
coop_mutex_unlock(SCM_MUTEX_DATA (m));
/* Yield early */
scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
coop_yield();
return SCM_BOOL_T;
}
SCM
scm_make_condition_variable (void)
{
SCM c = scm_make_smob (scm_tc16_condvar);
coop_condition_variable_init (SCM_CONDVAR_DATA (c));
return c;
}
SCM
scm_timed_wait_condition_variable (SCM c, SCM m, SCM t)
#define FUNC_NAME s_wait_condition_variable
{
coop_c *cv;
coop_m *mx;
scm_t_timespec waittime;
SCM_ASSERT (SCM_CONDVARP (c),
c,
SCM_ARG1,
s_wait_condition_variable);
SCM_ASSERT (SCM_MUTEXP (m),
m,
SCM_ARG2,
s_wait_condition_variable);
cv = SCM_CONDVAR_DATA (c);
mx = SCM_MUTEX_DATA (m);
if (!SCM_UNBNDP (t))
{
if (SCM_CONSP (t))
{
SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_nsec);
waittime.tv_nsec *= 1000;
}
else
{
SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec);
waittime.tv_nsec = 0;
}
return scm_from_bool(
coop_condition_variable_timed_wait_mutex (cv, mx, &waittime));
}
else
{
coop_condition_variable_wait_mutex (cv, mx);
return SCM_BOOL_T;
}
}
#undef FUNC_NAME
SCM
scm_signal_condition_variable (SCM c)
{
SCM_ASSERT (SCM_CONDVARP (c),
c,
SCM_ARG1,
s_signal_condition_variable);
coop_condition_variable_signal (SCM_CONDVAR_DATA (c));
return SCM_BOOL_T;
}
SCM
scm_broadcast_condition_variable (SCM c)
{
SCM_ASSERT (SCM_CONDVARP (c),
c,
SCM_ARG1,
s_broadcast_condition_variable);
coop_condition_variable_broadcast (SCM_CONDVAR_DATA (c));
return SCM_BOOL_T;
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/

12
libguile/debug.c
View file

@ -422,18 +422,18 @@ SCM_REGISTER_PROC (s_reverse_lookup, "reverse-lookup", 2, 0, 0, scm_reverse_look
SCM
scm_reverse_lookup (SCM env, SCM data)
{
while (SCM_CONSP (env) && SCM_CONSP (SCM_CAR (env)))
while (scm_is_pair (env) && scm_is_pair (SCM_CAR (env)))
{
SCM names = SCM_CAAR (env);
SCM values = SCM_CDAR (env);
while (SCM_CONSP (names))
while (scm_is_pair (names))
{
if (scm_is_eq (SCM_CAR (values), data))
return SCM_CAR (names);
names = SCM_CDR (names);
values = SCM_CDR (values);
}
if (!SCM_NULLP (names) && scm_is_eq (values, data))
if (!scm_is_null (names) && scm_is_eq (values, data))
return names;
env = SCM_CDR (env);
}
@ -463,9 +463,9 @@ scm_m_start_stack (SCM exp, SCM env)
#define FUNC_NAME s_start_stack
{
exp = SCM_CDR (exp);
if (!SCM_CONSP (exp)
|| !SCM_CONSP (SCM_CDR (exp))
|| !SCM_NULLP (SCM_CDDR (exp)))
if (!scm_is_pair (exp)
|| !scm_is_pair (SCM_CDR (exp))
|| !scm_is_null (SCM_CDDR (exp)))
SCM_WRONG_NUM_ARGS ();
return scm_start_stack (scm_eval_car (exp, env), SCM_CADR (exp), env);
}

10
libguile/deprecated.c
View file

@ -317,7 +317,7 @@ maybe_close_port (void *data, SCM port)
{
SCM except = (SCM)data;
while (!SCM_NULLP (except))
while (!scm_is_null (except))
{
SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except));
if (scm_is_eq (p, port))
@ -341,7 +341,7 @@ SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1,
SCM p;
SCM_VALIDATE_REST_ARGUMENT (ports);
for (p = ports; !SCM_NULLP (p); p = SCM_CDR (p))
for (p = ports; !scm_is_null (p); p = SCM_CDR (p))
SCM_VALIDATE_OPPORT (SCM_ARG1, SCM_COERCE_OUTPORT (SCM_CAR (p)));
scm_c_port_for_each (maybe_close_port, ports);
@ -445,7 +445,7 @@ SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0,
scm_c_issue_deprecation_warning
("'sloppy-memq' is deprecated. Use 'memq' instead.");
for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
for(; scm_is_pair (lst); lst = SCM_CDR(lst))
{
if (scm_is_eq (SCM_CAR (lst), x))
return lst;
@ -465,7 +465,7 @@ SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0,
scm_c_issue_deprecation_warning
("'sloppy-memv' is deprecated. Use 'memv' instead.");
for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
for(; scm_is_pair (lst); lst = SCM_CDR(lst))
{
if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x)))
return lst;
@ -485,7 +485,7 @@ SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0,
scm_c_issue_deprecation_warning
("'sloppy-member' is deprecated. Use 'member' instead.");
for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
for(; scm_is_pair (lst); lst = SCM_CDR(lst))
{
if (! scm_is_false (scm_equal_p (SCM_CAR (lst), x)))
return lst;

2
libguile/deprecation.c
View file

@ -106,7 +106,7 @@ SCM_DEFINE(scm_issue_deprecation_warning,
SCM nl = scm_from_locale_string ("\n");
SCM msgs_nl = SCM_EOL;
char *c_msgs;
while (SCM_CONSP (msgs))
while (scm_is_pair (msgs))
{
if (msgs_nl != SCM_EOL)
msgs_nl = scm_cons (nl, msgs_nl);

6
libguile/dynwind.c
View file

@ -164,7 +164,7 @@ scm_frame_end (void)
encounter #<winder> entries on the way.
*/
while (SCM_CONSP (scm_dynwinds))
while (scm_is_pair (scm_dynwinds))
{
SCM entry = SCM_CAR (scm_dynwinds);
scm_dynwinds = SCM_CDR (scm_dynwinds);
@ -308,7 +308,7 @@ scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data)
/* key = #t | symbol | thunk | list of variables */
if (SCM_NIMP (wind_key))
{
if (SCM_CONSP (wind_key))
if (scm_is_pair (wind_key))
{
if (SCM_VARIABLEP (SCM_CAR (wind_key)))
scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
@ -342,7 +342,7 @@ scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data)
wind_key = SCM_CAR (wind_elt);
if (SCM_NIMP (wind_key))
{
if (SCM_CONSP (wind_key))
if (scm_is_pair (wind_key))
{
if (SCM_VARIABLEP (SCM_CAR (wind_key)))
scm_swap_bindings (wind_key, SCM_CDR (wind_elt));

66
libguile/environments.c
View file

@ -531,7 +531,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
SCM slot;
for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash];
!SCM_NULLP (lsym);
!scm_is_null (lsym);
lsym = SCM_CDR (lsym))
{
SCM old_entry = SCM_CAR (lsym);
@ -561,7 +561,7 @@ obarray_retrieve (SCM obarray, SCM sym)
SCM lsym;
for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash];
!SCM_NULLP (lsym);
!scm_is_null (lsym);
lsym = SCM_CDR (lsym))
{
SCM entry = SCM_CAR (lsym);
@ -584,7 +584,7 @@ obarray_remove (SCM obarray, SCM sym)
SCM table_entry = SCM_HASHTABLE_BUCKETS (obarray)[hash];
SCM handle = scm_sloppy_assq (sym, table_entry);
if (SCM_CONSP (handle))
if (scm_is_pair (handle))
{
SCM new_table_entry = scm_delq1_x (handle, table_entry);
SCM_SET_HASHTABLE_BUCKET (obarray, hash, new_table_entry);
@ -675,7 +675,7 @@ core_environments_unobserve (SCM env, SCM observer)
? CORE_ENVIRONMENT_WEAK_OBSERVERS (env)
: CORE_ENVIRONMENT_OBSERVERS (env);
if (!SCM_NULLP (l))
if (!scm_is_null (l))
{
SCM rest = SCM_CDR (l);
SCM first = handling_weaks
@ -694,7 +694,7 @@ core_environments_unobserve (SCM env, SCM observer)
do {
SCM rest = SCM_CDR (l);
if (!SCM_NULLP (rest))
if (!scm_is_null (rest))
{
SCM next = handling_weaks
? SCM_CDAR (l)
@ -708,7 +708,7 @@ core_environments_unobserve (SCM env, SCM observer)
}
l = rest;
} while (!SCM_NULLP (l));
} while (!scm_is_null (l));
}
}
@ -807,7 +807,7 @@ core_environments_broadcast (SCM env)
? CORE_ENVIRONMENT_WEAK_OBSERVERS (env)
: CORE_ENVIRONMENT_OBSERVERS (env);
for (; !SCM_NULLP (observers); observers = SCM_CDR (observers))
for (; !scm_is_null (observers); observers = SCM_CDR (observers))
{
struct update_data data;
SCM observer = handling_weaks
@ -827,7 +827,7 @@ core_environments_broadcast (SCM env)
}
}
if (!SCM_NULLP (errors))
if (!scm_is_null (errors))
{
/* Dirk:FIXME:: As soon as scm_misc_error is fixed to handle the name
* parameter correctly it should not be necessary any more to also pass
@ -888,7 +888,7 @@ leaf_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init)
{
SCM l;
for (l = SCM_HASHTABLE_BUCKETS (obarray)[i];
!SCM_NULLP (l);
!scm_is_null (l);
l = SCM_CDR (l))
{
SCM binding = SCM_CAR (l);
@ -1114,7 +1114,7 @@ eval_environment_lookup (SCM env, SCM sym, int for_write)
SCM entry = SCM_CDR (binding);
if (SCM_CONSP (entry))
if (scm_is_pair (entry))
{
/* The entry in the obarray is a cached location. */
@ -1133,7 +1133,7 @@ eval_environment_lookup (SCM env, SCM sym, int for_write)
SCM source_env = CACHED_SOURCE_ENVIRONMENT (entry);
SCM location = SCM_ENVIRONMENT_CELL (source_env, sym, 1);
if (SCM_CONSP (location))
if (scm_is_pair (location))
{
SET_CACHED_MUTABILITY (entry, MUTABLE);
return location;
@ -1173,7 +1173,7 @@ eval_environment_lookup (SCM env, SCM sym, int for_write)
if (!SCM_UNBNDP (location))
{
if (SCM_CONSP (location))
if (scm_is_pair (location))
{
SCM mutability = for_write ? MUTABLE : UNKNOWN;
SCM entry = scm_cons2 (location, mutability, source_env);
@ -1203,7 +1203,7 @@ eval_environment_ref (SCM env, SCM sym)
{
SCM location = eval_environment_lookup (env, sym, 0);
if (SCM_CONSP (location))
if (scm_is_pair (location))
return SCM_CDR (location);
else if (!SCM_UNBNDP (location))
return SCM_ENVIRONMENT_REF (location, sym);
@ -1273,7 +1273,7 @@ eval_environment_set_x (SCM env, SCM sym, SCM val)
{
SCM location = eval_environment_lookup (env, sym, 1);
if (SCM_CONSP (location))
if (scm_is_pair (location))
{
SCM_SETCDR (location, val);
return SCM_ENVIRONMENT_SUCCESS;
@ -1300,7 +1300,7 @@ eval_environment_cell (SCM env, SCM sym, int for_write)
{
SCM location = eval_environment_lookup (env, sym, for_write);
if (SCM_CONSP (location))
if (scm_is_pair (location))
return location;
else if (SCM_ENVIRONMENT_P (location))
return SCM_ENVIRONMENT_LOCATION_NO_CELL;
@ -1559,7 +1559,7 @@ import_environment_lookup (SCM env, SCM sym)
SCM result = SCM_UNDEFINED;
SCM l;
for (l = imports; !SCM_NULLP (l); l = SCM_CDR (l))
for (l = imports; !scm_is_null (l); l = SCM_CDR (l))
{
SCM imported = SCM_CAR (l);
@ -1567,14 +1567,14 @@ import_environment_lookup (SCM env, SCM sym)
{
if (SCM_UNBNDP (result))
result = imported;
else if (SCM_CONSP (result))
else if (scm_is_pair (result))
result = scm_cons (imported, result);
else
result = scm_cons2 (imported, result, SCM_EOL);
}
}
if (SCM_CONSP (result))
if (scm_is_pair (result))
return scm_reverse (result);
else
return result;
@ -1601,7 +1601,7 @@ import_environment_ref (SCM env, SCM sym)
{
return SCM_UNDEFINED;
}
else if (SCM_CONSP (owner))
else if (scm_is_pair (owner))
{
SCM resolve = import_environment_conflict (env, sym, owner);
@ -1630,7 +1630,7 @@ import_environment_folder (SCM extended_data, SCM symbol, SCM value, SCM tail)
scm_environment_folder proc = (scm_environment_folder) proc_as_ul;
SCM data = SCM_CDDDR (extended_data);
if (SCM_CONSP (owner) && scm_is_eq (SCM_CAR (owner), imported_env))
if (scm_is_pair (owner) && scm_is_eq (SCM_CAR (owner), imported_env))
owner = import_environment_conflict (import_env, symbol, owner);
if (SCM_ENVIRONMENT_P (owner))
@ -1648,7 +1648,7 @@ import_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM ini
SCM result = init;
SCM l;
for (l = IMPORT_ENVIRONMENT (env)->imports; !SCM_NULLP (l); l = SCM_CDR (l))
for (l = IMPORT_ENVIRONMENT (env)->imports; !scm_is_null (l); l = SCM_CDR (l))
{
SCM imported_env = SCM_CAR (l);
SCM extended_data = scm_cons (env, scm_cons2 (imported_env, proc_as_nr, data));
@ -1691,7 +1691,7 @@ import_environment_set_x (SCM env, SCM sym, SCM val)
{
return SCM_UNDEFINED;
}
else if (SCM_CONSP (owner))
else if (scm_is_pair (owner))
{
SCM resolve = import_environment_conflict (env, sym, owner);
@ -1718,7 +1718,7 @@ import_environment_cell (SCM env, SCM sym, int for_write)
{
return SCM_UNDEFINED;
}
else if (SCM_CONSP (owner))
else if (scm_is_pair (owner))
{
SCM resolve = import_environment_conflict (env, sym, owner);
@ -1881,20 +1881,20 @@ SCM_DEFINE (scm_import_environment_set_imports_x, "import-environment-set-import
SCM l;
SCM_ASSERT (SCM_IMPORT_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
for (l = imports; SCM_CONSP (l); l = SCM_CDR (l))
for (l = imports; scm_is_pair (l); l = SCM_CDR (l))
{
SCM obj = SCM_CAR (l);
SCM_ASSERT (SCM_ENVIRONMENT_P (obj), imports, SCM_ARG2, FUNC_NAME);
}
SCM_ASSERT (SCM_NULLP (l), imports, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_null (l), imports, SCM_ARG2, FUNC_NAME);
for (l = body->import_observers; !SCM_NULLP (l); l = SCM_CDR (l))
for (l = body->import_observers; !scm_is_null (l); l = SCM_CDR (l))
{
SCM obs = SCM_CAR (l);
SCM_ENVIRONMENT_UNOBSERVE (env, obs);
}
for (l = imports; !SCM_NULLP (l); l = SCM_CDR (l))
for (l = imports; !scm_is_null (l); l = SCM_CDR (l))
{
SCM imp = SCM_CAR (l);
SCM obs = SCM_ENVIRONMENT_OBSERVE (imp, import_environment_observer, env, 1);
@ -1962,7 +1962,7 @@ export_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM ini
SCM result = init;
SCM l;
for (l = body->signature; !SCM_NULLP (l); l = SCM_CDR (l))
for (l = body->signature; !scm_is_null (l); l = SCM_CDR (l))
{
SCM symbol = SCM_CAR (l);
SCM value = SCM_ENVIRONMENT_REF (body->private, symbol);
@ -2235,7 +2235,7 @@ export_environment_parse_signature (SCM signature, const char* caller)
SCM result = SCM_EOL;
SCM l;
for (l = signature; SCM_CONSP (l); l = SCM_CDR (l))
for (l = signature; scm_is_pair (l); l = SCM_CDR (l))
{
SCM entry = SCM_CAR (l);
@ -2253,12 +2253,12 @@ export_environment_parse_signature (SCM signature, const char* caller)
SCM mutability;
SCM l2;
SCM_ASSERT (SCM_CONSP (entry), entry, SCM_ARGn, caller);
SCM_ASSERT (scm_is_pair (entry), entry, SCM_ARGn, caller);
SCM_ASSERT (scm_is_symbol (SCM_CAR (entry)), entry, SCM_ARGn, caller);
sym = SCM_CAR (entry);
for (l2 = SCM_CDR (entry); SCM_CONSP (l2); l2 = SCM_CDR (l2))
for (l2 = SCM_CDR (entry); scm_is_pair (l2); l2 = SCM_CDR (l2))
{
SCM attribute = SCM_CAR (l2);
if (scm_is_eq (attribute, symbol_immutable_location))
@ -2268,7 +2268,7 @@ export_environment_parse_signature (SCM signature, const char* caller)
else
SCM_ASSERT (0, entry, SCM_ARGn, caller);
}
SCM_ASSERT (SCM_NULLP (l2), entry, SCM_ARGn, caller);
SCM_ASSERT (scm_is_null (l2), entry, SCM_ARGn, caller);
SCM_ASSERT (!mutable || !immutable, entry, SCM_ARGn, caller);
if (!mutable && !immutable)
@ -2279,7 +2279,7 @@ export_environment_parse_signature (SCM signature, const char* caller)
result = scm_cons (new_entry, result);
}
}
SCM_ASSERT (SCM_NULLP (l), signature, SCM_ARGn, caller);
SCM_ASSERT (scm_is_null (l), signature, SCM_ARGn, caller);
/* Dirk:FIXME:: Now we know that signature is syntactically correct. There
* are, however, no checks for symbols entered twice with contradicting

2
libguile/eq.c
View file

@ -147,7 +147,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
return SCM_BOOL_F;
if (SCM_IMP (y))
return SCM_BOOL_F;
if (SCM_CONSP (x) && SCM_CONSP (y))
if (scm_is_pair (x) && scm_is_pair (y))
{
if (scm_is_false (scm_equal_p (SCM_CAR (x), SCM_CAR (y))))
return SCM_BOOL_F;

8
libguile/evalext.c
View file

@ -47,14 +47,14 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
register SCM b;
for (; SCM_NIMP (frames); frames = SCM_CDR (frames))
{
SCM_ASSERT (SCM_CONSP (frames), env, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_pair (frames), env, SCM_ARG2, FUNC_NAME);
b = SCM_CAR (frames);
if (scm_is_true (scm_procedure_p (b)))
break;
SCM_ASSERT (SCM_CONSP (b), env, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_pair (b), env, SCM_ARG2, FUNC_NAME);
for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b))
{
if (!SCM_CONSP (b))
if (!scm_is_pair (b))
{
if (scm_is_eq (b, sym))
return SCM_BOOL_T;
@ -93,7 +93,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
return SCM_BOOL_T;
case scm_tc3_imm24:
/* characters, booleans, other immediates */
return scm_from_bool (!SCM_NULLP (obj));
return scm_from_bool (!scm_is_null (obj));
case scm_tc3_cons:
switch (SCM_TYP7 (obj))
{

2
libguile/filesys.c
View file

@ -1225,7 +1225,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
/* if there's a port with a ready buffer, don't block, just
check for ready file descriptors. */
if (!SCM_NULLP (read_ports_ready) || !SCM_NULLP (write_ports_ready))
if (!scm_is_null (read_ports_ready) || !scm_is_null (write_ports_ready))
{
timeout.tv_sec = 0;
timeout.tv_usec = 0;

16
libguile/futures.c
View file

@ -55,7 +55,7 @@ static SCM
count (SCM ls)
{
int n = 0;
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
++n;
ls = SCM_FUTURE_NEXT (ls);
@ -169,9 +169,9 @@ scm_i_make_future (SCM thunk)
scm_mutex_lock (&future_admin_mutex);
while (1)
{
if (!SCM_NULLP (old))
if (!scm_is_null (old))
UNLINK (old, future);
else if (!SCM_NULLP (young))
else if (!scm_is_null (young))
UNLINK (young, future);
else
{
@ -244,7 +244,7 @@ SCM_DEFINE (scm_future_ref, "future-ref", 1, 0, 0,
static void
kill_futures (SCM victims)
{
while (!SCM_NULLP (victims))
while (!scm_is_null (victims))
{
SCM future;
UNLINK (victims, future);
@ -257,7 +257,7 @@ static void
cleanup_undead ()
{
SCM next = undead, *nextloc = &undead;
while (!SCM_NULLP (next))
while (!scm_is_null (next))
{
if (scm_mutex_trylock (SCM_FUTURE_MUTEX (next)))
goto next;
@ -284,7 +284,7 @@ cleanup_undead ()
static void
mark_futures (SCM futures)
{
while (!SCM_NULLP (futures))
while (!scm_is_null (futures))
{
SCM_SET_GC_MARK (futures);
futures = SCM_FUTURE_NEXT (futures);
@ -310,7 +310,7 @@ scan_futures (void *dummy1, void *dummy2, void *dummy3)
next = futures;
nextloc = &futures;
while (!SCM_NULLP (next))
while (!scm_is_null (next))
{
if (!SCM_GC_MARK_P (next))
goto free;
@ -319,7 +319,7 @@ scan_futures (void *dummy1, void *dummy2, void *dummy3)
next = *nextloc;
}
goto exit;
while (!SCM_NULLP (next))
while (!scm_is_null (next))
{
if (SCM_GC_MARK_P (next))
{

6
libguile/gc-mark.c
View file

@ -87,7 +87,7 @@ scm_mark_all (void)
for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (scm_gc_registered_roots); ++i)
{
SCM l = SCM_HASHTABLE_BUCKETS (scm_gc_registered_roots)[i];
for (; !SCM_NULLP (l); l = SCM_CDR (l))
for (; !scm_is_null (l); l = SCM_CDR (l))
{
SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l)));
scm_gc_mark (*p);
@ -300,9 +300,9 @@ scm_gc_mark_dependencies (SCM p)
/* mark everything on the alist except the keys or
* values, according to weak_values and weak_keys. */
while ( SCM_CONSP (alist)
while ( scm_is_pair (alist)
&& !SCM_GC_MARK_P (alist)
&& SCM_CONSP (SCM_CAR (alist)))
&& scm_is_pair (SCM_CAR (alist)))
{
SCM kvpair;
SCM next_alist;

4
libguile/gc.c
View file

@ -512,9 +512,9 @@ scm_igc (const char *what)
fprintf (stderr,"gc reason %s\n", what);
fprintf (stderr,
SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist))
scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist))
? "*"
: (SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
: (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
#endif
/* During the critical section, only the current thread may run. */

76
libguile/goops.c
View file

@ -159,14 +159,14 @@ static SCM scm_sys_goops_loaded (void);
static SCM
map (SCM (*proc) (SCM), SCM ls)
{
if (SCM_NULLP (ls))
if (scm_is_null (ls))
return ls;
else
{
SCM res = scm_cons (proc (SCM_CAR (ls)), SCM_EOL);
SCM h = res;
ls = SCM_CDR (ls);
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
SCM_SETCDR (h, scm_cons (proc (SCM_CAR (ls)), SCM_EOL));
h = SCM_CDR (h);
@ -180,7 +180,7 @@ static SCM
filter_cpl (SCM ls)
{
SCM res = SCM_EOL;
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
SCM el = SCM_CAR (ls);
if (scm_is_false (scm_c_memq (el, res)))
@ -215,7 +215,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen)
{
SCM tmp;
if (SCM_NULLP (l))
if (scm_is_null (l))
return res;
tmp = SCM_CAAR (l);
@ -235,7 +235,7 @@ build_slots_list (SCM dslots, SCM cpl)
{
register SCM res = dslots;
for (cpl = SCM_CDR (cpl); !SCM_NULLP (cpl); cpl = SCM_CDR (cpl))
for (cpl = SCM_CDR (cpl); !scm_is_null (cpl); cpl = SCM_CDR (cpl))
res = scm_append (scm_list_2 (SCM_SLOT (SCM_CAR (cpl),
scm_si_direct_slots),
res));
@ -248,9 +248,9 @@ static SCM
maplist (SCM ls)
{
SCM orig = ls;
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
if (!SCM_CONSP (SCM_CAR (ls)))
if (!scm_is_pair (SCM_CAR (ls)))
SCM_SETCAR (ls, scm_cons (SCM_CAR (ls), SCM_EOL));
ls = SCM_CDR (ls);
}
@ -291,11 +291,11 @@ compute_getters_n_setters (SCM slots)
SCM *cdrloc = &res;
long i = 0;
for ( ; !SCM_NULLP (slots); slots = SCM_CDR (slots))
for ( ; !scm_is_null (slots); slots = SCM_CDR (slots))
{
SCM init = SCM_BOOL_F;
SCM options = SCM_CDAR (slots);
if (!SCM_NULLP (options))
if (!scm_is_null (options))
{
init = scm_get_keyword (k_init_value, options, 0);
if (init)
@ -392,13 +392,13 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
/* See for each slot how it must be initialized */
for (;
!SCM_NULLP (slots);
!scm_is_null (slots);
get_n_set = SCM_CDR (get_n_set), slots = SCM_CDR (slots))
{
SCM slot_name = SCM_CAR (slots);
SCM slot_value = 0;
if (!SCM_NULLP (SCM_CDR (slot_name)))
if (!scm_is_null (SCM_CDR (slot_name)))
{
/* This slot admits (perhaps) to be initialized at creation time */
long n = scm_ilength (SCM_CDR (slot_name));
@ -456,9 +456,9 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
*/
#define SCM_GNS_INSTANCE_ALLOCATED_P(gns) \
(SCM_I_INUMP (SCM_CDDR (gns)) \
|| (SCM_CONSP (SCM_CDDR (gns)) \
&& SCM_CONSP (SCM_CDDDR (gns)) \
&& SCM_CONSP (SCM_CDDDDR (gns))))
|| (scm_is_pair (SCM_CDDR (gns)) \
&& scm_is_pair (SCM_CDDDR (gns)) \
&& scm_is_pair (SCM_CDDDDR (gns))))
#define SCM_GNS_INDEX(gns) \
(SCM_I_INUMP (SCM_CDDR (gns)) \
? SCM_I_INUM (SCM_CDDR (gns)) \
@ -497,7 +497,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
layout = scm_i_make_string (n, &s);
i = 0;
while (SCM_CONSP (getters_n_setters))
while (scm_is_pair (getters_n_setters))
{
if (SCM_GNS_INSTANCE_ALLOCATED_P (SCM_CAR (getters_n_setters)))
{
@ -505,7 +505,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
int len, index, size;
char p, a;
if (i >= n || !SCM_CONSP (slots))
if (i >= n || !scm_is_pair (slots))
goto inconsistent;
/* extract slot type */
@ -559,7 +559,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
slots = SCM_CDR (slots);
getters_n_setters = SCM_CDR (getters_n_setters);
}
if (!SCM_NULLP (slots))
if (!scm_is_null (slots))
{
inconsistent:
SCM_MISC_ERROR ("inconsistent getters-n-setters", SCM_EOL);
@ -579,9 +579,9 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0,
SCM ls = dsupers;
long flags = 0;
SCM_VALIDATE_INSTANCE (1, class);
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
SCM_ASSERT (SCM_CONSP (ls)
SCM_ASSERT (scm_is_pair (ls)
&& SCM_INSTANCEP (SCM_CAR (ls)),
dsupers,
SCM_ARG2,
@ -661,7 +661,7 @@ scm_basic_basic_make_class (SCM class, SCM name, SCM dsupers, SCM dslots)
/* Add this class in the direct-subclasses slot of dsupers */
{
SCM tmp;
for (tmp = dsupers; !SCM_NULLP (tmp); tmp = SCM_CDR (tmp))
for (tmp = dsupers; !scm_is_null (tmp); tmp = SCM_CDR (tmp))
SCM_SET_SLOT (SCM_CAR (tmp), scm_si_direct_subclasses,
scm_cons (z, SCM_SLOT (SCM_CAR (tmp),
scm_si_direct_subclasses)));
@ -926,7 +926,7 @@ SCM fold_downward_gf_methods (SCM method_lists, SCM gf)
{
SCM gfs = scm_slot_ref (gf, sym_extended_by);
method_lists = scm_cons (scm_slot_ref (gf, sym_methods), method_lists);
while (!SCM_NULLP (gfs))
while (!scm_is_null (gfs))
{
method_lists = fold_downward_gf_methods (method_lists, SCM_CAR (gfs));
gfs = SCM_CDR (gfs);
@ -940,7 +940,7 @@ SCM fold_upward_gf_methods (SCM method_lists, SCM gf)
if (SCM_IS_A_P (gf, scm_class_extended_generic))
{
SCM gfs = scm_slot_ref (gf, sym_extends);
while (!SCM_NULLP (gfs))
while (!scm_is_null (gfs))
{
SCM methods = scm_slot_ref (SCM_CAR (gfs), sym_methods);
method_lists = fold_upward_gf_methods (scm_cons (methods,
@ -1110,7 +1110,7 @@ static SCM
slot_definition_using_name (SCM class, SCM slot_name)
{
register SCM slots = SCM_SLOT (class, scm_si_getters_n_setters);
for (; !SCM_NULLP (slots); slots = SCM_CDR (slots))
for (; !scm_is_null (slots); slots = SCM_CDR (slots))
if (SCM_CAAR (slots) == slot_name)
return SCM_CAR (slots);
return SCM_BOOL_F;
@ -1205,7 +1205,7 @@ test_slot_existence (SCM class SCM_UNUSED, SCM obj, SCM slot_name)
{
register SCM l;
for (l = SCM_ACCESSORS_OF (obj); !SCM_NULLP (l); l = SCM_CDR (l))
for (l = SCM_ACCESSORS_OF (obj); !scm_is_null (l); l = SCM_CDR (l))
if (scm_is_eq (SCM_CAAR (l), slot_name))
return SCM_BOOL_T;
@ -1647,10 +1647,10 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0
if (scm_is_true (used_by))
{
SCM methods = SCM_SLOT (gf, scm_si_methods);
for (; SCM_CONSP (used_by); used_by = SCM_CDR (used_by))
for (; scm_is_pair (used_by); used_by = SCM_CDR (used_by))
scm_sys_invalidate_method_cache_x (SCM_CAR (used_by));
clear_method_cache (gf);
for (; SCM_CONSP (methods); methods = SCM_CDR (methods))
for (; scm_is_pair (methods); methods = SCM_CDR (methods))
SCM_SET_SLOT (SCM_CAR (methods), scm_si_code_table, SCM_EOL);
}
{
@ -1681,7 +1681,7 @@ SCM_DEFINE (scm_enable_primitive_generic_x, "enable-primitive-generic!", 0, 0, 1
#define FUNC_NAME s_scm_enable_primitive_generic_x
{
SCM_VALIDATE_REST_ARGUMENT (subrs);
while (!SCM_NULLP (subrs))
while (!scm_is_null (subrs))
{
SCM subr = SCM_CAR (subrs);
SCM_ASSERT (scm_subr_p (subr) && SCM_SUBR_GENERIC (subr),
@ -1810,8 +1810,8 @@ more_specificp (SCM m1, SCM m2, SCM const *targs)
*
*/
for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) {
if (SCM_NULLP(s1)) return 1;
if (SCM_NULLP(s2)) return 0;
if (scm_is_null(s1)) return 1;
if (scm_is_null(s2)) return 0;
if (SCM_CAR(s1) != SCM_CAR(s2)) {
register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2);
@ -1940,29 +1940,29 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
else
types = p = buffer;
for ( ; !SCM_NULLP (args); args = SCM_CDR (args))
for ( ; !scm_is_null (args); args = SCM_CDR (args))
*p++ = scm_class_of (SCM_CAR (args));
/* Build a list of all applicable methods */
for (l = scm_generic_function_methods (gf); !SCM_NULLP (l); l = SCM_CDR (l))
for (l = scm_generic_function_methods (gf); !scm_is_null (l); l = SCM_CDR (l))
{
fl = SPEC_OF (SCM_CAR (l));
/* Only accept accessors which match exactly in first arg. */
if (SCM_ACCESSORP (SCM_CAR (l))
&& (SCM_NULLP (fl) || types[0] != SCM_CAR (fl)))
&& (scm_is_null (fl) || types[0] != SCM_CAR (fl)))
continue;
for (i = 0; ; i++, fl = SCM_CDR (fl))
{
if (SCM_INSTANCEP (fl)
/* We have a dotted argument list */
|| (i >= len && SCM_NULLP (fl)))
|| (i >= len && scm_is_null (fl)))
{ /* both list exhausted */
applicable = scm_cons (SCM_CAR (l), applicable);
count += 1;
break;
}
if (i >= len
|| SCM_NULLP (fl)
|| scm_is_null (fl)
|| !applicablep (types[i], SCM_CAR (fl)))
break;
}
@ -2166,7 +2166,7 @@ SCM_DEFINE (scm_find_method, "find-method", 0, 0, 1,
gf = SCM_CAR(l); l = SCM_CDR(l);
SCM_VALIDATE_GENERIC (1, gf);
if (SCM_NULLP (SCM_SLOT (gf, scm_si_methods)))
if (scm_is_null (SCM_SLOT (gf, scm_si_methods)))
SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf));
return scm_compute_applicable_methods (gf, l, len - 1, 1);
@ -2188,7 +2188,7 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0,
/* Verify that all the arguments of targs are classes and place them in a vector*/
v = scm_c_make_vector (len, SCM_EOL);
for (i = 0, l = targs; !SCM_NULLP (l); i++, l = SCM_CDR (l)) {
for (i = 0, l = targs; !scm_is_null (l); i++, l = SCM_CDR (l)) {
SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME);
SCM_VECTOR_SET (v, i, SCM_CAR(l));
}
@ -2232,7 +2232,7 @@ make_stdcls (SCM *var, char *name, SCM meta, SCM super, SCM slots)
*var = scm_permanent_object (scm_basic_make_class (meta,
tmp,
SCM_CONSP (super)
scm_is_pair (super)
? super
: scm_list_1 (super),
slots));
@ -2627,7 +2627,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
{
SCM name, class;
name = scm_from_locale_symbol (s_name);
if (SCM_NULLP (supers))
if (scm_is_null (supers))
supers = scm_list_1 (scm_class_foreign_object);
class = scm_basic_basic_make_class (meta, name, supers, SCM_EOL);
scm_sys_inherit_magic_x (class, supers);

4
libguile/gsubr.c
View file

@ -197,7 +197,7 @@ scm_gsubr_apply (SCM args)
#endif
args = SCM_CDR (args);
for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
if (SCM_NULLP (args))
if (scm_is_null (args))
scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
v[i] = SCM_CAR(args);
args = SCM_CDR(args);
@ -212,7 +212,7 @@ scm_gsubr_apply (SCM args)
}
if (SCM_GSUBR_REST(typ))
v[i] = args;
else if (!SCM_NULLP (args))
else if (!scm_is_null (args))
scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
switch (n) {
case 2: return (*fcn)(v[0], v[1]);

6
libguile/guardians.c
View file

@ -494,7 +494,7 @@ mark_and_zombify (t_guardian *g)
/* Mark the cells of the live list (yes, the cells in the list, we
don't care about objects pointed to by the list cars, since we
know they are already marked). */
for (pair = g->live.head; !SCM_NULLP (pair); pair = SCM_CDR (pair))
for (pair = g->live.head; !scm_is_null (pair); pair = SCM_CDR (pair))
SCM_SET_GC_MARK (pair);
}
@ -567,7 +567,7 @@ whine_about_self_centered_zombies (void *dummy1 SCM_UNUSED,
void *dummy2 SCM_UNUSED,
void *dummy3 SCM_UNUSED)
{
if (!SCM_NULLP (self_centered_zombies))
if (!scm_is_null (self_centered_zombies))
{
SCM pair;
@ -575,7 +575,7 @@ whine_about_self_centered_zombies (void *dummy1 SCM_UNUSED,
scm_cur_errp);
scm_newline (scm_cur_errp);
for (pair = self_centered_zombies;
!SCM_NULLP (pair); pair = SCM_CDR (pair))
!scm_is_null (pair); pair = SCM_CDR (pair))
{
scm_display (SCM_CAR (pair), scm_cur_errp);
scm_newline (scm_cur_errp);

24
libguile/hashtab.c
View file

@ -165,7 +165,7 @@ scm_i_rehash (SCM table,
for (i = 0; i < old_size; ++i)
{
SCM ls = SCM_VELTS (buckets)[i], handle;
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
unsigned long h;
handle = SCM_CAR (ls);
@ -215,7 +215,7 @@ scan_weak_hashtables (void *dummy1 SCM_UNUSED,
{
SCM *next = &weak_hashtables;
SCM h = *next;
while (!SCM_NULLP (h))
while (!scm_is_null (h))
{
if (!SCM_GC_MARK_P (h))
*next = h = SCM_HASHTABLE_NEXT (h);
@ -230,7 +230,7 @@ scan_weak_hashtables (void *dummy1 SCM_UNUSED,
{
SCM *next_spine = (SCM *) &SCM_HASHTABLE_BUCKETS (h)[i];
for (alist = *next_spine;
!SCM_NULLP (alist);
!scm_is_null (alist);
alist = SCM_CDR (alist))
if ((weak_car && UNMARKED_CELL_P (SCM_CAAR (alist)))
|| (weak_cdr && UNMARKED_CELL_P (SCM_CDAR (alist))))
@ -266,7 +266,7 @@ rehash_after_gc (void *dummy1 SCM_UNUSED,
void *dummy2 SCM_UNUSED,
void *dummy3 SCM_UNUSED)
{
if (!SCM_NULLP (to_rehash))
if (!scm_is_null (to_rehash))
{
SCM first = to_rehash, last, h;
/* important to clear to_rehash here so that we don't get stuck
@ -282,7 +282,7 @@ rehash_after_gc (void *dummy1 SCM_UNUSED,
"rehash_after_gc");
last = h;
h = SCM_HASHTABLE_NEXT (h);
} while (!SCM_NULLP (h));
} while (!scm_is_null (h));
/* move tables back to weak_hashtables */
SCM_SET_HASHTABLE_NEXT (last, weak_hashtables);
weak_hashtables = first;
@ -487,7 +487,7 @@ scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned long (*hash_fn)(),
SCM (*assoc_fn)(), void * closure)
{
SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
if (SCM_CONSP (it))
if (scm_is_pair (it))
return SCM_CDR (it);
else
return dflt;
@ -912,12 +912,12 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
for (i = 0; i < n; ++i)
{
SCM ls = SCM_VELTS (buckets)[i], handle;
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
if (!SCM_CONSP (ls))
if (!scm_is_pair (ls))
scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
handle = SCM_CAR (ls);
if (!SCM_CONSP (handle))
if (!scm_is_pair (handle))
scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
ls = SCM_CDR (ls);
@ -950,12 +950,12 @@ scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table)
for (i = 0; i < n; ++i)
{
SCM ls = SCM_VELTS (buckets)[i], handle;
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
if (!SCM_CONSP (ls))
if (!scm_is_pair (ls))
scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
handle = SCM_CAR (ls);
if (!SCM_CONSP (handle))
if (!scm_is_pair (handle))
scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
fn (closure, handle);
ls = SCM_CDR (ls);

2
libguile/hooks.c
View file

@ -183,7 +183,7 @@ SCM_DEFINE (scm_hook_empty_p, "hook-empty?", 1, 0, 0,
#define FUNC_NAME s_scm_hook_empty_p
{
SCM_VALIDATE_HOOK (1, hook);
return scm_from_bool (SCM_NULLP (SCM_HOOK_PROCEDURES (hook)));
return scm_from_bool (scm_is_null (SCM_HOOK_PROCEDURES (hook)));
}
#undef FUNC_NAME

6
libguile/inline.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_INLINE_H
#define SCM_INLINE_H
/* Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
/* Copyright (C) 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
@ -75,7 +75,7 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
*/
SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist);
if (SCM_NULLP (*freelist))
if (scm_is_null (*freelist))
z = scm_gc_for_newcell (&scm_i_master_freelist, freelist);
else
{
@ -164,7 +164,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
SCM z;
SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist2);
if (SCM_NULLP (*freelist))
if (scm_is_null (*freelist))
z = scm_gc_for_newcell (&scm_i_master_freelist2, freelist);
else
{

4
libguile/lang.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_LANG_H
#define SCM_LANG_H
/* Copyright (C) 1998 Free Software Foundation, Inc.
/* Copyright (C) 1998, 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
@ -38,7 +38,7 @@ SCM_API void scm_init_lang (void);
#endif /* ! SCM_ENABLE_ELISP */
#define SCM_NULL_OR_NIL_P(x) (SCM_NULLP (x) || SCM_NILP (x))
#define SCM_NULL_OR_NIL_P(x) (scm_is_null (x) || SCM_NILP (x))
#endif /* SCM_LANG_H */

54
libguile/list.c
View file

@ -120,10 +120,10 @@ SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1,
#define FUNC_NAME s_scm_cons_star
{
SCM_VALIDATE_REST_ARGUMENT (rest);
if (!SCM_NULLP (rest))
if (!scm_is_null (rest))
{
SCM prev = arg = scm_cons (arg, rest);
while (!SCM_NULLP (SCM_CDR (rest)))
while (!scm_is_null (SCM_CDR (rest)))
{
prev = rest;
rest = SCM_CDR (rest);
@ -171,11 +171,11 @@ scm_ilength(SCM sx)
do {
if (SCM_NULL_OR_NIL_P(hare)) return i;
if (!SCM_CONSP (hare)) return -1;
if (!scm_is_pair (hare)) return -1;
hare = SCM_CDR(hare);
i++;
if (SCM_NULL_OR_NIL_P(hare)) return i;
if (!SCM_CONSP (hare)) return -1;
if (!scm_is_pair (hare)) return -1;
hare = SCM_CDR(hare);
i++;
/* For every two steps the hare takes, the tortoise takes one. */
@ -224,7 +224,7 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1,
#define FUNC_NAME s_scm_append
{
SCM_VALIDATE_REST_ARGUMENT (args);
if (SCM_NULLP (args)) {
if (scm_is_null (args)) {
return SCM_EOL;
} else {
SCM res = SCM_EOL;
@ -232,8 +232,8 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1,
SCM arg = SCM_CAR (args);
int argnum = 1;
args = SCM_CDR (args);
while (!SCM_NULLP (args)) {
while (SCM_CONSP (arg)) {
while (!scm_is_null (args)) {
while (scm_is_pair (arg)) {
*lloc = scm_cons (SCM_CAR (arg), SCM_EOL);
lloc = SCM_CDRLOC (*lloc);
arg = SCM_CDR (arg);
@ -262,7 +262,7 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1,
SCM ret, *loc;
SCM_VALIDATE_REST_ARGUMENT (lists);
if (SCM_NULLP (lists))
if (scm_is_null (lists))
return SCM_EOL;
loc = &ret;
@ -272,7 +272,7 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1,
*loc = arg;
lists = SCM_CDR (lists);
if (SCM_NULLP (lists))
if (scm_is_null (lists))
return ret;
if (!SCM_NULL_OR_NIL_P (arg))
@ -300,10 +300,10 @@ SCM_DEFINE (scm_last_pair, "last-pair", 1, 0, 0,
SCM_VALIDATE_CONS (SCM_ARG1, lst);
do {
SCM ahead = SCM_CDR(hare);
if (!SCM_CONSP (ahead)) return hare;
if (!scm_is_pair (ahead)) return hare;
hare = ahead;
ahead = SCM_CDR(hare);
if (!SCM_CONSP (ahead)) return hare;
if (!scm_is_pair (ahead)) return hare;
hare = ahead;
tortoise = SCM_CDR(tortoise);
}
@ -327,11 +327,11 @@ SCM_DEFINE (scm_reverse, "reverse", 1, 0, 0,
do {
if (SCM_NULL_OR_NIL_P(hare)) return result;
SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME);
SCM_ASSERT(scm_is_pair(hare), lst, 1, FUNC_NAME);
result = scm_cons (SCM_CAR (hare), result);
hare = SCM_CDR (hare);
if (SCM_NULL_OR_NIL_P(hare)) return result;
SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME);
SCM_ASSERT(scm_is_pair(hare), lst, 1, FUNC_NAME);
result = scm_cons (SCM_CAR (hare), result);
hare = SCM_CDR (hare);
tortoise = SCM_CDR (tortoise);
@ -384,7 +384,7 @@ SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0,
SCM lst = list;
unsigned long int i;
i = scm_to_ulong (k);
while (SCM_CONSP (lst)) {
while (scm_is_pair (lst)) {
if (i == 0)
return SCM_CAR (lst);
else {
@ -407,7 +407,7 @@ SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0,
{
SCM lst = list;
unsigned long int i = scm_to_ulong (k);
while (SCM_CONSP (lst)) {
while (scm_is_pair (lst)) {
if (i == 0) {
SCM_SETCAR (lst, val);
return val;
@ -453,7 +453,7 @@ SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0,
{
SCM lst = list;
size_t i = scm_to_size_t (k);
while (SCM_CONSP (lst)) {
while (scm_is_pair (lst)) {
if (i == 0) {
SCM_SETCDR (lst, val);
return val;
@ -502,7 +502,7 @@ SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0,
SCM
scm_i_finite_list_copy (SCM list)
{
if (!SCM_CONSP (list))
if (!scm_is_pair (list))
{
return list;
}
@ -511,7 +511,7 @@ scm_i_finite_list_copy (SCM list)
SCM tail;
const SCM result = tail = scm_list_1 (SCM_CAR (list));
list = SCM_CDR (list);
while (SCM_CONSP (list))
while (scm_is_pair (list))
{
const SCM new_tail = scm_list_1 (SCM_CAR (list));
SCM_SETCDR (tail, new_tail);
@ -540,7 +540,7 @@ SCM_DEFINE (scm_list_copy, "list-copy", 1, 0, 0,
fill_here = &newlst;
from_here = lst;
while (SCM_CONSP (from_here))
while (scm_is_pair (from_here))
{
SCM c;
c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
@ -650,7 +650,7 @@ SCM_DEFINE (scm_delq_x, "delq!", 2, 0, 0,
SCM *prev;
for (prev = &lst, walk = lst;
SCM_CONSP (walk);
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (scm_is_eq (SCM_CAR (walk), item))
@ -674,7 +674,7 @@ SCM_DEFINE (scm_delv_x, "delv!", 2, 0, 0,
SCM *prev;
for (prev = &lst, walk = lst;
SCM_CONSP (walk);
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (! scm_is_false (scm_eqv_p (SCM_CAR (walk), item)))
@ -699,7 +699,7 @@ SCM_DEFINE (scm_delete_x, "delete!", 2, 0, 0,
SCM *prev;
for (prev = &lst, walk = lst;
SCM_CONSP (walk);
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (! scm_is_false (scm_equal_p (SCM_CAR (walk), item)))
@ -767,7 +767,7 @@ SCM_DEFINE (scm_delq1_x, "delq1!", 2, 0, 0,
SCM *prev;
for (prev = &lst, walk = lst;
SCM_CONSP (walk);
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (scm_is_eq (SCM_CAR (walk), item))
@ -795,7 +795,7 @@ SCM_DEFINE (scm_delv1_x, "delv1!", 2, 0, 0,
SCM *prev;
for (prev = &lst, walk = lst;
SCM_CONSP (walk);
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (! scm_is_false (scm_eqv_p (SCM_CAR (walk), item)))
@ -823,7 +823,7 @@ SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0,
SCM *prev;
for (prev = &lst, walk = lst;
SCM_CONSP (walk);
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (! scm_is_false (scm_equal_p (SCM_CAR (walk), item)))
@ -859,7 +859,7 @@ SCM_DEFINE (scm_filter, "filter", 2, 0, 0,
SCM_VALIDATE_LIST (2, list);
for (prev = &res, walk = list;
SCM_CONSP (walk);
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (scm_is_true (call (pred, SCM_CAR (walk))))
@ -885,7 +885,7 @@ SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0,
SCM_VALIDATE_LIST (2, list);
for (prev = &list, walk = list;
SCM_CONSP (walk);
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (scm_is_true (call (pred, SCM_CAR (walk))))

6
libguile/load.c
View file

@ -368,7 +368,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
/* This simplifies the loop below a bit.
*/
if (SCM_NULLP (extensions))
if (scm_is_null (extensions))
extensions = scm_listofnullstr;
buf.buf_len = 512;
@ -377,7 +377,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
/* Try every path element.
*/
for (; SCM_CONSP (path); path = SCM_CDR (path))
for (; scm_is_pair (path); path = SCM_CDR (path))
{
SCM dir = SCM_CAR (path);
SCM exts;
@ -399,7 +399,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
sans_ext_len = buf.ptr - buf.buf;
/* Try every extension. */
for (exts = extensions; SCM_CONSP (exts); exts = SCM_CDR (exts))
for (exts = extensions; scm_is_pair (exts); exts = SCM_CDR (exts))
{
SCM ext = SCM_CAR (exts);
struct stat mode;

12
libguile/modules.c
View file

@ -217,10 +217,10 @@ scm_top_level_env (SCM thunk)
SCM
scm_env_top_level (SCM env)
{
while (SCM_CONSP (env))
while (scm_is_pair (env))
{
SCM car_env = SCM_CAR (env);
if (!SCM_CONSP (car_env) && scm_is_true (scm_procedure_p (car_env)))
if (!scm_is_pair (car_env) && scm_is_true (scm_procedure_p (car_env)))
return car_env;
env = SCM_CDR (env);
}
@ -297,7 +297,7 @@ module_variable (SCM module, SCM sym)
{
/* 3. Search the use list */
SCM uses = SCM_MODULE_USES (module);
while (SCM_CONSP (uses))
while (scm_is_pair (uses))
{
b = module_variable (SCM_CAR (uses), sym);
if (SCM_BOUND_THING_P (b))
@ -399,7 +399,7 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
SCM_VALIDATE_MODULE (SCM_ARG1, module);
/* Search the use list */
uses = SCM_MODULE_USES (module);
while (SCM_CONSP (uses))
while (scm_is_pair (uses))
{
SCM _interface = SCM_CAR (uses);
/* 1. Check module obarray */
@ -578,7 +578,7 @@ scm_module_reverse_lookup (SCM module, SCM variable)
for (i = 0; i < n; ++i)
{
SCM ls = SCM_HASHTABLE_BUCKETS (obarray)[i], handle;
while (!SCM_NULLP (ls))
while (!scm_is_null (ls))
{
handle = SCM_CAR (ls);
if (SCM_CDR (handle) == variable)
@ -591,7 +591,7 @@ scm_module_reverse_lookup (SCM module, SCM variable)
*/
{
SCM uses = SCM_MODULE_USES (module);
while (SCM_CONSP (uses))
while (scm_is_pair (uses))
{
SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
if (scm_is_true (sym))

2
libguile/null-threads.c
View file

@ -245,7 +245,7 @@ scm_timed_wait_condition_variable (SCM c, SCM m, SCM t)
s_wait_condition_variable);
if (!SCM_UNBNDP (t))
{
if (SCM_CONSP (t))
if (scm_is_pair (t))
{
SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_usec);

14
libguile/objects.c
View file

@ -73,7 +73,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return scm_class_char;
else if (scm_is_bool (x))
return scm_class_boolean;
else if (SCM_NULLP (x))
else if (scm_is_null (x))
return scm_class_null;
else
return scm_class_unknown;
@ -178,7 +178,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
}
}
default:
if (SCM_CONSP (x))
if (scm_is_pair (x))
return scm_class_pair;
else
return scm_class_unknown;
@ -256,14 +256,14 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
methods = SCM_CADR (z);
i = 0;
ls = args;
if (!SCM_NULLP (ls))
if (!scm_is_null (ls))
do
{
i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
[scm_si_hashsets + hashset];
ls = SCM_CDR (ls);
}
while (j-- && !SCM_NULLP (ls));
while (j-- && !scm_is_null (ls));
i &= mask;
end = i;
}
@ -274,7 +274,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
long j = n;
z = SCM_VELTS (methods)[i];
ls = args; /* list of arguments */
if (!SCM_NULLP (ls))
if (!scm_is_null (ls))
do
{
/* More arguments than specifiers => CLASS != ENV */
@ -283,9 +283,9 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
ls = SCM_CDR (ls);
z = SCM_CDR (z);
}
while (j-- && !SCM_NULLP (ls));
while (j-- && !scm_is_null (ls));
/* Fewer arguments than specifiers => CAR != ENV */
if (SCM_NULLP (SCM_CAR (z)) || SCM_CONSP (SCM_CAR (z)))
if (scm_is_null (SCM_CAR (z)) || scm_is_pair (SCM_CAR (z)))
return z;
next_method:
i = (i + 1) & mask;

6
libguile/options.c
View file

@ -187,12 +187,12 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c
break;
case SCM_OPTION_INTEGER:
args = SCM_CDR (args);
SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG1, s);
SCM_ASSERT (scm_is_pair (args), args, SCM_ARG1, s);
flags[i] = scm_to_size_t (SCM_CAR (args));
break;
case SCM_OPTION_SCM:
args = SCM_CDR (args);
SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG1, s);
SCM_ASSERT (scm_is_pair (args), args, SCM_ARG1, s);
flags[i] = SCM_UNPACK (SCM_CAR (args));
break;
}
@ -229,7 +229,7 @@ scm_options (SCM args, scm_t_option options[], unsigned int n, const char *s)
{
if (SCM_UNBNDP (args))
return get_option_setting (options, n);
else if (!SCM_NULL_OR_NIL_P (args) && !SCM_CONSP (args))
else if (!SCM_NULL_OR_NIL_P (args) && !scm_is_pair (args))
/* Dirk:FIXME:: This criterion should be improved. IMO it is better to
* demand that args is #t if documentation should be shown than to say
* that every argument except a list will print out documentation. */

20
libguile/print.c
View file

@ -140,7 +140,7 @@ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0,
"included in @code{--enable-guile-debug} builds.")
#define FUNC_NAME s_scm_current_pstate
{
if (!SCM_NULLP (print_state_pool))
if (!scm_is_null (print_state_pool))
return SCM_CAR (print_state_pool);
else
return SCM_BOOL_F;
@ -170,7 +170,7 @@ scm_make_print_state ()
/* First try to allocate a print state from the pool */
scm_i_plugin_mutex_lock (&print_state_mutex);
if (!SCM_NULLP (print_state_pool))
if (!scm_is_null (print_state_pool))
{
answer = SCM_CAR (print_state_pool);
print_state_pool = SCM_CDR (print_state_pool);
@ -239,11 +239,11 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref)
register long i;
long self = pstate->top - 1;
i = pstate->top - 1;
if (SCM_CONSP (pstate->ref_stack[i]))
if (scm_is_pair (pstate->ref_stack[i]))
{
while (i > 0)
{
if (!SCM_CONSP (pstate->ref_stack[i - 1])
if (!scm_is_pair (pstate->ref_stack[i - 1])
|| !scm_is_eq (SCM_CDR (pstate->ref_stack[i - 1]),
pstate->ref_stack[i]))
break;
@ -685,7 +685,7 @@ scm_prin1 (SCM exp, SCM port, int writingp)
{
/* First try to allocate a print state from the pool */
scm_i_plugin_mutex_lock (&print_state_mutex);
if (!SCM_NULLP (print_state_pool))
if (!scm_is_null (print_state_pool))
{
handle = print_state_pool;
print_state_pool = SCM_CDR (print_state_pool);
@ -763,12 +763,12 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate)
O(depth * N) instead of O(N^2). */
hare = SCM_CDR (exp);
tortoise = exp;
while (SCM_CONSP (hare))
while (scm_is_pair (hare))
{
if (scm_is_eq (hare, tortoise))
goto fancy_printing;
hare = SCM_CDR (hare);
if (!SCM_CONSP (hare))
if (!scm_is_pair (hare))
break;
hare = SCM_CDR (hare);
tortoise = SCM_CDR (tortoise);
@ -776,7 +776,7 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate)
/* No cdr cycles intrinsic to this list */
scm_iprin1 (SCM_CAR (exp), port, pstate);
for (exp = SCM_CDR (exp); SCM_CONSP (exp); exp = SCM_CDR (exp))
for (exp = SCM_CDR (exp); scm_is_pair (exp); exp = SCM_CDR (exp))
{
register long i;
@ -805,7 +805,7 @@ fancy_printing:
scm_iprin1 (SCM_CAR (exp), port, pstate);
exp = SCM_CDR (exp); --n;
for (; SCM_CONSP (exp); exp = SCM_CDR (exp))
for (; scm_is_pair (exp); exp = SCM_CDR (exp))
{
register unsigned long i;
@ -974,7 +974,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
}
if (!SCM_CONSP (args))
if (!scm_is_pair (args))
SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
scm_list_1 (SCM_MAKE_CHAR (*p)));

6
libguile/procprop.c
View file

@ -105,14 +105,14 @@ scm_i_procedure_arity (SCM proc)
goto loop;
case scm_tcs_closures:
proc = SCM_CLOSURE_FORMALS (proc);
if (SCM_NULLP (proc))
if (scm_is_null (proc))
break;
while (SCM_CONSP (proc))
while (scm_is_pair (proc))
{
++a;
proc = SCM_CDR (proc);
}
if (!SCM_NULLP (proc))
if (!scm_is_null (proc))
r = 1;
break;
case scm_tcs_struct:

4
libguile/procs.c
View file

@ -204,7 +204,7 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
switch (SCM_TYP7 (obj))
{
case scm_tcs_closures:
return scm_from_bool (!SCM_CONSP (SCM_CLOSURE_FORMALS (obj)));
return scm_from_bool (!scm_is_pair (SCM_CLOSURE_FORMALS (obj)));
case scm_tc7_subr_0:
case scm_tc7_subr_1o:
case scm_tc7_lsubr:
@ -255,7 +255,7 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
{
case scm_tcs_closures:
code = SCM_CLOSURE_BODY (proc);
if (SCM_NULLP (SCM_CDR (code)))
if (scm_is_null (SCM_CDR (code)))
return SCM_BOOL_F;
code = SCM_CAR (code);
if (scm_is_string (code))

2
libguile/procs.h
View file

@ -77,7 +77,7 @@ typedef struct
+ scm_tc3_closure))
#define SCM_ENV(x) SCM_CELL_OBJECT_1 (x)
#define SCM_SETENV(x, e) SCM_SET_CELL_OBJECT_1 ((x), (e))
#define SCM_TOP_LEVEL(ENV) (SCM_NULLP (ENV) || (scm_is_true (scm_procedure_p (SCM_CAR (ENV)))))
#define SCM_TOP_LEVEL(ENV) (scm_is_null (ENV) || (scm_is_true (scm_procedure_p (SCM_CAR (ENV)))))
/* Procedure-with-setter

28
libguile/ramap.c
View file

@ -988,7 +988,7 @@ scm_ra_sum (SCM ra0, SCM ras)
unsigned long i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (!SCM_NULLP(ras))
if (!scm_is_null(ras))
{
SCM ra1 = SCM_CAR (ras);
unsigned long i1 = SCM_ARRAY_BASE (ra1);
@ -1027,7 +1027,7 @@ scm_ra_difference (SCM ra0, SCM ras)
unsigned long i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
if (scm_is_null (ras))
{
switch (SCM_TYP7 (ra0))
{
@ -1083,7 +1083,7 @@ scm_ra_product (SCM ra0, SCM ras)
unsigned long i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (!SCM_NULLP (ras))
if (!scm_is_null (ras))
{
SCM ra1 = SCM_CAR (ras);
unsigned long i1 = SCM_ARRAY_BASE (ra1);
@ -1134,7 +1134,7 @@ scm_ra_divide (SCM ra0, SCM ras)
unsigned long i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
if (scm_is_null (ras))
{
switch (SCM_TYP7 (ra0))
{
@ -1220,7 +1220,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
long n = SCM_ARRAY_DIMS (ra0)->ubnd;
long base = SCM_ARRAY_BASE (ra0) - i * inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
if (scm_is_null (ras))
for (; i <= n; i++)
scm_array_set_x (ra0, scm_call_0 (proc), scm_from_long (i * inc + base));
else
@ -1232,7 +1232,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (SCM_NULLP(ras))
if (scm_is_null(ras))
ras = scm_nullvect;
else
{
@ -1430,7 +1430,7 @@ ramap_2o (SCM ra0, SCM proc, SCM ras)
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (SCM_NULLP (ras))
if (scm_is_null (ras))
{
if (scm_tc7_vector == SCM_TYP7 (ra0)
|| scm_tc7_wvect == SCM_TYP7 (ra0))
@ -1474,7 +1474,7 @@ ramap_a (SCM ra0, SCM proc, SCM ras)
unsigned long i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
if (scm_is_null (ras))
for (; n-- > 0; i0 += inc0)
scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), SCM_UNDEFINED), scm_from_ulong (i0));
else
@ -1532,14 +1532,14 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
for (p = ra_rpsubrs; p->name; p++)
if (scm_is_eq (proc, p->sproc))
{
while (!SCM_NULLP (lra) && !SCM_NULLP (SCM_CDR (lra)))
while (!scm_is_null (lra) && !scm_is_null (SCM_CDR (lra)))
{
scm_ramapc (p->vproc, SCM_UNDEFINED, ra0, lra, FUNC_NAME);
lra = SCM_CDR (lra);
}
return SCM_UNSPECIFIED;
}
while (!SCM_NULLP (lra) && !SCM_NULLP (SCM_CDR (lra)))
while (!scm_is_null (lra) && !scm_is_null (SCM_CDR (lra)))
{
scm_ramapc (ramap_rp, proc, ra0, lra, FUNC_NAME);
lra = SCM_CDR (lra);
@ -1547,7 +1547,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
return SCM_UNSPECIFIED;
}
case scm_tc7_asubr:
if (SCM_NULLP (lra))
if (scm_is_null (lra))
{
SCM prot, fill = SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED);
if (SCM_I_INUMP(fill))
@ -1572,7 +1572,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
if (!scm_is_eq (ra0, ra1)
|| (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0)))
goto gencase;
for (tail = SCM_CDR (lra); !SCM_NULLP (tail); tail = SCM_CDR (tail))
for (tail = SCM_CDR (lra); !scm_is_null (tail); tail = SCM_CDR (tail))
{
ra1 = SCM_CAR (tail);
if (scm_is_eq (v0, ra1)
@ -1613,7 +1613,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
long n = SCM_ARRAY_DIMS (ra0)->ubnd;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
if (scm_is_null (ras))
for (; i <= n; i++, i0 += inc0)
scm_call_1 (proc, scm_cvref (ra0, i0, SCM_UNDEFINED));
else
@ -1625,7 +1625,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (SCM_NULLP(ras))
if (scm_is_null(ras))
ras = scm_nullvect;
else
{

20
libguile/read.c
View file

@ -280,7 +280,7 @@ scm_i_casei_streq (const char *s1, const char *s2, size_t len2)
static SCM
recsexpr (SCM obj, long line, int column, SCM filename)
{
if (!SCM_CONSP(obj)) {
if (!scm_is_pair(obj)) {
return obj;
} else {
SCM tmp = obj, copy;
@ -293,7 +293,7 @@ recsexpr (SCM obj, long line, int column, SCM filename)
{
copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename),
SCM_UNDEFINED);
while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
while ((tmp = SCM_CDR (tmp)) && scm_is_pair (tmp))
{
SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp),
line,
@ -307,7 +307,7 @@ recsexpr (SCM obj, long line, int column, SCM filename)
else
{
recsexpr (SCM_CAR (obj), line, column, filename);
while ((tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
while ((tmp = SCM_CDR (tmp)) && scm_is_pair (tmp))
recsexpr (SCM_CAR (tmp), line, column, filename);
copy = SCM_UNDEFINED;
}
@ -358,7 +358,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
if (SCM_ELISP_VECTORS_P)
{
p = scm_i_lreadparen (tok_buf, port, s_vector, copy, ']');
return SCM_NULLP (p) ? scm_nullvect : scm_vector (p);
return scm_is_null (p) ? scm_nullvect : scm_vector (p);
}
goto read_token;
#endif
@ -422,7 +422,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
{
case '(':
p = scm_i_lreadparen (tok_buf, port, s_vector, copy, ')');
return SCM_NULLP (p) ? scm_nullvect : scm_vector (p);
return scm_is_null (p) ? scm_nullvect : scm_vector (p);
case 't':
case 'T':
@ -807,7 +807,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
/* Build the head of the list structure. */
ans = tl = scm_cons (tmp, SCM_EOL);
if (SCM_COPY_SOURCE_P)
ans2 = tl2 = scm_cons (SCM_CONSP (tmp)
ans2 = tl2 = scm_cons (scm_is_pair (tmp)
? *copy
: tmp,
SCM_EOL);
@ -820,7 +820,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
{
SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy));
if (SCM_COPY_SOURCE_P)
SCM_SETCDR (tl2, scm_cons (SCM_CONSP (tmp)
SCM_SETCDR (tl2, scm_cons (scm_is_pair (tmp)
? *copy
: tmp,
SCM_EOL));
@ -835,7 +835,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
if (SCM_COPY_SOURCE_P)
{
SCM new_tail2 = scm_cons (SCM_CONSP (tmp) ? *copy : tmp, SCM_EOL);
SCM new_tail2 = scm_cons (scm_is_pair (tmp) ? *copy : tmp, SCM_EOL);
SCM_SETCDR (tl2, new_tail2);
tl2 = new_tail2;
}
@ -881,7 +881,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0,
prev = SCM_BOOL_F;
while (1)
{
if (SCM_NULLP (this))
if (scm_is_null (this))
{
/* not found, so add it to the beginning. */
if (scm_is_true (proc))
@ -928,7 +928,7 @@ scm_get_hash_procedure (int c)
while (1)
{
if (SCM_NULLP (rest))
if (scm_is_null (rest))
return SCM_BOOL_F;
if (SCM_CHAR (SCM_CAAR (rest)) == c)

2
libguile/regex-posix.c
View file

@ -162,7 +162,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
turn off REG_EXTENDED flag (on by default). */
cflags = REG_EXTENDED;
flag = flags;
while (!SCM_NULLP (flag))
while (!scm_is_null (flag))
{
if (scm_to_int (SCM_CAR (flag)) == REG_BASIC)
cflags &= ~REG_EXTENDED;

4
libguile/scmsigs.c
View file

@ -104,7 +104,7 @@ take_signal (int signum)
SCM handler = SCM_VECTOR_REF(signal_cell_handlers, signum);
SCM thread = SCM_VECTOR_REF(signal_handler_threads, signum);
scm_root_state *root = scm_i_thread_root (thread);
if (SCM_CONSP (cell))
if (scm_is_pair (cell))
{
SCM_SETCAR (cell, handler);
root->pending_asyncs = 1;
@ -148,7 +148,7 @@ scm_delq_spine_x (SCM cell, SCM list)
while (!scm_is_eq (cell, s))
{
if (SCM_NULLP (s))
if (scm_is_null (s))
return list;
prev = s;
s = SCM_CDR (s);

10
libguile/script.c
View file

@ -453,7 +453,7 @@ scm_compile_shell_switches (int argc, char **argv)
/* If we specified the -ds option, do_script points to the
cdr of an expression like (load #f); we replace the car
(i.e., the #f) with the script name. */
if (!SCM_NULLP (do_script))
if (!scm_is_null (do_script))
{
SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
do_script = SCM_EOL;
@ -526,7 +526,7 @@ scm_compile_shell_switches (int argc, char **argv)
{
/* We put a dummy "load" expression, and let the -s put the
filename in. */
if (!SCM_NULLP (do_script))
if (!scm_is_null (do_script))
scm_shell_usage (1, "the -ds switch may only be specified once");
do_script = scm_cons (SCM_BOOL_F, SCM_EOL);
tail = scm_cons (scm_cons (sym_load, do_script),
@ -615,7 +615,7 @@ scm_compile_shell_switches (int argc, char **argv)
}
/* Check to make sure the -ds got a -s. */
if (!SCM_NULLP (do_script))
if (!scm_is_null (do_script))
scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
/* Make any remaining arguments available to the
@ -626,7 +626,7 @@ scm_compile_shell_switches (int argc, char **argv)
scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface));
/* Handle the `-e' switch, if it was specified. */
if (!SCM_NULLP (entry_point))
if (!scm_is_null (entry_point))
tail = scm_cons (scm_cons2 (entry_point,
scm_cons (sym_command_line, SCM_EOL),
SCM_EOL),
@ -650,7 +650,7 @@ scm_compile_shell_switches (int argc, char **argv)
/* add the user-specified load path here, so it won't be in effect
during the loading of the user's customization file. */
if(!SCM_NULLP(user_load_path))
if(!scm_is_null(user_load_path))
{
tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
}

4
libguile/simpos.c
View file

@ -114,10 +114,10 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
"Example: (system* \"echo\" \"foo\" \"bar\")")
#define FUNC_NAME s_scm_system_star
{
if (SCM_NULLP (args))
if (scm_is_null (args))
SCM_WRONG_NUM_ARGS ();
if (SCM_CONSP (args))
if (scm_is_pair (args))
{
SCM oldint;
SCM oldquit;

2
libguile/smob.c
View file

@ -242,7 +242,7 @@ scm_smob_apply_2_error (SCM smob, SCM a1 SCM_UNUSED, SCM a2 SCM_UNUSED)
static SCM
scm_smob_apply_3_030 (SCM smob, SCM a1, SCM a2, SCM rst)
{
if (!SCM_NULLP (SCM_CDR (rst)))
if (!scm_is_null (SCM_CDR (rst)))
scm_wrong_num_args (smob);
return SCM_SMOB_APPLY3 (smob, a1, a2, SCM_CAR (rst));
}

10
libguile/socket.c
View file

@ -620,7 +620,7 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
struct linger ling;
long lv;
SCM_ASSERT (SCM_CONSP (value), value, SCM_ARG4, FUNC_NAME);
SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
lv = SCM_NUM2LONG (4, SCM_CAR (value));
ling.l_onoff = (int) lv;
SCM_ASSERT_RANGE (SCM_ARG4, value, ling.l_onoff == lv);
@ -633,7 +633,7 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
int ling;
long lv;
SCM_ASSERT (SCM_CONSP (value), value, SCM_ARG4, FUNC_NAME);
SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
/* timeout is ignored, but may as well validate it. */
lv = SCM_NUM2LONG (4, SCM_CDR (value));
ling = (int) lv;
@ -755,11 +755,11 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
SCM_VALIDATE_CONS (which_arg + 1, *args);
port = scm_to_int (SCM_CAR (*args));
*args = SCM_CDR (*args);
if (SCM_CONSP (*args))
if (scm_is_pair (*args))
{
SCM_VALIDATE_ULONG_COPY (which_arg + 2, SCM_CAR (*args), flowinfo);
*args = SCM_CDR (*args);
if (SCM_CONSP (*args))
if (scm_is_pair (*args))
{
SCM_VALIDATE_ULONG_COPY (which_arg + 3, SCM_CAR (*args),
scope_id);
@ -1299,7 +1299,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
fd = SCM_FPORT_FDES (sock);
soka = scm_fill_sockaddr (scm_to_int (fam), address, &args_and_flags, 4,
FUNC_NAME, &size);
if (SCM_NULLP (args_and_flags))
if (scm_is_null (args_and_flags))
flg = 0;
else
{

10
libguile/sort.c
View file

@ -329,7 +329,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items))
return SCM_BOOL_T;
if (SCM_CONSP (items))
if (scm_is_pair (items))
{
len = scm_ilength (items); /* also checks that it's a pure list */
SCM_ASSERT_RANGE (1, items, len >= 0);
@ -581,7 +581,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items))
return items;
if (SCM_CONSP (items))
if (scm_is_pair (items))
{
const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
@ -612,7 +612,7 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items))
return items;
if (SCM_CONSP (items))
if (scm_is_pair (items))
{
const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len;
@ -723,7 +723,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items))
return items;
if (SCM_CONSP (items))
if (scm_is_pair (items))
{
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
return scm_merge_list_step (&items, cmp, less, len);
@ -761,7 +761,7 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
if (SCM_NULL_OR_NIL_P (items))
return items;
if (SCM_CONSP (items))
if (scm_is_pair (items))
{
long len; /* list/vector length */

8
libguile/srcprop.c
View file

@ -156,7 +156,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj);
else if (!SCM_CONSP (obj))
else if (!scm_is_pair (obj))
SCM_WRONG_TYPE_ARG (1, obj);
p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
if (SRCPROPSP (p))
@ -179,7 +179,7 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj);
else if (!SCM_CONSP (obj))
else if (!scm_is_pair (obj))
SCM_WRONG_TYPE_ARG(1, obj);
handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist);
SCM_SETCDR (handle, plist);
@ -197,7 +197,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj);
else if (!SCM_CONSP (obj))
else if (!scm_is_pair (obj))
SCM_WRONG_TYPE_ARG (1, obj);
p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
if (!SRCPROPSP (p))
@ -229,7 +229,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj);
else if (!SCM_CONSP (obj))
else if (!scm_is_pair (obj))
SCM_WRONG_TYPE_ARG (1, obj);
h = scm_whash_get_handle (scm_source_whash, obj);
if (SCM_WHASHFOUNDP (h))

14
libguile/srfi-13.c
View file

@ -291,7 +291,7 @@ SCM_DEFINE (scm_reverse_list_to_string, "reverse-list->string", 1, 0, 0,
{
data += i;
while (i > 0 && SCM_CONSP (chrs))
while (i > 0 && scm_is_pair (chrs))
{
SCM elt = SCM_CAR (chrs);
@ -391,7 +391,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
switch (gram)
{
case GRAM_INFIX:
if (!SCM_NULLP (ls))
if (!scm_is_null (ls))
len = (strings > 0) ? ((strings - 1) * del_len) : 0;
break;
case GRAM_STRICT_INFIX:
@ -406,7 +406,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
}
tmp = ls;
while (SCM_CONSP (tmp))
while (scm_is_pair (tmp))
{
len += scm_c_string_length (SCM_CAR (tmp));
tmp = SCM_CDR (tmp);
@ -419,16 +419,16 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
{
case GRAM_INFIX:
case GRAM_STRICT_INFIX:
while (SCM_CONSP (tmp))
while (scm_is_pair (tmp))
{
append_string (&p, &len, SCM_CAR (tmp));
if (!SCM_NULLP (SCM_CDR (tmp)) && del_len > 0)
if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0)
append_string (&p, &len, delimiter);
tmp = SCM_CDR (tmp);
}
break;
case GRAM_SUFFIX:
while (SCM_CONSP (tmp))
while (scm_is_pair (tmp))
{
append_string (&p, &len, SCM_CAR (tmp));
if (del_len > 0)
@ -437,7 +437,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
}
break;
case GRAM_PREFIX:
while (SCM_CONSP (tmp))
while (scm_is_pair (tmp))
{
if (del_len > 0)
append_string (&p, &len, delimiter);

42
libguile/srfi-14.c
View file

@ -100,7 +100,7 @@ SCM_DEFINE (scm_char_set_eq, "char-set=", 0, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (char_sets);
while (!SCM_NULLP (char_sets))
while (!scm_is_null (char_sets))
{
SCM csi = SCM_CAR (char_sets);
long *csi_data;
@ -130,7 +130,7 @@ SCM_DEFINE (scm_char_set_leq, "char-set<=", 0, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (char_sets);
while (!SCM_NULLP (char_sets))
while (!scm_is_null (char_sets))
{
SCM csi = SCM_CAR (char_sets);
long *csi_data;
@ -441,7 +441,7 @@ SCM_DEFINE (scm_char_set, "char-set", 0, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
cs = make_char_set (FUNC_NAME);
p = (long *) SCM_SMOB_DATA (cs);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
int c;
@ -474,7 +474,7 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
cs = scm_char_set_copy (base_cs);
}
p = (long *) SCM_SMOB_DATA (cs);
while (!SCM_NULLP (list))
while (!scm_is_null (list))
{
SCM chr = SCM_CAR (list);
int c;
@ -501,7 +501,7 @@ SCM_DEFINE (scm_list_to_char_set_x, "list->char-set!", 2, 0, 0,
SCM_VALIDATE_LIST (1, list);
SCM_VALIDATE_SMOB (2, base_cs, charset);
p = (long *) SCM_SMOB_DATA (base_cs);
while (!SCM_NULLP (list))
while (!scm_is_null (list))
{
SCM chr = SCM_CAR (list);
int c;
@ -908,7 +908,7 @@ SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1,
cs = scm_char_set_copy (cs);
p = (long *) SCM_SMOB_DATA (cs);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
SCM chr = SCM_CAR (rest);
int c;
@ -936,7 +936,7 @@ SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1,
cs = scm_char_set_copy (cs);
p = (long *) SCM_SMOB_DATA (cs);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
SCM chr = SCM_CAR (rest);
int c;
@ -963,7 +963,7 @@ SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
p = (long *) SCM_SMOB_DATA (cs);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
SCM chr = SCM_CAR (rest);
int c;
@ -990,7 +990,7 @@ SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
p = (long *) SCM_SMOB_DATA (cs);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
SCM chr = SCM_CAR (rest);
int c;
@ -1039,7 +1039,7 @@ SCM_DEFINE (scm_char_set_union, "char-set-union", 0, 0, 1,
res = make_char_set (FUNC_NAME);
p = (long *) SCM_SMOB_DATA (res);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
int k;
SCM cs = SCM_CAR (rest);
@ -1064,7 +1064,7 @@ SCM_DEFINE (scm_char_set_intersection, "char-set-intersection", 0, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
if (SCM_NULLP (rest))
if (scm_is_null (rest))
res = make_char_set (FUNC_NAME);
else
{
@ -1075,7 +1075,7 @@ SCM_DEFINE (scm_char_set_intersection, "char-set-intersection", 0, 0, 1,
p = (long *) SCM_SMOB_DATA (res);
rest = SCM_CDR (rest);
while (SCM_CONSP (rest))
while (scm_is_pair (rest))
{
int k;
SCM cs = SCM_CAR (rest);
@ -1109,7 +1109,7 @@ SCM_DEFINE (scm_char_set_difference, "char-set-difference", 1, 0, 1,
res = scm_char_set_copy (cs1);
p = (long *) SCM_SMOB_DATA (res);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
int k;
SCM cs = SCM_CAR (rest);
@ -1134,7 +1134,7 @@ SCM_DEFINE (scm_char_set_xor, "char-set-xor", 0, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
if (SCM_NULLP (rest))
if (scm_is_null (rest))
res = make_char_set (FUNC_NAME);
else
{
@ -1145,7 +1145,7 @@ SCM_DEFINE (scm_char_set_xor, "char-set-xor", 0, 0, 1,
p = (long *) SCM_SMOB_DATA (res);
rest = SCM_CDR (rest);
while (SCM_CONSP (rest))
while (scm_is_pair (rest))
{
SCM cs = SCM_CAR (rest);
long *cs_data;
@ -1182,7 +1182,7 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1
res2 = make_char_set (FUNC_NAME);
p = (long *) SCM_SMOB_DATA (res1);
q = (long *) SCM_SMOB_DATA (res2);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
int k;
SCM cs = SCM_CAR (rest);
@ -1233,7 +1233,7 @@ SCM_DEFINE (scm_char_set_union_x, "char-set-union!", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
p = (long *) SCM_SMOB_DATA (cs1);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
int k;
SCM cs = SCM_CAR (rest);
@ -1261,7 +1261,7 @@ SCM_DEFINE (scm_char_set_intersection_x, "char-set-intersection!", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
p = (long *) SCM_SMOB_DATA (cs1);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
int k;
SCM cs = SCM_CAR (rest);
@ -1289,7 +1289,7 @@ SCM_DEFINE (scm_char_set_difference_x, "char-set-difference!", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
p = (long *) SCM_SMOB_DATA (cs1);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
int k;
SCM cs = SCM_CAR (rest);
@ -1326,7 +1326,7 @@ SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (rest);
p = (long *) SCM_SMOB_DATA (cs1);
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
int k;
SCM cs = SCM_CAR (rest);
@ -1373,7 +1373,7 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!"
p[k] &= ~q[k];
q[k] = t & q[k];
}
while (!SCM_NULLP (rest))
while (!scm_is_null (rest))
{
SCM cs = SCM_CAR (rest);
long *r;

4
libguile/stacks.c
View file

@ -468,11 +468,11 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
/* Narrow the stack according to the arguments given to scm_make_stack. */
SCM_VALIDATE_REST_ARGUMENT (args);
while (n > 0 && !SCM_NULLP (args))
while (n > 0 && !scm_is_null (args))
{
inner_cut = SCM_CAR (args);
args = SCM_CDR (args);
if (SCM_NULLP (args))
if (scm_is_null (args))
{
outer_cut = SCM_INUM0;
}

4
libguile/stacks.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_STACKS_H
#define SCM_STACKS_H
/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,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
@ -52,7 +52,7 @@ SCM_API SCM scm_stack_type;
#define SCM_STACK_LENGTH(stack) (SCM_STACK (stack) -> length)
#define SCM_FRAMEP(obj) \
(SCM_CONSP (obj) && SCM_STACKP (SCM_CAR (obj)) \
(scm_is_pair (obj) && SCM_STACKP (SCM_CAR (obj)) \
&& scm_is_unsigned_integer (SCM_CDR (obj), \
0, SCM_STACK_LENGTH (SCM_CAR (obj))-1))

10
libguile/strings.c
View file

@ -552,7 +552,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
}
result = scm_i_make_string (len, &data);
while (len > 0 && SCM_CONSP (chrs))
while (len > 0 && scm_is_pair (chrs))
{
SCM elt = SCM_CAR (chrs);
@ -563,7 +563,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
}
if (len > 0)
scm_misc_error (NULL, "list changed while constructing string", SCM_EOL);
if (!SCM_NULLP (chrs))
if (!scm_is_null (chrs))
scm_wrong_type_arg_msg (NULL, 0, chrs, "proper list");
return result;
@ -780,14 +780,14 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
char *data;
SCM_VALIDATE_REST_ARGUMENT (args);
for (l = args; !SCM_NULLP (l); l = SCM_CDR (l))
for (l = args; !scm_is_null (l); l = SCM_CDR (l))
{
s = SCM_CAR (l);
SCM_VALIDATE_STRING (SCM_ARGn, s);
i += scm_i_string_length (s);
}
res = scm_i_make_string (i, &data);
for (l = args; !SCM_NULLP (l); l = SCM_CDR (l))
for (l = args; !scm_is_null (l); l = SCM_CDR (l))
{
size_t len;
s = SCM_CAR (l);
@ -941,7 +941,7 @@ scm_i_allocate_string_pointers (SCM list)
/* The list might be have been modified in another thread, so
we check LIST before each access.
*/
for (i = 0; i < len && SCM_CONSP (list); i++)
for (i = 0; i < len && scm_is_pair (list); i++)
{
result[i] = scm_to_locale_string (SCM_CAR (list));
list = SCM_CDR (list);

10
libguile/struct.c
View file

@ -172,7 +172,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in
#endif
case 'u':
if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
if ((prot != 'r' && prot != 'w') || scm_is_null (inits))
*mem = 0;
else
{
@ -182,7 +182,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in
break;
case 'p':
if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
if ((prot != 'r' && prot != 'w') || scm_is_null (inits))
*mem = SCM_UNPACK (SCM_BOOL_F);
else
{
@ -357,7 +357,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED,
{
/* Mark vtables in GC chain. GC mark set means delay freeing. */
SCM chain = newchain;
while (!SCM_NULLP (chain))
while (!scm_is_null (chain))
{
SCM vtable = SCM_STRUCT_VTABLE (chain);
if (SCM_STRUCT_GC_CHAIN (vtable) != 0 && vtable != chain)
@ -367,7 +367,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED,
/* Free unmarked structs. */
chain = newchain;
newchain = SCM_EOL;
while (!SCM_NULLP (chain))
while (!scm_is_null (chain))
{
SCM obj = chain;
chain = SCM_STRUCT_GC_CHAIN (chain);
@ -390,7 +390,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED,
}
}
}
while (!SCM_NULLP (newchain));
while (!scm_is_null (newchain));
return 0;
}

2
libguile/symbols.c
View file

@ -99,7 +99,7 @@ scm_i_mem2symbol (SCM str)
SCM l;
for (l = SCM_HASHTABLE_BUCKETS (symbols) [hash];
!SCM_NULLP (l);
!scm_is_null (l);
l = SCM_CDR (l))
{
SCM sym = SCM_CAAR (l);

18
libguile/threads.c
View file

@ -54,7 +54,7 @@ static SCM
enqueue (SCM q, SCM t)
{
SCM c = scm_cons (t, SCM_EOL);
if (SCM_NULLP (SCM_CDR (q)))
if (scm_is_null (SCM_CDR (q)))
SCM_SETCDR (q, c);
else
SCM_SETCDR (SCM_CAR (q), c);
@ -66,7 +66,7 @@ static void
remqueue (SCM q, SCM c)
{
SCM p, prev = q;
for (p = SCM_CDR (q); !SCM_NULLP (p); p = SCM_CDR (p))
for (p = SCM_CDR (q); !scm_is_null (p); p = SCM_CDR (p))
{
if (scm_is_eq (p, c))
{
@ -84,12 +84,12 @@ static SCM
dequeue (SCM q)
{
SCM c = SCM_CDR (q);
if (SCM_NULLP (c))
if (scm_is_null (c))
return SCM_BOOL_F;
else
{
SCM_SETCDR (q, SCM_CDR (c));
if (SCM_NULLP (SCM_CDR (q)))
if (scm_is_null (SCM_CDR (q)))
SCM_SETCAR (q, SCM_EOL);
return SCM_CAR (c);
}
@ -841,7 +841,7 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1,
if (!SCM_UNBNDP (t))
{
if (SCM_CONSP (t))
if (scm_is_pair (t))
{
SCM_VALIDATE_UINT_COPY (3, SCM_CAR (t), waittime.tv_sec);
SCM_VALIDATE_UINT_COPY (3, SCM_CDR (t), waittime.tv_nsec);
@ -938,7 +938,7 @@ scm_threads_mark_stacks (void)
{
volatile SCM c;
for (c = all_threads; !SCM_NULLP (c); c = SCM_CDR (c))
for (c = all_threads; !scm_is_null (c); c = SCM_CDR (c))
{
scm_thread *t = SCM_THREAD_DATA (SCM_CAR (c));
if (!THREAD_INITIALIZED_P (t))
@ -1164,7 +1164,7 @@ scm_i_thread_put_to_sleep ()
threads = all_threads;
/* Signal all threads to go to sleep */
scm_i_thread_go_to_sleep = 1;
for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
for (; !scm_is_null (threads); threads = SCM_CDR (threads))
{
scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
scm_i_plugin_mutex_lock (&t->heap_mutex);
@ -1178,7 +1178,7 @@ scm_i_thread_invalidate_freelists ()
{
/* Don't need to lock thread_admin_mutex here since we are single threaded */
SCM threads = all_threads;
for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
for (; !scm_is_null (threads); threads = SCM_CDR (threads))
if (SCM_CAR (threads) != cur_thread)
{
scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
@ -1194,7 +1194,7 @@ scm_i_thread_wake_up ()
SCM threads;
threads = all_threads;
scm_i_plugin_cond_broadcast (&wake_up_cond);
for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
for (; !scm_is_null (threads); threads = SCM_CDR (threads))
{
scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
scm_i_plugin_mutex_unlock (&t->heap_mutex);

8
libguile/throw.c
View file

@ -577,10 +577,10 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
/* Search the wind list for an appropriate catch.
"Waiter, please bring us the wind list." */
for (winds = scm_dynwinds; SCM_CONSP (winds); winds = SCM_CDR (winds))
for (winds = scm_dynwinds; scm_is_pair (winds); winds = SCM_CDR (winds))
{
dynpair = SCM_CAR (winds);
if (SCM_CONSP (dynpair))
if (scm_is_pair (dynpair))
{
SCM this_key = SCM_CAR (dynpair);
@ -592,14 +592,14 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
/* If we didn't find anything, print a message and abort the process
right here. If you don't want this, establish a catch-all around
any code that might throw up. */
if (SCM_NULLP (winds))
if (scm_is_null (winds))
{
scm_handle_by_message (NULL, key, args);
abort ();
}
/* If the wind list is malformed, bail. */
if (!SCM_CONSP (winds))
if (!scm_is_pair (winds))
abort ();
jmpbuf = SCM_CDR (dynpair);

48
libguile/unif.c
View file

@ -310,7 +310,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
break;
case scm_tc7_vector:
case scm_tc7_wvect:
protp = SCM_NULLP(prot);
protp = scm_is_null(prot);
break;
default:
/* no default */
@ -466,7 +466,7 @@ scm_aind (SCM ra, SCM args, const char *what)
scm_error_num_args_subr (what);
return pos + (scm_to_long (args) - s->lbnd) * (s->inc);
}
while (k && SCM_CONSP (args))
while (k && scm_is_pair (args))
{
ind = SCM_CAR (args);
args = SCM_CDR (args);
@ -479,7 +479,7 @@ scm_aind (SCM ra, SCM args, const char *what)
k--;
s++;
}
if (k != 0 || !SCM_NULLP (args))
if (k != 0 || !scm_is_null (args))
scm_error_num_args_subr (what);
return pos;
@ -517,7 +517,7 @@ scm_shap2ra (SCM args, const char *what)
ra = scm_make_ra (ndim);
SCM_ARRAY_BASE (ra) = 0;
s = SCM_ARRAY_DIMS (ra);
for (; !SCM_NULLP (args); s++, args = SCM_CDR (args))
for (; !scm_is_null (args); s++, args = SCM_CDR (args))
{
spec = SCM_CAR (args);
if (scm_is_integer (spec))
@ -530,13 +530,13 @@ scm_shap2ra (SCM args, const char *what)
}
else
{
if (!SCM_CONSP (spec) || !scm_is_integer (SCM_CAR (spec)))
if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec)))
scm_misc_error (what, s_bad_spec, SCM_EOL);
s->lbnd = scm_to_long (SCM_CAR (spec));
sp = SCM_CDR (spec);
if (!SCM_CONSP (sp)
if (!scm_is_pair (sp)
|| !scm_is_integer (SCM_CAR (sp))
|| !SCM_NULLP (SCM_CDR (sp)))
|| !scm_is_null (SCM_CDR (sp)))
scm_misc_error (what, s_bad_spec, SCM_EOL);
s->ubnd = scm_to_long (SCM_CAR (sp));
s->inc = 1;
@ -571,7 +571,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
return answer;
}
SCM_ASSERT (SCM_NULLP (dims) || SCM_CONSP (dims),
SCM_ASSERT (scm_is_null (dims) || scm_is_pair (dims),
dims, SCM_ARG1, FUNC_NAME);
ra = scm_shap2ra (dims, FUNC_NAME);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
@ -797,7 +797,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
#if SCM_SIZEOF_LONG_LONG != 0
case scm_tc7_llvect:
#endif
if (SCM_NULLP (args) || !SCM_NULLP (SCM_CDR (args)))
if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
SCM_WRONG_NUM_ARGS ();
SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
@ -885,7 +885,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
int ndim, j, k, ninr, noutr;
SCM_VALIDATE_REST_ARGUMENT (axes);
if (SCM_NULLP (axes))
if (scm_is_null (axes))
axes = scm_cons ((SCM_ARRAYP (ra) ? scm_from_size_t (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
ninr = scm_ilength (axes);
if (ninr < 0)
@ -993,7 +993,7 @@ tail:
pos = SCM_ARRAY_BASE (v);
if (!k)
{
SCM_ASRTGO (SCM_NULLP (ind), wna);
SCM_ASRTGO (scm_is_null (ind), wna);
ind = SCM_INUM0;
}
else
@ -1033,7 +1033,7 @@ tail:
case scm_tc7_wvect:
{
unsigned long length = scm_to_ulong (scm_uniform_vector_length (v));
SCM_ASRTGO (SCM_NULLP (args) && scm_is_integer (ind), wna);
SCM_ASRTGO (scm_is_null (args) && scm_is_integer (ind), wna);
return scm_from_bool(pos >= 0 && pos < length);
}
}
@ -1055,7 +1055,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
if (SCM_IMP (v))
{
SCM_ASRTGO (SCM_NULLP (args), badarg);
SCM_ASRTGO (scm_is_null (args), badarg);
return v;
}
else if (SCM_ARRAYP (v))
@ -1068,9 +1068,9 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
unsigned long int length;
if (SCM_NIMP (args))
{
SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_pair (args), args, SCM_ARG2, FUNC_NAME);
pos = scm_to_long (SCM_CAR (args));
SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna);
SCM_ASRTGO (scm_is_null (SCM_CDR (args)), wna);
}
else
{
@ -1082,7 +1082,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
switch SCM_TYP7 (v)
{
default:
if (SCM_NULLP (args))
if (scm_is_null (args))
return v;
badarg:
SCM_WRONG_TYPE_ARG (1, v);
@ -1239,9 +1239,9 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
else
{
unsigned long int length;
if (SCM_CONSP (args))
if (scm_is_pair (args))
{
SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna);
SCM_ASRTGO (scm_is_null (SCM_CDR (args)), wna);
pos = scm_to_long (SCM_CAR (args));
}
else
@ -2221,7 +2221,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
}
ra = scm_dimensions_to_uniform_array (scm_reverse (shp), prot,
SCM_UNDEFINED);
if (SCM_NULLP (shp))
if (scm_is_null (shp))
{
SCM_ASRTGO (1 == scm_ilength (lst), badlst);
scm_array_set_x (ra, SCM_CAR (lst), SCM_EOL);
@ -2249,31 +2249,31 @@ l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k)
register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd);
int ok = 1;
if (n <= 0)
return (SCM_NULLP (lst));
return (scm_is_null (lst));
if (k < SCM_ARRAY_NDIM (ra) - 1)
{
while (n--)
{
if (!SCM_CONSP (lst))
if (!scm_is_pair (lst))
return 0;
ok = ok && l2ra (SCM_CAR (lst), ra, base, k + 1);
base += inc;
lst = SCM_CDR (lst);
}
if (!SCM_NULLP (lst))
if (!scm_is_null (lst))
return 0;
}
else
{
while (n--)
{
if (!SCM_CONSP (lst))
if (!scm_is_pair (lst))
return 0;
scm_array_set_x (SCM_ARRAY_V (ra), SCM_CAR (lst), scm_from_ulong (base));
base += inc;
lst = SCM_CDR (lst);
}
if (!SCM_NULLP (lst))
if (!scm_is_null (lst))
return 0;
}
return ok;

25
libguile/validate.h
View file

@ -115,11 +115,15 @@
SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, #pred); \
} while (0)
#define SCM_MAKE_VALIDATE_MSG(pos, var, pred, msg) \
#define SCM_I_MAKE_VALIDATE_MSG2(pos, var, pred, msg) \
do { \
SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, msg); \
SCM_ASSERT_TYPE (pred (var), var, pos, FUNC_NAME, msg); \
} while (0)
#define SCM_MAKE_VALIDATE_MSG(pos, var, pred, msg) \
SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_ ## pred, msg)
#define SCM_VALIDATE_REST_ARGUMENT(x) \
@ -214,11 +218,14 @@
} \
} while (0)
#define SCM_VALIDATE_NULL(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NULLP, "null")
#define SCM_VALIDATE_NULL(pos, scm) \
SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_null, "empty list")
#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NULL_OR_NIL_P, "null")
#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) \
SCM_MAKE_VALIDATE_MSG (pos, scm, NULL_OR_NIL_P, "empty list")
#define SCM_VALIDATE_CONS(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CONSP, "pair")
#define SCM_VALIDATE_CONS(pos, scm) \
SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_pair, "pair")
#define SCM_VALIDATE_LIST(pos, lst) \
do { \
@ -244,15 +251,15 @@
#define SCM_VALIDATE_ALISTCELL(pos, alist) \
do { \
SCM_ASSERT (SCM_CONSP (alist) && SCM_CONSP (SCM_CAR (alist)), \
SCM_ASSERT (scm_is_pair (alist) && scm_is_pair (SCM_CAR (alist)), \
alist, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_ALISTCELL_COPYSCM(pos, alist, cvar) \
do { \
SCM_ASSERT (SCM_CONSP (alist), alist, pos, FUNC_NAME); \
SCM_ASSERT (scm_is_pair (alist), alist, pos, FUNC_NAME); \
cvar = SCM_CAR (alist); \
SCM_ASSERT (SCM_CONSP (cvar), alist, pos, FUNC_NAME); \
SCM_ASSERT (scm_is_pair (cvar), alist, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_OPORT_VALUE(pos, port) \
@ -291,7 +298,7 @@
#define SCM_VALIDATE_NULLORCONS(pos, env) \
do { \
SCM_ASSERT (SCM_NULLP (env) || SCM_CONSP (env), env, pos, FUNC_NAME); \
SCM_ASSERT (scm_is_null (env) || scm_is_pair (env), env, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, HOOKP, "hook")

12
libguile/weaks.c
View file

@ -264,7 +264,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
{
SCM w;
for (w = scm_weak_vectors; !SCM_NULLP (w); w = SCM_WVECT_GC_CHAIN (w))
for (w = scm_weak_vectors; !scm_is_null (w); w = SCM_WVECT_GC_CHAIN (w))
{
if (SCM_IS_WHVEC_ANY (w))
{
@ -281,9 +281,9 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
SCM alist;
alist = ptr[j];
while ( SCM_CONSP (alist)
while ( scm_is_pair (alist)
&& !SCM_GC_MARK_P (alist)
&& SCM_CONSP (SCM_CAR (alist)))
&& scm_is_pair (SCM_CAR (alist)))
{
SCM_SET_GC_MARK (alist);
SCM_SET_GC_MARK (SCM_CAR (alist));
@ -304,7 +304,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
void *dummy3 SCM_UNUSED)
{
SCM *ptr, w;
for (w = scm_weak_vectors; !SCM_NULLP (w); w = SCM_WVECT_GC_CHAIN (w))
for (w = scm_weak_vectors; !scm_is_null (w); w = SCM_WVECT_GC_CHAIN (w))
{
if (!SCM_IS_WHVEC_ANY (w))
{
@ -336,8 +336,8 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
fixup = ptr + j;
alist = *fixup;
while (SCM_CONSP (alist)
&& SCM_CONSP (SCM_CAR (alist)))
while (scm_is_pair (alist)
&& scm_is_pair (SCM_CAR (alist)))
{
SCM key;
SCM value;