-2004-09-22 Marius Vollmer <marius.vollmer@uni-dortmund.de>
+2004-09-22 Marius Vollmer <mvo@zagadka.de>
+
+ * 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 (scm_car, scm_cdr, scm_i_chase_pairs, SCM_I_A_PAT,
- SCM_I_D_PAT, etc, scm_caar, scm_cadr, etc): New.
+ * 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>
-/* 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
#include "libguile/lang.h"
#include "libguile/validate.h"
+#include "libguile/pairs.h"
#include "libguile/alist.h"
\f
"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;
"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;
}
"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;
}
#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;
#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;
#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;
SCM handle;
handle = scm_sloppy_assq (key, alist);
- if (SCM_CONSP (handle))
+ if (scm_is_pair (handle))
{
return SCM_CDR (handle);
}
SCM handle;
handle = scm_sloppy_assv (key, alist);
- if (SCM_CONSP (handle))
+ if (scm_is_pair (handle))
{
return SCM_CDR (handle);
}
SCM handle;
handle = scm_sloppy_assoc (key, alist);
- if (SCM_CONSP (handle))
+ if (scm_is_pair (handle))
{
return SCM_CDR (handle);
}
SCM handle;
handle = scm_sloppy_assq (key, alist);
- if (SCM_CONSP (handle))
+ if (scm_is_pair (handle))
{
SCM_SETCDR (handle, val);
return alist;
SCM handle;
handle = scm_sloppy_assv (key, alist);
- if (SCM_CONSP (handle))
+ if (scm_is_pair (handle))
{
SCM_SETCDR (handle, val);
return alist;
SCM handle;
handle = scm_sloppy_assoc (key, alist);
- if (SCM_CONSP (handle))
+ if (scm_is_pair (handle))
{
SCM_SETCDR (handle, val);
return alist;
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;
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;
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;
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
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)))
{
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);
/* 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,
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);
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);
}
/* 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)),
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 ();
}
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);
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)
-/* 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
- */
-
-
-\f
-
-#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:
-*/
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);
}
#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);
}
{
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))
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);
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;
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;
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;
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);
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);
/* 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));
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));
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);
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);
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);
? 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
do {
SCM rest = SCM_CDR (l);
- if (!SCM_NULLP (rest))
+ if (!scm_is_null (rest))
{
SCM next = handling_weaks
? SCM_CDAR (l)
}
l = rest;
- } while (!SCM_NULLP (l));
+ } while (!scm_is_null (l));
}
}
? 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
}
}
- 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
{
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);
SCM entry = SCM_CDR (binding);
- if (SCM_CONSP (entry))
+ if (scm_is_pair (entry))
{
/* The entry in the obarray is a cached location. */
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;
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);
{
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);
{
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;
{
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;
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);
{
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;
{
return SCM_UNDEFINED;
}
- else if (SCM_CONSP (owner))
+ else if (scm_is_pair (owner))
{
SCM resolve = import_environment_conflict (env, sym, owner);
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))
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));
{
return SCM_UNDEFINED;
}
- else if (SCM_CONSP (owner))
+ else if (scm_is_pair (owner))
{
SCM resolve = import_environment_conflict (env, sym, owner);
{
return SCM_UNDEFINED;
}
- else if (SCM_CONSP (owner))
+ else if (scm_is_pair (owner))
{
SCM resolve = import_environment_conflict (env, sym, owner);
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);
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);
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);
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))
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)
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
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;
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;
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))
{
/* 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;
count (SCM ls)
{
int n = 0;
- while (!SCM_NULLP (ls))
+ while (!scm_is_null (ls))
{
++n;
ls = SCM_FUTURE_NEXT (ls);
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
{
static void
kill_futures (SCM victims)
{
- while (!SCM_NULLP (victims))
+ while (!scm_is_null (victims))
{
SCM future;
UNLINK (victims, future);
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;
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);
next = futures;
nextloc = &futures;
- while (!SCM_NULLP (next))
+ while (!scm_is_null (next))
{
if (!SCM_GC_MARK_P (next))
goto free;
next = *nextloc;
}
goto exit;
- while (!SCM_NULLP (next))
+ while (!scm_is_null (next))
{
if (SCM_GC_MARK_P (next))
{
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);
/* 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;
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. */
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);
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)))
{
SCM tmp;
- if (SCM_NULLP (l))
+ if (scm_is_null (l))
return res;
tmp = SCM_CAAR (l);
{
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));
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);
}
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)
/* 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));
*/
#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)) \
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)))
{
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 */
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);
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,
/* 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)));
{
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);
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,
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;
{
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;
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);
}
{
#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),
*
*/
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);
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;
}
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);
/* 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));
}
*var = scm_permanent_object (scm_basic_make_class (meta,
tmp,
- SCM_CONSP (super)
+ scm_is_pair (super)
? super
: scm_list_1 (super),
slots));
{
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);
#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);
}
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]);
/* 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);
}
void *dummy2 SCM_UNUSED,
void *dummy3 SCM_UNUSED)
{
- if (!SCM_NULLP (self_centered_zombies))
+ if (!scm_is_null (self_centered_zombies))
{
SCM pair;
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);
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);
{
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);
{
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))))
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
"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;
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;
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);
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);
#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
#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
*/
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
{
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
{
#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
#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 */
#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);
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. */
#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;
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);
SCM ret, *loc;
SCM_VALIDATE_REST_ARGUMENT (lists);
- if (SCM_NULLP (lists))
+ if (scm_is_null (lists))
return SCM_EOL;
loc = &ret;
*loc = arg;
lists = SCM_CDR (lists);
- if (SCM_NULLP (lists))
+ if (scm_is_null (lists))
return ret;
if (!SCM_NULL_OR_NIL_P (arg))
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);
}
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);
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 {
{
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;
{
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;
SCM
scm_i_finite_list_copy (SCM list)
{
- if (!SCM_CONSP (list))
+ if (!scm_is_pair (list))
{
return 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);
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));
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))
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)))
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)))
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))
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)))
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)))
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))))
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))))
/* This simplifies the loop below a bit.
*/
- if (SCM_NULLP (extensions))
+ if (scm_is_null (extensions))
extensions = scm_listofnullstr;
buf.buf_len = 512;
/* 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;
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;
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);
}
{
/* 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))
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 */
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)
*/
{
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))
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);
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;
}
}
default:
- if (SCM_CONSP (x))
+ if (scm_is_pair (x))
return scm_class_pair;
else
return scm_class_unknown;
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;
}
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 */
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;
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;
}
{
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. */
"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;
/* 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);
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;
{
/* 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);
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);
/* 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;
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;
}
- if (!SCM_CONSP (args))
+ if (!scm_is_pair (args))
SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
scm_list_1 (SCM_MAKE_CHAR (*p)));
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:
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:
{
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))
+ 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
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);
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))
{
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);
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))
{
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
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
{
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))
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
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);
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))
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)
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
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
{
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;
{
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,
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;
}
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
{
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':
/* 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);
{
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));
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;
}
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))
while (1)
{
- if (SCM_NULLP (rest))
+ if (scm_is_null (rest))
return SCM_BOOL_F;
if (SCM_CHAR (SCM_CAAR (rest)) == c)
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;
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;
while (!scm_is_eq (cell, s))
{
- if (SCM_NULLP (s))
+ if (scm_is_null (s))
return list;
prev = s;
s = SCM_CDR (s);
/* 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;
{
/* 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),
}
/* 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
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),
/* 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) );
}
"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;
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));
}
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);
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;
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);
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
{
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);
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);
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;
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);
if (SCM_NULL_OR_NIL_P (items))
return items;
- if (SCM_CONSP (items))
+ if (scm_is_pair (items))
{
long len; /* list/vector length */
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))
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);
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))
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))
{
data += i;
- while (i > 0 && SCM_CONSP (chrs))
+ while (i > 0 && scm_is_pair (chrs))
{
SCM elt = SCM_CAR (chrs);
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:
}
tmp = ls;
- while (SCM_CONSP (tmp))
+ while (scm_is_pair (tmp))
{
len += scm_c_string_length (SCM_CAR (tmp));
tmp = SCM_CDR (tmp);
{
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)
}
break;
case GRAM_PREFIX:
- while (SCM_CONSP (tmp))
+ while (scm_is_pair (tmp))
{
if (del_len > 0)
append_string (&p, &len, delimiter);
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;
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;
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;
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;
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;
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;
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;
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;
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;
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);
SCM_VALIDATE_REST_ARGUMENT (rest);
- if (SCM_NULLP (rest))
+ if (scm_is_null (rest))
res = make_char_set (FUNC_NAME);
else
{
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);
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);
SCM_VALIDATE_REST_ARGUMENT (rest);
- if (SCM_NULLP (rest))
+ if (scm_is_null (rest))
res = make_char_set (FUNC_NAME);
else
{
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;
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);
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);
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);
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);
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);
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;
/* 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;
}
#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
#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))
}
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);
}
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;
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);
/* 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);
#endif
case 'u':
- if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
+ if ((prot != 'r' && prot != 'w') || scm_is_null (inits))
*mem = 0;
else
{
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
{
{
/* 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)
/* 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);
}
}
}
- while (!SCM_NULLP (newchain));
+ while (!scm_is_null (newchain));
return 0;
}
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);
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);
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))
{
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);
}
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);
{
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))
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);
{
/* 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));
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);
/* 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);
/* 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);
break;
case scm_tc7_vector:
case scm_tc7_wvect:
- protp = SCM_NULLP(prot);
+ protp = scm_is_null(prot);
break;
default:
/* no default */
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);
k--;
s++;
}
- if (k != 0 || !SCM_NULLP (args))
+ if (k != 0 || !scm_is_null (args))
scm_error_num_args_subr (what);
return pos;
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))
}
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;
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);
#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);
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)
pos = SCM_ARRAY_BASE (v);
if (!k)
{
- SCM_ASRTGO (SCM_NULLP (ind), wna);
+ SCM_ASRTGO (scm_is_null (ind), wna);
ind = SCM_INUM0;
}
else
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);
}
}
if (SCM_IMP (v))
{
- SCM_ASRTGO (SCM_NULLP (args), badarg);
+ SCM_ASRTGO (scm_is_null (args), badarg);
return v;
}
else if (SCM_ARRAYP (v))
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
{
switch SCM_TYP7 (v)
{
default:
- if (SCM_NULLP (args))
+ if (scm_is_null (args))
return v;
badarg:
SCM_WRONG_TYPE_ARG (1, v);
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
}
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);
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;
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)
+
+
\f
#define SCM_VALIDATE_REST_ARGUMENT(x) \
} \
} 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 { \
#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) \
#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")
{
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))
{
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));
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))
{
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;
HCoop / bpt / guile.git / commitdiff