summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/async.c14
-rw-r--r--libguile/debug.c9
-rw-r--r--libguile/eq.c4
-rw-r--r--libguile/eval.c89
-rw-r--r--libguile/eval.h10
-rw-r--r--libguile/fluids.c6
-rw-r--r--libguile/gc.c22
-rw-r--r--libguile/guardians.c8
-rw-r--r--libguile/hashtab.c63
-rw-r--r--libguile/keywords.c8
-rw-r--r--libguile/macros.h12
-rw-r--r--libguile/ports.c2
-rw-r--r--libguile/ports.h12
-rw-r--r--libguile/print.c26
-rw-r--r--libguile/procs.h12
-rw-r--r--libguile/properties.c24
-rw-r--r--libguile/smob.c4
-rw-r--r--libguile/tags.h18
-rw-r--r--libguile/throw.c8
-rw-r--r--libguile/variable.c41
-rw-r--r--libguile/variable.h10
-rw-r--r--libguile/vectors.c19
-rw-r--r--libguile/weaks.c17
23 files changed, 218 insertions, 220 deletions
diff --git a/libguile/async.c b/libguile/async.c
index e57b821ae..ae3f5dcaf 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -130,7 +130,7 @@ scm_asyncs_pending ()
{
SCM pos;
pos = scm_asyncs;
- while (pos != SCM_EOL)
+ while (!SCM_NULLP (pos))
{
SCM a = SCM_CAR (pos);
if (ASYNC_GOT_IT (a))
@@ -300,14 +300,8 @@ SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0,
"add it to the system's list of active async objects.")
#define FUNC_NAME s_scm_system_async
{
- SCM it;
- SCM list;
-
- it = scm_async (thunk);
- SCM_NEWCELL (list);
- SCM_SETCAR (list, it);
- SCM_SETCDR (list, scm_asyncs);
- scm_asyncs = list;
+ SCM it = scm_async (thunk);
+ scm_asyncs = scm_cons (it, scm_asyncs);
return it;
}
#undef FUNC_NAME
diff --git a/libguile/debug.c b/libguile/debug.c
index 7c1cf8bc4..3b4f77fa9 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -504,11 +504,10 @@ SCM_REGISTER_PROC (s_reverse_lookup, "reverse-lookup", 2, 0, 0, scm_reverse_look
SCM
scm_reverse_lookup (SCM env, SCM data)
{
- SCM names, values;
- while (SCM_NIMP (env) && SCM_SLOPPY_CONSP (SCM_CAR (env)))
+ while (SCM_CONSP (env) && SCM_CONSP (SCM_CAR (env)))
{
- names = SCM_CAAR (env);
- values = SCM_CDAR (env);
+ SCM names = SCM_CAAR (env);
+ SCM values = SCM_CDAR (env);
while (SCM_CONSP (names))
{
if (SCM_EQ_P (SCM_CAR (values), data))
@@ -516,7 +515,7 @@ scm_reverse_lookup (SCM env, SCM data)
names = SCM_CDR (names);
values = SCM_CDR (values);
}
- if (! SCM_NULLP (names) && SCM_EQ_P (values, data))
+ if (!SCM_NULLP (names) && SCM_EQ_P (values, data))
return names;
env = SCM_CDR (env);
}
diff --git a/libguile/eq.c b/libguile/eq.c
index 8eda34047..0bb7f0840 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -136,7 +136,7 @@ SCM_DEFINE1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
return SCM_BOOL_F;
if (SCM_IMP (y))
return SCM_BOOL_F;
- if (SCM_SLOPPY_CONSP (x) && SCM_SLOPPY_CONSP (y))
+ if (SCM_CONSP (x) && SCM_CONSP (y))
{
if (SCM_FALSEP (scm_equal_p (SCM_CAR (x), SCM_CAR (y))))
return SCM_BOOL_F;
diff --git a/libguile/eval.c b/libguile/eval.c
index 0d3c620fc..67d90345f 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -150,7 +150,7 @@ char *alloca ();
? *scm_lookupcar (x, env, 1) \
: SCM_CEVAL (SCM_CAR (x), env))
-#define EVALCAR(x, env) (SCM_NCELLP (SCM_CAR (x)) \
+#define EVALCAR(x, env) (!SCM_CELLP (SCM_CAR (x)) \
? (SCM_IMP (SCM_CAR (x)) \
? SCM_EVALIM (SCM_CAR (x), env) \
: SCM_GLOC_VAL (SCM_CAR (x))) \
@@ -790,11 +790,11 @@ scm_m_quasiquote (SCM xorig, SCM env)
static SCM
-iqq (SCM form,SCM env,int depth)
+iqq (SCM form, SCM env, int depth)
{
SCM tmp;
int edepth = depth;
- if (SCM_IMP(form))
+ if (SCM_IMP (form))
return form;
if (SCM_VECTORP (form))
{
@@ -805,7 +805,7 @@ iqq (SCM form,SCM env,int depth)
tmp = scm_cons (data[i], tmp);
return scm_vector (iqq (tmp, env, depth));
}
- if (SCM_NCONSP(form))
+ if (!SCM_CONSP (form))
return form;
tmp = SCM_CAR (form);
if (SCM_EQ_P (scm_sym_quasiquote, tmp))
@@ -824,7 +824,7 @@ iqq (SCM form,SCM env,int depth)
return evalcar (form, env);
return scm_cons2 (tmp, iqq (SCM_CAR (form), env, depth), SCM_EOL);
}
- if (SCM_NIMP (tmp) && (SCM_EQ_P (scm_sym_uq_splicing, SCM_CAR (tmp))))
+ if (SCM_CONSP (tmp) && (SCM_EQ_P (scm_sym_uq_splicing, SCM_CAR (tmp))))
{
tmp = SCM_CDR (tmp);
if (0 == --edepth)
@@ -876,10 +876,11 @@ scm_m_define (SCM x, SCM env)
/* Only the first definition determines the name. */
&& SCM_FALSEP (scm_procedure_property (arg1, scm_sym_name)))
scm_set_procedure_property_x (arg1, scm_sym_name, proc);
- else if (SCM_TYP16 (arg1) == scm_tc16_macro
- && !SCM_EQ_P (SCM_CDR (arg1), arg1))
+ else if (SCM_MACROP (arg1)
+ /* Dirk::FIXME: Does the following test make sense? */
+ && !SCM_EQ_P (SCM_MACRO_CODE (arg1), arg1))
{
- arg1 = SCM_CDR (arg1);
+ arg1 = SCM_MACRO_CODE (arg1);
goto proc;
}
}
@@ -1144,19 +1145,17 @@ scm_m_at_call_with_values (SCM xorig, SCM env)
SCM
scm_m_expand_body (SCM xorig, SCM env)
{
- SCM form, x = SCM_CDR (xorig), defs = SCM_EOL;
+ SCM x = SCM_CDR (xorig), defs = SCM_EOL;
char *what = SCM_ISYMCHARS (SCM_CAR (xorig)) + 2;
while (SCM_NIMP (x))
{
- form = SCM_CAR (x);
- if (SCM_IMP (form) || SCM_NCONSP (form))
- break;
- if (SCM_IMP (SCM_CAR (form)))
+ SCM form = SCM_CAR (x);
+ if (!SCM_CONSP (form))
break;
if (!SCM_SYMBOLP (SCM_CAR (form)))
break;
-
+
form = scm_macroexp (scm_cons_source (form,
SCM_CAR (form),
SCM_CDR (form)),
@@ -1165,9 +1164,9 @@ scm_m_expand_body (SCM xorig, SCM env)
if (SCM_EQ_P (SCM_IM_DEFINE, SCM_CAR (form)))
{
defs = scm_cons (SCM_CDR (form), defs);
- x = SCM_CDR(x);
+ x = SCM_CDR (x);
}
- else if (SCM_NIMP(defs))
+ else if (!SCM_IMP (defs))
{
break;
}
@@ -1177,7 +1176,7 @@ scm_m_expand_body (SCM xorig, SCM env)
}
else
{
- x = scm_cons (form, SCM_CDR(x));
+ x = scm_cons (form, SCM_CDR (x));
break;
}
}
@@ -1229,13 +1228,11 @@ scm_macroexp (SCM x, SCM env)
/* Only handle memoizing macros. `Acros' and `macros' are really
special forms and should not be evaluated here. */
- if (SCM_IMP (proc)
- || scm_tc16_macro != SCM_TYP16 (proc)
- || (SCM_CELL_WORD_0 (proc) >> 16) != 2)
+ if (!SCM_MACROP (proc) || SCM_MACRO_TYPE (proc) != 2)
return x;
unmemocar (x, env);
- res = scm_apply (SCM_CDR (proc), x, scm_cons (env, scm_listofnull));
+ res = scm_apply (SCM_MACRO_CODE (proc), x, scm_cons (env, scm_listofnull));
if (scm_ilength (res) <= 0)
res = scm_cons2 (SCM_IM_BEGIN, res, SCM_EOL);
@@ -1510,7 +1507,7 @@ SCM
scm_eval_args (SCM l, SCM env, SCM proc)
{
SCM results = SCM_EOL, *lloc = &results, res;
- while (SCM_NIMP (l))
+ while (!SCM_IMP (l))
{
#ifdef SCM_CAUTIOUS
if (SCM_CONSP (l))
@@ -1538,7 +1535,7 @@ scm_eval_args (SCM l, SCM env, SCM proc)
l = SCM_CDR (l);
}
#ifdef SCM_CAUTIOUS
- if (SCM_NNULLP (l))
+ if (!SCM_NULLP (l))
{
wrongnumargs:
scm_wrong_num_args (proc);
@@ -1733,7 +1730,7 @@ SCM
scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
{
SCM *results = lloc, res;
- while (SCM_NIMP (l))
+ while (!SCM_IMP (l))
{
#ifdef SCM_CAUTIOUS
if (SCM_CONSP (l))
@@ -1761,7 +1758,7 @@ scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
l = SCM_CDR (l);
}
#ifdef SCM_CAUTIOUS
- if (SCM_NNULLP (l))
+ if (!SCM_NULLP (l))
{
wrongnumargs:
scm_wrong_num_args (proc);
@@ -1943,11 +1940,11 @@ dispatch:
begin:
/* If we are on toplevel with a lookup closure, we need to sync
with the current module. */
- if (SCM_CONSP(env) && !SCM_CONSP(SCM_CAR(env)))
+ if (SCM_CONSP (env) && !SCM_CONSP (SCM_CAR (env)))
{
t.arg1 = x;
UPDATE_TOPLEVEL_ENV (env);
- while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+ while (!SCM_NULLP (t.arg1 = SCM_CDR (t.arg1)))
{
EVALCAR (x, env);
x = t.arg1;
@@ -1964,7 +1961,7 @@ dispatch:
x = SCM_CDR (x);
nontoplevel_begin:
t.arg1 = x;
- while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+ while (!SCM_NULLP (t.arg1 = SCM_CDR (t.arg1)))
{
if (SCM_IMP (SCM_CAR (x)))
{
@@ -1974,7 +1971,7 @@ dispatch:
goto nontoplevel_begin;
}
else
- SCM_EVALIM2 (SCM_CAR(x));
+ SCM_EVALIM2 (SCM_CAR (x));
}
else
SCM_CEVAL (SCM_CAR (x), env);
@@ -1982,7 +1979,7 @@ dispatch:
}
carloop: /* scm_eval car of last form in list */
- if (SCM_NCELLP (SCM_CAR (x)))
+ if (!SCM_CELLP (SCM_CAR (x)))
{
x = SCM_CAR (x);
RETURN (SCM_IMP (x) ? SCM_EVALIM (x, env) : SCM_GLOC_VAL (x))
@@ -2026,18 +2023,18 @@ dispatch:
case SCM_BIT8(SCM_IM_COND):
- while (SCM_NIMP (x = SCM_CDR (x)))
+ while (!SCM_IMP (x = SCM_CDR (x)))
{
proc = SCM_CAR (x);
t.arg1 = EVALCAR (proc, env);
if (SCM_NFALSEP (t.arg1))
{
x = SCM_CDR (proc);
- if SCM_NULLP (x)
+ if (SCM_NULLP (x))
{
RETURN (t.arg1)
}
- if (! SCM_EQ_P (scm_sym_arrow, SCM_CAR (x)))
+ if (!SCM_EQ_P (scm_sym_arrow, SCM_CAR (x)))
{
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto begin;
@@ -2147,10 +2144,10 @@ dispatch:
case SCM_BIT8(SCM_IM_OR):
x = SCM_CDR (x);
t.arg1 = x;
- while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+ while (!SCM_NULLP (t.arg1 = SCM_CDR (t.arg1)))
{
x = EVALCAR (x, env);
- if (SCM_NFALSEP (x))
+ if (!SCM_FALSEP (x))
{
RETURN (x);
}
@@ -2576,7 +2573,7 @@ dispatch:
unmemocar (x, env);
goto badfun;
}
- if (scm_tc16_macro == SCM_TYP16 (proc))
+ if (SCM_MACROP (proc))
{
unmemocar (x, env);
@@ -2586,19 +2583,19 @@ dispatch:
application frames can be deleted from the backtrace. */
SCM_SET_MACROEXP (debug);
#endif
- t.arg1 = SCM_APPLY (SCM_CDR (proc), x,
+ t.arg1 = SCM_APPLY (SCM_MACRO_CODE (proc), x,
scm_cons (env, scm_listofnull));
#ifdef DEVAL
SCM_CLEAR_MACROEXP (debug);
#endif
- switch (SCM_CELL_WORD_0 (proc) >> 16)
+ switch (SCM_MACRO_TYPE (proc))
{
case 2:
if (scm_ilength (t.arg1) <= 0)
t.arg1 = scm_cons2 (SCM_IM_BEGIN, t.arg1, SCM_EOL);
#ifdef DEVAL
- if (!SCM_CLOSUREP (SCM_CDR (proc)))
+ if (!SCM_CLOSUREP (SCM_MACRO_CODE (proc)))
{
SCM_DEFER_INTS;
SCM_SETCAR (x, SCM_CAR (t.arg1));
@@ -2626,7 +2623,7 @@ dispatch:
}
else
proc = SCM_CEVAL (SCM_CAR (x), env);
- SCM_ASRTGO (SCM_NIMP (proc), badfun);
+ SCM_ASRTGO (!SCM_IMP (proc), badfun);
#ifndef SCM_RECKLESS
#ifdef SCM_CAUTIOUS
checkargs:
@@ -2635,19 +2632,19 @@ dispatch:
{
arg2 = SCM_CAR (SCM_CODE (proc));
t.arg1 = SCM_CDR (x);
- while (SCM_NIMP (arg2))
+ while (!SCM_IMP (arg2))
{
- if (SCM_NCONSP (arg2))
+ if (!SCM_CONSP (arg2))
goto evapply;
if (SCM_IMP (t.arg1))
goto umwrongnumargs;
arg2 = SCM_CDR (arg2);
t.arg1 = SCM_CDR (t.arg1);
}
- if (SCM_NNULLP (t.arg1))
+ if (!SCM_NULLP (t.arg1))
goto umwrongnumargs;
}
- else if (scm_tc16_macro == SCM_TYP16 (proc))
+ else if (SCM_MACROP (proc))
goto handle_a_macro;
#endif
}
@@ -3778,7 +3775,7 @@ promise_print (SCM exp, SCM port, scm_print_state *pstate)
int writingp = SCM_WRITINGP (pstate);
scm_puts ("#<promise ", port);
SCM_SET_WRITINGP (pstate, 1);
- scm_iprin1 (SCM_CDR (exp), port, pstate);
+ scm_iprin1 (SCM_CELL_WORD_1 (exp), port, pstate);
SCM_SET_WRITINGP (pstate, writingp);
scm_putc ('>', port);
return !0;
diff --git a/libguile/eval.h b/libguile/eval.h
index ec387a4dd..60c5d737a 100644
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -1,8 +1,8 @@
/* classes: h_files */
-#ifndef EVALH
-#define EVALH
-/* Copyright (C) 1995, 1996 ,1998, 1999, 2000 Free Software Foundation, Inc.
+#ifndef SCM_EVAL_H
+#define SCM_EVAL_H
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -180,8 +180,6 @@ extern SCM scm_sym_args;
extern SCM scm_f_apply;
-extern scm_bits_t scm_tc16_macro;
-
/* A resolved global variable reference in the CAR position
* of a list is stored (in code only) as a pointer to a pair with a
* tag of 1. This is called a "gloc".
@@ -259,7 +257,7 @@ extern SCM scm_eval_x (SCM exp, SCM module);
extern void scm_init_eval (void);
-#endif /* EVALH */
+#endif /* SCM_EVAL_H */
/*
Local Variables:
diff --git a/libguile/fluids.c b/libguile/fluids.c
index a52b2c8df..a76b05c76 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -183,7 +183,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
void
scm_swap_fluids (SCM fluids, SCM vals)
{
- while (SCM_NIMP (fluids))
+ while (!SCM_NULLP (fluids))
{
SCM fl = SCM_CAR (fluids);
SCM old_val = scm_fluid_ref (fl);
@@ -200,7 +200,7 @@ same fluid appears multiple times in the fluids list. */
void
scm_swap_fluids_reverse (SCM fluids, SCM vals)
{
- if (SCM_NIMP (fluids))
+ if (!SCM_NULLP (fluids))
{
SCM fl, old_val;
diff --git a/libguile/gc.c b/libguile/gc.c
index ebcddca09..a4336789f 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -1183,8 +1183,8 @@ gc_mark_loop_first_time:
ptr = SCM_CDR (ptr);
goto gc_mark_loop;
case scm_tc7_pws:
- RECURSE (SCM_CELL_OBJECT_2 (ptr));
- ptr = SCM_CDR (ptr);
+ RECURSE (SCM_SETTER (ptr));
+ ptr = SCM_PROCEDURE (ptr);
goto gc_mark_loop;
case scm_tcs_cons_gloc:
{
@@ -1241,13 +1241,13 @@ gc_mark_loop_first_time:
}
break;
case scm_tcs_closures:
- if (SCM_IMP (SCM_CDR (ptr)))
+ if (SCM_IMP (SCM_ENV (ptr)))
{
ptr = SCM_CLOSCAR (ptr);
goto gc_mark_nimp;
}
RECURSE (SCM_CLOSCAR (ptr));
- ptr = SCM_CDR (ptr);
+ ptr = SCM_ENV (ptr);
goto gc_mark_nimp;
case scm_tc7_vector:
i = SCM_VECTOR_LENGTH (ptr);
@@ -1541,8 +1541,8 @@ gc_sweep_freelist_finish (scm_freelist_t *freelist)
if (!SCM_NULLP (freelist->cells))
{
SCM c = freelist->cells;
- SCM_SETCAR (c, SCM_CDR (c));
- SCM_SETCDR (c, SCM_EOL);
+ SCM_SET_CELL_WORD_0 (c, SCM_FREE_CELL_CDR (c));
+ SCM_SET_CELL_WORD_1 (c, SCM_EOL);
freelist->collected +=
freelist->span * (freelist->cluster_size - freelist->left_to_collect);
}
@@ -1733,7 +1733,7 @@ scm_gc_sweep ()
SCM_SETSTREAM (scmptr, 0);
scm_remove_from_port_table (scmptr);
scm_gc_ports_collected++;
- SCM_SETAND_CAR (scmptr, ~SCM_OPN);
+ SCM_CLR_PORT_OPEN_FLAG (scmptr);
}
break;
case scm_tc7_smob:
@@ -1770,7 +1770,7 @@ scm_gc_sweep ()
if (!--left_to_collect)
{
- SCM_SETCAR (scmptr, nfreelist);
+ SCM_SET_CELL_WORD_0 (scmptr, nfreelist);
*freelist->clustertail = scmptr;
freelist->clustertail = SCM_CDRLOC (scmptr);
@@ -2130,7 +2130,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
}
SCM_SET_CELL_TYPE (scmptr, scm_tc_free_cell);
- SCM_SETCDR (scmptr, PTR2SCM (nxt));
+ SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (nxt));
ptr = nxt;
}
@@ -2463,7 +2463,7 @@ scm_unprotect_object (SCM obj)
handle = scm_hashq_get_handle (scm_protects, obj);
- if (SCM_IMP (handle))
+ if (SCM_FALSEP (handle))
{
fprintf (stderr, "scm_unprotect_object called on unprotected object\n");
abort ();
diff --git a/libguile/guardians.c b/libguile/guardians.c
index fbecd9d9c..f7eac2817 100644
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -89,8 +89,8 @@ typedef struct tconc_t
#define TCONC_IN(tc, obj, pair) \
do { \
SCM_SETCAR ((tc).tail, obj); \
- SCM_SETCAR (pair, SCM_BOOL_F); \
- SCM_SETCDR (pair, SCM_EOL); \
+ SCM_SET_CELL_WORD_0 (pair, SCM_BOOL_F); \
+ SCM_SET_CELL_WORD_1 (pair, SCM_EOL); \
SCM_SETCDR ((tc).tail, pair); \
(tc).tail = pair; \
} while (0)
@@ -258,7 +258,7 @@ scm_guard (SCM guardian, SCM obj, int throw_p)
if (GREEDY_P (g))
{
- if (SCM_NFALSEP (scm_hashq_get_handle
+ if (!SCM_FALSEP (scm_hashq_get_handle
(greedily_guarded_whash, obj)))
{
SCM_ALLOW_INTS;
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 54500fdfe..9bcc16826 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -60,21 +60,24 @@ scm_c_make_hash_table (unsigned long k)
return scm_c_make_vector (k, SCM_EOL);
}
+
SCM
scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
+#define FUNC_NAME "scm_hash_fn_get_handle"
{
unsigned int k;
SCM h;
- SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle");
+ SCM_VALIDATE_VECTOR (1, table);
if (SCM_VECTOR_LENGTH (table) == 0)
- return SCM_EOL;
+ return SCM_BOOL_F;
k = hash_fn (obj, SCM_VECTOR_LENGTH (table), closure);
if (k >= SCM_VECTOR_LENGTH (table))
scm_out_of_range ("hash_fn_get_handle", scm_ulong2num (k));
h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
return h;
}
+#undef FUNC_NAME
SCM
@@ -116,13 +119,11 @@ SCM
scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned int (*hash_fn)(),
SCM (*assoc_fn)(),void * closure)
{
- SCM it;
-
- it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
- if (SCM_IMP (it))
- return dflt;
- else
+ SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
+ if (SCM_CONSP (it))
return SCM_CDR (it);
+ else
+ return dflt;
}
@@ -165,16 +166,14 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn
SCM_DEFINE (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0,
- (SCM table, SCM obj),
- "This procedure is similar to its @code{-ref} cousin, but returns a\n"
- "@dfn{handle} from the hash table rather than the value associated with\n"
- "@var{key}. By convention, a handle in a hash table is the pair which\n"
- "associates a key with a value. Where @code{hashq-ref table key} returns\n"
- "only a @code{value}, @code{hashq-get-handle table key} returns the pair\n"
- "@code{(key . value)}.")
+ (SCM table, SCM key),
+ "This procedure returns the @code{(key . value)} pair from the\n"
+ "hash table @var{table}. If @var{table} does not hold an\n"
+ "associated value for @var{key}, @code{#f} is returned.\n"
+ "Uses @code{eq?} for equality testing.")
#define FUNC_NAME s_scm_hashq_get_handle
{
- return scm_hash_fn_get_handle (table, obj, scm_ihashq, scm_sloppy_assq, 0);
+ return scm_hash_fn_get_handle (table, key, scm_ihashq, scm_sloppy_assq, 0);
}
#undef FUNC_NAME
@@ -233,16 +232,14 @@ SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0,
SCM_DEFINE (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0,
- (SCM table, SCM obj),
- "This procedure is similar to its @code{-ref} cousin, but returns a\n"
- "@dfn{handle} from the hash table rather than the value associated with\n"
- "@var{key}. By convention, a handle in a hash table is the pair which\n"
- "associates a key with a value. Where @code{hashv-ref table key} returns\n"
- "only a @code{value}, @code{hashv-get-handle table key} returns the pair\n"
- "@code{(key . value)}.")
+ (SCM table, SCM key),
+ "This procedure returns the @code{(key . value)} pair from the\n"
+ "hash table @var{table}. If @var{table} does not hold an\n"
+ "associated value for @var{key}, @code{#f} is returned.\n"
+ "Uses @code{eqv?} for equality testing.")
#define FUNC_NAME s_scm_hashv_get_handle
{
- return scm_hash_fn_get_handle (table, obj, scm_ihashv, scm_sloppy_assv, 0);
+ return scm_hash_fn_get_handle (table, key, scm_ihashv, scm_sloppy_assv, 0);
}
#undef FUNC_NAME
@@ -299,16 +296,14 @@ SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
SCM_DEFINE (scm_hash_get_handle, "hash-get-handle", 2, 0, 0,
- (SCM table, SCM obj),
- "This procedure is similar to its @code{-ref} cousin, but returns a\n"
- "@dfn{handle} from the hash table rather than the value associated with\n"
- "@var{key}. By convention, a handle in a hash table is the pair which\n"
- "associates a key with a value. Where @code{hash-ref table key} returns\n"
- "only a @code{value}, @code{hash-get-handle table key} returns the pair\n"
- "@code{(key . value)}.")
+ (SCM table, SCM key),
+ "This procedure returns the @code{(key . value)} pair from the\n"
+ "hash table @var{table}. If @var{table} does not hold an\n"
+ "associated value for @var{key}, @code{#f} is returned.\n"
+ "Uses @code{equal?} for equality testing.")
#define FUNC_NAME s_scm_hash_get_handle
{
- return scm_hash_fn_get_handle (table, obj, scm_ihash, scm_sloppy_assoc, 0);
+ return scm_hash_fn_get_handle (table, key, scm_ihash, scm_sloppy_assoc, 0);
}
#undef FUNC_NAME
@@ -543,7 +538,7 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
for (i = 0; i < n; ++i)
{
SCM ls = SCM_VELTS (table)[i], handle;
- while (SCM_NNULLP (ls))
+ while (!SCM_NULLP (ls))
{
SCM_ASSERT (SCM_CONSP (ls),
table, SCM_ARG1, s_scm_hash_fold);
diff --git a/libguile/keywords.c b/libguile/keywords.c
index 84d942dfa..3509314ea 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -112,7 +112,7 @@ SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0,
"Returns @code{#t} if the argument @var{obj} is a keyword, else @code{#f}.")
#define FUNC_NAME s_scm_keyword_p
{
- return SCM_BOOL(SCM_KEYWORDP (obj));
+ return SCM_BOOL (SCM_KEYWORDP (obj));
}
#undef FUNC_NAME
@@ -123,8 +123,8 @@ SCM_DEFINE (scm_keyword_dash_symbol, "keyword-dash-symbol", 1, 0, 0,
"This is the inverse of @code{make-keyword-from-dash-symbol}.")
#define FUNC_NAME s_scm_keyword_dash_symbol
{
- SCM_VALIDATE_KEYWORD (1,keyword);
- return SCM_CDR (keyword);
+ SCM_VALIDATE_KEYWORD (1, keyword);
+ return SCM_KEYWORDSYM (keyword);
}
#undef FUNC_NAME
diff --git a/libguile/macros.h b/libguile/macros.h
index 92436fe95..ccc80dffd 100644
--- a/libguile/macros.h
+++ b/libguile/macros.h
@@ -1,8 +1,8 @@
/* classes: h_files */
-#ifndef MACROSH
-#define MACROSH
-/* Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+#ifndef SCM_MACROS_H
+#define SCM_MACROS_H
+/* Copyright (C) 1998,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -51,6 +51,10 @@
#define SCM_ASSYNT(_cond, _msg, _subr) \
if (!(_cond)) scm_misc_error (_subr, _msg, SCM_EOL);
+#define SCM_MACROP(x) SCM_TYP16_PREDICATE (scm_tc16_macro, (x))
+#define SCM_MACRO_TYPE(m) (SCM_CELL_WORD_0 (m) >> 16)
+#define SCM_MACRO_CODE(m) SCM_CELL_OBJECT_1 (m)
+
extern scm_bits_t scm_tc16_macro;
extern SCM scm_makacro (SCM code);
@@ -65,7 +69,7 @@ extern SCM scm_make_synt (const char *name,
SCM (*fcn) ());
extern void scm_init_macros (void);
-#endif /* MACROSH */
+#endif /* SCM_MACROS_H */
/*
Local Variables:
diff --git a/libguile/ports.c b/libguile/ports.c
index 6884811d1..c480b7fc8 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -663,7 +663,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
else
rv = 0;
scm_remove_from_port_table (port);
- SCM_SETAND_CAR (port, ~SCM_OPN);
+ SCM_CLR_PORT_OPEN_FLAG (port);
return SCM_NEGATE_BOOL (rv < 0);
}
#undef FUNC_NAME
diff --git a/libguile/ports.h b/libguile/ports.h
index fabf744eb..c8c96aa5b 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -1,8 +1,8 @@
/* classes: h_files */
-#ifndef PORTSH
-#define PORTSH
-/* Copyright (C) 1995,1996,1997,1998,1999, 2000, 2001 Free Software Foundation, Inc.
+#ifndef SCM_PORTS_H
+#define SCM_PORTS_H
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -152,7 +152,7 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
#define SCM_BUF0 (8L<<16) /* Is it unbuffered? */
#define SCM_BUFLINE (64L<<16) /* Is it line-buffered? */
-#define SCM_PORTP(x) (SCM_NIMP(x) && (SCM_TYP7(x)==scm_tc7_port))
+#define SCM_PORTP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_port))
#define SCM_OPPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN)))
#define SCM_OPINPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG)))
#define SCM_OPOUTPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG)))
@@ -164,6 +164,8 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
&& (((0x7f | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_WRTNG)))
#define SCM_OPENP(x) (SCM_NIMP(x) && (SCM_OPN & SCM_CELL_WORD_0 (x)))
#define SCM_CLOSEDP(x) (!SCM_OPENP(x))
+#define SCM_CLR_PORT_OPEN_FLAG(p) \
+ SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN)
#define SCM_PTAB_ENTRY(x) ((scm_port *) SCM_CELL_WORD_1 (x))
#define SCM_SETPTAB_ENTRY(x,ent) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (ent)))
@@ -324,7 +326,7 @@ extern SCM scm_close_all_ports_except (SCM ports);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
-#endif /* PORTSH */
+#endif /* SCM_PORTS_H */
/*
Local Variables:
diff --git a/libguile/print.c b/libguile/print.c
index 0c2adba12..b1f59d249 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-1999, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -254,8 +254,8 @@ scm_free_print_state (SCM print_state)
pstate->revealed = 0;
SCM_NEWCELL (handle);
SCM_DEFER_INTS;
- SCM_SETCAR (handle, print_state);
- SCM_SETCDR (handle, SCM_CDR (print_state_pool));
+ SCM_SET_CELL_WORD_0 (handle, print_state);
+ SCM_SET_CELL_WORD_1 (handle, SCM_CDR (print_state_pool));
SCM_SETCDR (print_state_pool, handle);
SCM_ALLOW_INTS;
}
@@ -419,7 +419,7 @@ taloop:
exp, port, pstate)))
{
SCM name, code, env;
- if (SCM_TYP16 (exp) == scm_tc16_macro)
+ if (SCM_MACROP (exp))
{
/* Printing a macro. */
prinmacro:
@@ -806,10 +806,11 @@ scm_ipruk (char *hdr, SCM ptr, SCM port)
scm_putc ('>', port);
}
-/* Print a list.
- */
-
+/* Print a list. The list may be either a list of ordinary data, or it may be
+ a list that represents code. Lists that represent code may contain gloc
+ cells.
+ */
void
scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
{
@@ -837,13 +838,10 @@ 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);
- exp = SCM_CDR (exp);
- for (; SCM_NIMP (exp); exp = SCM_CDR (exp))
+ for (exp = SCM_CDR (exp); SCM_ECONSP (exp); exp = SCM_CDR (exp))
{
register int i;
- if (SCM_NECONSP (exp))
- break;
for (i = floor; i >= 0; --i)
if (SCM_EQ_P (pstate->ref_stack[i], exp))
goto circref;
@@ -852,7 +850,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
/* CHECK_INTS; */
scm_iprin1 (SCM_CAR (exp), port, pstate);
}
- if (SCM_NNULLP (exp))
+ if (!SCM_NULLP (exp))
{
scm_puts (" . ", port);
scm_iprin1 (exp, port, pstate);
@@ -869,12 +867,10 @@ fancy_printing:
scm_iprin1 (SCM_CAR (exp), port, pstate);
exp = SCM_CDR (exp); --n;
- for (; SCM_NIMP (exp); exp = SCM_CDR (exp))
+ for (; SCM_ECONSP (exp); exp = SCM_CDR (exp))
{
register unsigned long i;
- if (SCM_NECONSP (exp))
- break;
for (i = 0; i < pstate->top; ++i)
if (SCM_EQ_P (pstate->ref_stack[i], exp))
goto fancy_circref;
diff --git a/libguile/procs.h b/libguile/procs.h
index 3e332f0ab..7007b3d2b 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -1,8 +1,8 @@
/* classes: h_files */
-#ifndef PROCSH
-#define PROCSH
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+#ifndef SCM_PROCS_H
+#define SCM_PROCS_H
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -97,8 +97,8 @@ typedef struct
#define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p)
#define SCM_SETCODE(x, e) (SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (scm_cons ((e), SCM_EOL)) \
+ scm_tc3_closure))
-#define SCM_ENV(x) SCM_CDR(x)
-#define SCM_SETENV(x, e) SCM_SETCDR (x, e)
+#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_EQ_P (scm_procedure_p (SCM_CAR (ENV)), SCM_BOOL_T)))
/* Procedure-with-setter
@@ -194,7 +194,7 @@ extern SCM scm_make_cclo (SCM proc, SCM len);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
-#endif /* PROCSH */
+#endif /* SCM_PROCS_H */
/*
Local Variables:
diff --git a/libguile/properties.c b/libguile/properties.c
index b33343862..6d9d8031b 100644
--- a/libguile/properties.c
+++ b/libguile/properties.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -72,6 +72,7 @@ SCM_DEFINE (scm_primitive_make_property, "primitive-make-property", 1, 0, 0,
}
#undef FUNC_NAME
+
SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
(SCM prop, SCM obj),
"Return the property @var{prop} of @var{obj}. When no value\n"
@@ -83,22 +84,24 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
"default value of @var{prop}.")
#define FUNC_NAME s_scm_primitive_property_ref
{
- SCM h, assoc;
+ SCM h;
SCM_VALIDATE_CONS (SCM_ARG1, prop);
h = scm_hashq_get_handle (scm_properties_whash, obj);
- assoc = (SCM_NIMP (h) ? scm_assq (prop, SCM_CDR (h)) : SCM_BOOL_F);
- if (SCM_NIMP (assoc))
- return SCM_CDR (assoc);
+ if (!SCM_FALSEP (h))
+ {
+ SCM assoc = scm_assq (prop, SCM_CDR (h));
+ if (!SCM_FALSEP (assoc))
+ return SCM_CDR (assoc);
+ }
if (SCM_FALSEP (SCM_CAR (prop)))
return SCM_BOOL_F;
else
{
- SCM val = scm_apply (SCM_CAR (prop),
- SCM_LIST2 (prop, obj), SCM_EOL);
- if (SCM_IMP (h))
+ SCM val = scm_apply (SCM_CAR (prop), SCM_LIST2 (prop, obj), SCM_EOL);
+ if (SCM_FALSEP (h))
h = scm_hashq_create_handle_x (scm_properties_whash, obj, SCM_EOL);
SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
return val;
@@ -106,6 +109,7 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
}
#undef FUNC_NAME
+
SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
(SCM prop, SCM obj, SCM val),
"Associate @var{code} with @var{prop} and @var{obj}.")
@@ -126,6 +130,7 @@ SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
}
#undef FUNC_NAME
+
SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
(SCM prop, SCM obj),
"Remove any value associated with @var{prop} and @var{obj}.")
@@ -134,12 +139,13 @@ SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
SCM h;
SCM_VALIDATE_CONS (SCM_ARG1, prop);
h = scm_hashq_get_handle (scm_properties_whash, obj);
- if (SCM_NIMP (h))
+ if (!SCM_FALSEP (h))
SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+
void
scm_init_properties ()
{
diff --git a/libguile/smob.c b/libguile/smob.c
index f7d00e910..6cd557cc7 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -88,9 +88,11 @@ scm_mark0 (SCM ptr)
}
SCM
+/* Dirk::FIXME: The name markcdr is misleading, since the term cdr should only
+ be used for real pairs. */
scm_markcdr (SCM ptr)
{
- return SCM_CDR (ptr);
+ return SCM_CELL_OBJECT_1 (ptr);
}
/* {Free}
diff --git a/libguile/tags.h b/libguile/tags.h
index 846d27000..0670c16f7 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -1,8 +1,8 @@
/* classes: h_files */
-#ifndef TAGSH
-#define TAGSH
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
+#ifndef SCM_TAGS_H
+#define SCM_TAGS_H
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -271,10 +271,7 @@ typedef long scm_bits_t;
* stored in the SCM_CAR of a non-immediate object have a 1 in bit 1:
*/
-#define SCM_SLOPPY_CONSP(x) ((1 & SCM_CELL_TYPE (x)) == 0)
-#define SCM_SLOPPY_NCONSP(x) (!SCM_SLOPPY_CONSP(x))
-
-#define SCM_CONSP(x) (!SCM_IMP (x) && SCM_SLOPPY_CONSP (x))
+#define SCM_CONSP(x) (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
#define SCM_NCONSP(x) (!SCM_CONSP (x))
@@ -283,7 +280,7 @@ typedef long scm_bits_t;
*/
#define SCM_ECONSP(x) \
(!SCM_IMP (x) \
- && (SCM_SLOPPY_CONSP (x) \
+ && (SCM_CONSP (x) \
|| (SCM_TYP3 (x) == 1 \
&& (SCM_STRUCT_VTABLE_DATA (x)[scm_vtable_index_vcell] != 0))))
#define SCM_NECONSP(x) (!SCM_ECONSP (x))
@@ -542,6 +539,9 @@ extern char *scm_isymnames[]; /* defined in print.c */
#if (SCM_DEBUG_DEPRECATED == 0)
+#define SCM_SLOPPY_CONSP(x) ((1 & SCM_CELL_TYPE (x)) == 0)
+#define SCM_SLOPPY_NCONSP(x) (!SCM_SLOPPY_CONSP(x))
+
#define scm_tc7_ssymbol scm_tc7_symbol
#define scm_tc7_msymbol scm_tc7_symbol
#define scm_tcs_symbols scm_tc7_symbol
@@ -553,7 +553,7 @@ extern char *scm_isymnames[]; /* defined in print.c */
#endif /* SCM_DEBUG_DEPRECATED == 0 */
-#endif /* TAGSH */
+#endif /* SCM_TAGS_H */
/*
Local Variables:
diff --git a/libguile/throw.c b/libguile/throw.c
index a1060595c..e0e921dcd 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -71,8 +71,10 @@ static scm_bits_t tc16_jmpbuffer;
#define SCM_JMPBUFP(OBJ) SCM_TYP16_PREDICATE (tc16_jmpbuffer, OBJ)
#define JBACTIVE(OBJ) (SCM_CELL_WORD_0 (OBJ) & (1L << 16L))
-#define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L)))
-#define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L)))
+#define ACTIVATEJB(x) \
+ (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) | (1L << 16L))))
+#define DEACTIVATEJB(x) \
+ (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L))))
#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
#define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v)))
diff --git a/libguile/variable.c b/libguile/variable.c
index 4ce7d6110..064744f73 100644
--- a/libguile/variable.c
+++ b/libguile/variable.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -59,17 +59,16 @@ static int
variable_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<variable ", port);
- scm_intprint(SCM_UNPACK (exp), 16, port);
+ scm_intprint (SCM_UNPACK (exp), 16, port);
{
- SCM val_cell;
- val_cell = SCM_CDR(exp);
- if (!SCM_UNBNDP (SCM_CAR (val_cell)))
+ SCM vcell = SCM_VARVCELL (exp);
+ if (!SCM_UNBNDP (SCM_CAR (vcell)))
{
scm_puts (" name: ", port);
- scm_iprin1 (SCM_CAR (val_cell), port, pstate);
+ scm_iprin1 (SCM_CAR (vcell), port, pstate);
}
scm_puts (" binding: ", port);
- scm_iprin1 (SCM_CDR (val_cell), port, pstate);
+ scm_iprin1 (SCM_CDR (vcell), port, pstate);
}
scm_putc('>', port);
return 1;
@@ -78,7 +77,7 @@ variable_print (SCM exp, SCM port, scm_print_state *pstate)
static SCM
variable_equalp (SCM var1, SCM var2)
{
- return scm_equal_p (SCM_CDR (var1), SCM_CDR (var2));
+ return scm_equal_p (SCM_VARVCELL (var1), SCM_VARVCELL (var2));
}
@@ -100,17 +99,13 @@ SCM_DEFINE (scm_make_variable, "make-variable", 1, 1, 0,
"variable may exist, so @var{name-hint} is just that---a hint.\n")
#define FUNC_NAME s_scm_make_variable
{
- SCM val_cell;
+ SCM vcell;
if (SCM_UNBNDP (name_hint))
name_hint = anonymous_variable_sym;
- SCM_NEWCELL(val_cell);
- SCM_DEFER_INTS;
- SCM_SETCAR (val_cell, name_hint);
- SCM_SETCDR (val_cell, init);
- SCM_ALLOW_INTS;
- return make_vcell_variable (val_cell);
+ vcell = scm_cons (name_hint, init);
+ return make_vcell_variable (vcell);
}
#undef FUNC_NAME
@@ -129,11 +124,7 @@ SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 1, 0,
if (SCM_UNBNDP (name_hint))
name_hint = anonymous_variable_sym;
- SCM_NEWCELL (vcell);
- SCM_DEFER_INTS;
- SCM_SETCAR (vcell, name_hint);
- SCM_SETCDR (vcell, SCM_UNDEFINED);
- SCM_ALLOW_INTS;
+ vcell = scm_cons (name_hint, SCM_UNDEFINED);
return make_vcell_variable (vcell);
}
#undef FUNC_NAME
@@ -158,7 +149,7 @@ SCM_DEFINE (scm_variable_ref, "variable-ref", 1, 0, 0,
#define FUNC_NAME s_scm_variable_ref
{
SCM_VALIDATE_VARIABLE (1, var);
- return SCM_CDR (SCM_CDR (var));
+ return SCM_CDR (SCM_VARVCELL (var));
}
#undef FUNC_NAME
@@ -171,8 +162,8 @@ SCM_DEFINE (scm_variable_set_x, "variable-set!", 2, 0, 0,
"value. Return an unspecified value.\n")
#define FUNC_NAME s_scm_variable_set_x
{
- SCM_VALIDATE_VARIABLE (1,var);
- SCM_SETCDR (SCM_CDR (var), val);
+ SCM_VALIDATE_VARIABLE (1, var);
+ SCM_SETCDR (SCM_VARVCELL (var), val);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -213,8 +204,8 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
"Throws an error if @var{var} is not a variable object.\n")
#define FUNC_NAME s_scm_variable_bound_p
{
- SCM_VALIDATE_VARIABLE (1,var);
- return SCM_NEGATE_BOOL(SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (var))));
+ SCM_VALIDATE_VARIABLE (1, var);
+ return SCM_BOOL (!SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (var))));
}
#undef FUNC_NAME
diff --git a/libguile/variable.h b/libguile/variable.h
index 22a2e0438..f5fc686ed 100644
--- a/libguile/variable.h
+++ b/libguile/variable.h
@@ -1,8 +1,8 @@
/* classes: h_files */
-#ifndef VARIABLEH
-#define VARIABLEH
-/* Copyright (C) 1995,1996, 2000 Free Software Foundation, Inc.
+#ifndef SCM_VARIABLE_H
+#define SCM_VARIABLE_H
+/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -55,7 +55,7 @@
*/
extern scm_bits_t scm_tc16_variable;
-#define SCM_VARVCELL(V) SCM_CDR(V)
+#define SCM_VARVCELL(V) SCM_CELL_OBJECT_1 (V)
#define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_CELL_TYPE (X) == scm_tc16_variable)
#define SCM_UDVARIABLEP(X) (SCM_VARIABLEP(X) && SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X))))
#define SCM_DEFVARIABLEP(X) (SCM_VARIABLEP(X) && !SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X))))
@@ -71,7 +71,7 @@ extern SCM scm_builtin_variable (SCM name);
extern SCM scm_variable_bound_p (SCM var);
extern void scm_init_variable (void);
-#endif /* VARIABLEH */
+#endif /* SCM_VARIABLE_H */
/*
Local Variables:
diff --git a/libguile/vectors.c b/libguile/vectors.c
index bd1b7ba85..280b2eedf 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -178,13 +178,20 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
#define FUNC_NAME s_scm_vector
{
SCM res;
- register SCM *data;
- int i;
- SCM_VALIDATE_LIST_COPYLEN (1,l,i);
+ SCM *data;
+ long i;
+
+ /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted
+ while the vector is being created. */
+ SCM_VALIDATE_LIST_COPYLEN (1, l, i);
res = scm_c_make_vector (i, SCM_UNSPECIFIED);
data = SCM_VELTS (res);
- for(; i && SCM_NIMP(l); --i, l = SCM_CDR (l))
- *data++ = SCM_CAR (l);
+ while (!SCM_NULLP (l))
+ {
+ *data++ = SCM_CAR (l);
+ l = SCM_CDR (l);
+ }
+
return res;
}
#undef FUNC_NAME
diff --git a/libguile/weaks.c b/libguile/weaks.c
index c01da2c61..c6cf591bb 100644
--- a/libguile/weaks.c
+++ b/libguile/weaks.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -88,17 +88,22 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
#define FUNC_NAME s_scm_weak_vector
{
SCM res;
- register SCM *data;
+ SCM *data;
long i;
+ /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted
+ while the vector is being created. */
i = scm_ilength (l);
SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME);
res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED);
data = SCM_VELTS (res);
- for (;
- i && SCM_CONSP (l);
- --i, l = SCM_CDR (l))
- *data++ = SCM_CAR (l);
+
+ while (!SCM_NULLP (l))
+ {
+ *data++ = SCM_CAR (l);
+ l = SCM_CDR (l);
+ }
+
return res;
}
#undef FUNC_NAME