summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog84
-rw-r--r--libguile/evalext.c8
-rw-r--r--libguile/feature.c4
-rw-r--r--libguile/fluids.c4
-rw-r--r--libguile/fports.c10
-rw-r--r--libguile/gc.c36
-rw-r--r--libguile/hash.c4
-rw-r--r--libguile/hashtab.c12
-rw-r--r--libguile/init.c2
-rw-r--r--libguile/keywords.c4
-rw-r--r--libguile/lang.c2
-rw-r--r--libguile/lang.h4
-rw-r--r--libguile/load.c11
-rw-r--r--libguile/macros.c6
-rw-r--r--libguile/mallocs.c8
-rw-r--r--libguile/mallocs.h4
-rw-r--r--libguile/modules.c2
-rw-r--r--libguile/objects.c6
-rw-r--r--libguile/ports.c7
-rw-r--r--libguile/ports.h2
-rw-r--r--libguile/print.c30
-rw-r--r--libguile/print.h4
-rw-r--r--libguile/procprop.c8
-rw-r--r--libguile/procs.c6
-rw-r--r--libguile/procs.h4
-rw-r--r--libguile/random.h2
-rw-r--r--libguile/read.c14
-rw-r--r--libguile/root.c2
-rw-r--r--libguile/root.h2
-rw-r--r--libguile/script.c8
-rw-r--r--libguile/smob.c6
-rw-r--r--libguile/snarf.h22
-rw-r--r--libguile/sort.c2
-rw-r--r--libguile/srcprop.c24
-rw-r--r--libguile/srcprop.h14
-rw-r--r--libguile/stacks.c12
-rw-r--r--libguile/strop.c14
-rw-r--r--libguile/strports.c2
-rw-r--r--libguile/struct.c12
-rw-r--r--libguile/tags.h4
-rw-r--r--libguile/validate.h12
41 files changed, 251 insertions, 173 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 5191f5bc3..4565be6c6 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,87 @@
+2000-04-03 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ * evalext.c (scm_definedp, scm_m_undefine), gc.c
+ (scm_mark_weak_vector_spines, scm_gc_sweep), hashtab.c
+ (scm_hashq_ref, scm_hashv_ref, scm_hash_ref, scm_hashx_ref),
+ keywords.c (scm_make_keyword_from_dash_symbol), lang.c
+ (scm_nil_eq), lang.h (SCM_NILP, SCM_NIL2EOL), load.c
+ (scm_primitive_load), modules.c (scm_module_full_name), objects.c
+ (scm_class_of, scm_mcache_lookup_cmethod, scm_make_class_object),
+ ports.c (scm_close_all_ports_except), ports.h (SCM_EOF_OBJECT_P),
+ print.c (scm_iprin1, scm_prin1, scm_iprlist, scm_simple_format),
+ print.h (SCM_PRINT_STATE_P), procprop.c (scm_i_procedure_arity,
+ scm_stand_in_scm_proc, scm_procedure_property,
+ scm_set_procedure_property_x), procs.c
+ (scm_procedure_documentation), read.c (scm_lreadr, scm_lreadparen,
+ scm_lreadrecparen, scm_read_hash_extend), script.c
+ (scm_compile_shell_switches), srcprop.c (scm_source_property,
+ scm_set_source_property_x), srcprop.h (SCM_WHASHFOUNDP), stacks.c
+ (read_frame, NEXT_FRAME, read_frames, narrow_stack,
+ scm_make_stack, scm_stack_id), strop.c (scm_i_index,
+ scm_string_index, scm_string_rindex), struct.c (scm_struct_init),
+ validate.h (SCM_VALIDATE_BOOL_COPY, SCM_VALIDATE_INUM_DEF,
+ SCM_VALIDATE_INUM_DEF_COPY, SCM_VALIDATE_PROC,
+ SCM_VALIDATE_ARRAY): Don't use C operators to compare SCM values.
+
+ * feature.c (make_hook), keywords.c
+ (scm_make_keyword_from_dash_symbol), macros.c (scm_makacro,
+ scm_makmacro, scm_makmmacro), print.c (scm_iprin1,
+ scm_printer_apply, scm_port_with_print_state): Smob data is of type
+ scm_bits_t.
+
+ * feature.c (print_hook), gc.c (scm_object_address), hash.c
+ (scm_ihashq, scm_ihashv), print.c (scm_iprin1, scm_ipruk), smob.c
+ (freeprint), struct.c (scm_print_struct): Must unpack
+ SCM values to access their raw contents.
+
+ * fluids.c (apply_thunk, scm_with_fluids), hashtab.c (fold_proc,
+ scm_hash_fold), load.c (load, scm_primitive_load): Passing SCM
+ values via void * requires unpacking / packing.
+
+ * fports.c (scm_fport_buffer_add, scm_setvbuf), procs.h
+ (SCM_SUBRNUM, SCM_SET_SUBRNUM), srcprop.h (SRCPROPBRK, SRCBRKP):
+ Read and modify data bits in cell entry #0 using
+ SCM_{SET_}?CELL_WORD_0.
+
+ * fports.c (scm_fdes_to_port), gc.c (scm_gc_for_newcell,
+ scm_gc_sweep, init_heap_seg), init.c (start_stack), ports.c
+ (scm_void_port), procs.c (scm_make_subr_opt,
+ scm_make_procedure_with_setter), root.c (scm_internal_cwdr),
+ smob.c (scm_make_smob), strports.c (scm_mkstrport): Use
+ SCM_SET_CELL_TYPE to write the cell type information.
+
+ * gc.c (scm_gc_mark): Use SCM_CELL_OBJECT* to access SCM values
+ from cells that are no scheme pairs.
+
+ * gc.c (scm_gc_sweep), mallocs.c (prinmalloc), mallocs.h
+ (SCM_MALLOCDATA, SCM_SETMALLOCDATA), print.c (scm_ipruk), random.h
+ (SCM_RSTATE), root.h (SCM_ROOT_STATE), smob.c (scm_smob_free),
+ srcprop.c (freesrcprops), srcprop.h (SRCPROPPOS, SRCPROPFNAME,
+ SRCPROPCOPY, SRCPROPPLIST), struct.c (scm_make_struct,
+ scm_make_vtable_vtable): Use SCM_{SET_}?CELL_WORD* to access cell
+ entries with raw data.
+
+ * gc.c (scm_init_storage), sort.c (applyless), strop.c
+ (scm_string_to_list): Eliminate unnecessary casts to SCM.
+
+ * mallocs.c (scm_malloc_obj): Store result of malloc as raw
+ data.
+
+ * ports.c (scm_close_all_ports_except): Duplicate documentation
+ text removed.
+
+ * print.c (scm_iprin1): Use SCM_ITAG3.
+
+ * procs.h (SCM_SET_SUBRNUM): Fix shift direction.
+
+ * snarf.h (SCM_GPROC, SCM_GPROC1, SCM_SYMBOL, SCM_GLOBAL_SYMBOL,
+ SCM_KEYWORD, SCM_GLOBAL_KEYWORD, SCM_VCELL, SCM_GLOBAL_VCELL,
+ SCM_VCELL_INIT, SCM_GLOBAL_VCELL_INIT): Don't initialize globals
+ and static variables at their point of declaration, but rather in
+ the init function.
+
+ * tags.h (SCM_PACK): Automatically cast to scm_bits_t.
+
2000-04-02 Gary Houston <ghouston@arglist.com>
* guardians.c (TCONC_IN, scm_make_guardian): set the CDR of the
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 447f6f90d..b9ddc8e31 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -96,12 +96,12 @@ SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0,
{
if (SCM_NCONSP (b))
{
- if (b == sym)
+ if (SCM_EQ_P (b, sym))
return SCM_BOOL_T;
else
break;
}
- if (SCM_CAR (b) == sym)
+ if (SCM_EQ_P (SCM_CAR (b), sym))
return SCM_BOOL_T;
}
}
@@ -110,7 +110,7 @@ SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0,
SCM_BOOL_F);
}
- return (vcell == SCM_BOOL_F || SCM_UNBNDP (SCM_CDR (vcell))
+ return (SCM_FALSEP (vcell) || SCM_UNBNDP (SCM_CDR (vcell))
? SCM_BOOL_F
: SCM_BOOL_T);
}
@@ -125,7 +125,7 @@ scm_m_undefine (SCM x, SCM env)
SCM arg1 = x;
x = SCM_CDR (x);
SCM_ASSYNT (SCM_TOP_LEVEL (env), arg1, "bad placement ", s_undefine);
- SCM_ASSYNT (SCM_CONSP (x) && SCM_CDR (x) == SCM_EOL,
+ SCM_ASSYNT (SCM_CONSP (x) && SCM_NULLP (SCM_CDR (x)),
arg1, scm_s_expression, s_undefine);
x = SCM_CAR (x);
SCM_ASSYNT (SCM_SYMBOLP (x), arg1, scm_s_variable, s_undefine);
diff --git a/libguile/feature.c b/libguile/feature.c
index 0e7daefe0..6f3f5f2cd 100644
--- a/libguile/feature.c
+++ b/libguile/feature.c
@@ -129,7 +129,7 @@ make_hook (SCM name, SCM n_args, const char *subr)
n = SCM_INUM (n_args);
}
SCM_ASSERT (n >= 0 && n <= 16, n_args, SCM_OUTOFRANGE, subr);
- SCM_RETURN_NEWSMOB (scm_tc16_hook + (n << 16), SCM_LIST1 (name));
+ SCM_RETURN_NEWSMOB (scm_tc16_hook + (n << 16), SCM_UNPACK (SCM_LIST1 (name)));
}
@@ -145,7 +145,7 @@ print_hook (SCM hook, SCM port, scm_print_state *pstate)
}
scm_intprint (SCM_HOOK_ARITY (hook), 10, port);
scm_putc (' ', port);
- scm_intprint ((int)hook, 16, port);
+ scm_intprint (SCM_UNPACK (hook), 16, port);
ls = SCM_HOOK_PROCEDURES (hook);
while (SCM_NIMP (ls))
{
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 752ef9c29..712afa988 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -217,7 +217,7 @@ scm_swap_fluids_reverse (SCM fluids, SCM vals)
static SCM
apply_thunk (void *thunk)
{
- return scm_apply ((SCM) thunk, SCM_EOL, SCM_EOL);
+ return scm_apply (SCM_PACK (thunk), SCM_EOL, SCM_EOL);
}
SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
@@ -228,7 +228,7 @@ SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
"one after another. @var{thunk} must be a procedure with no argument.")
#define FUNC_NAME s_scm_with_fluids
{
- return scm_internal_with_fluids (fluids, values, apply_thunk, (void *)thunk);
+ return scm_internal_with_fluids (fluids, values, apply_thunk, (void *) SCM_UNPACK (thunk));
}
#undef FUNC_NAME
diff --git a/libguile/fports.c b/libguile/fports.c
index 36f37fab1..8e48412bf 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -127,9 +127,9 @@ scm_fport_buffer_add (SCM port, int read_size, int write_size)
pt->write_end = pt->write_buf + pt->write_buf_size;
if (read_size > 0 || write_size > 0)
- SCM_SETCAR (port, SCM_UNPACK_CAR (port) & ~SCM_BUF0);
+ SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
else
- SCM_SETCAR (port, (SCM_UNPACK_CAR (port) | SCM_BUF0));
+ SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0);
}
SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
@@ -159,12 +159,12 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
if (cmode == _IOLBF)
{
- SCM_SETCAR (port, SCM_UNPACK_CAR (port) | SCM_BUFLINE);
+ SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
cmode = _IOFBF;
}
else
{
- SCM_SETCAR (port, SCM_UNPACK_CAR (port) ^ SCM_BUFLINE);
+ SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) ^ SCM_BUFLINE);
}
if (SCM_UNBNDP (size))
@@ -365,7 +365,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
SCM_DEFER_INTS;
pt = scm_add_to_port_table (port);
SCM_SETPTAB_ENTRY (port, pt);
- SCM_SETCAR (port, (scm_tc16_fport | mode_bits));
+ SCM_SET_CELL_TYPE (port, (scm_tc16_fport | mode_bits));
{
struct scm_fport *fp
diff --git a/libguile/gc.c b/libguile/gc.c
index 11b1ce30c..4b8239996 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -769,7 +769,7 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
"returned by this function for @var{obj}")
#define FUNC_NAME s_scm_object_address
{
- return scm_ulong2num ((unsigned long) obj);
+ return scm_ulong2num ((unsigned long) SCM_UNPACK (obj));
}
#undef FUNC_NAME
@@ -863,7 +863,7 @@ scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist)
while (SCM_NULLP (cell));
--scm_ints_disabled;
*freelist = SCM_CDR (cell);
- SCM_SETCAR (cell, scm_tc16_allocated);
+ SCM_SET_CELL_TYPE (cell, scm_tc16_allocated);
return cell;
}
@@ -1120,7 +1120,7 @@ gc_mark_nimp:
if (SCM_GCMARKP (ptr))
break;
SCM_SETGCMARK (ptr);
- scm_gc_mark (SCM_CELL_WORD (ptr, 2));
+ scm_gc_mark (SCM_CELL_OBJECT_2 (ptr));
ptr = SCM_GCCDR (ptr);
goto gc_mark_loop;
case scm_tcs_cons_gloc:
@@ -1512,7 +1512,7 @@ scm_mark_weak_vector_spines ()
{
SCM w;
- for (w = scm_weak_vectors; w != SCM_EOL; w = SCM_WVECT_GC_CHAIN (w))
+ for (w = scm_weak_vectors; !SCM_NULLP (w); w = SCM_WVECT_GC_CHAIN (w))
{
if (SCM_IS_WHVEC_ANY (w))
{
@@ -1639,18 +1639,18 @@ scm_gc_sweep ()
case scm_tcs_cons_gloc:
if (SCM_GCMARKP (scmptr))
{
- if (SCM_CDR ((SCM) SCM_STRUCT_VTABLE_DATA (scmptr))
- == (SCM) 1)
- SCM_SETCDR ((SCM) SCM_STRUCT_VTABLE_DATA (scmptr),
- (SCM) 0);
+ if (SCM_CELL_WORD_1 ((SCM) SCM_STRUCT_VTABLE_DATA (scmptr))
+ == 1)
+ SCM_SET_CELL_WORD_1 ((SCM) SCM_STRUCT_VTABLE_DATA (scmptr),
+ 0);
goto cmrkcontinue;
}
{
SCM vcell;
vcell = (SCM) SCM_STRUCT_VTABLE_DATA (scmptr);
- if ((SCM_CDR (vcell) == (SCM) 0)
- || (SCM_CDR (vcell)) == (SCM) 1)
+ if ((SCM_CELL_WORD_1 (vcell) == 0)
+ || (SCM_CELL_WORD_1 (vcell) == 1))
{
scm_struct_free_t free
= (scm_struct_free_t) ((SCM*) vcell)[scm_struct_i_free];
@@ -1846,7 +1846,7 @@ scm_gc_sweep ()
critical that we mark this cell as freed; otherwise, the
conservative collector might trace it as some other type
of object. */
- SCM_SETCAR (scmptr, scm_tc_free_cell);
+ SCM_SET_CELL_TYPE (scmptr, scm_tc_free_cell);
SCM_SETCDR (scmptr, nfreelist);
nfreelist = scmptr;
}
@@ -1911,7 +1911,7 @@ scm_gc_sweep ()
/* Scan weak vectors. */
{
SCM *ptr, w;
- for (w = scm_weak_vectors; w != SCM_EOL; w = SCM_WVECT_GC_CHAIN (w))
+ for (w = scm_weak_vectors; !SCM_NULLP (w); w = SCM_WVECT_GC_CHAIN (w))
{
if (!SCM_IS_WHVEC_ANY (w))
{
@@ -2235,7 +2235,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
{
SCM scmptr = PTR2SCM (ptr);
- SCM_SETCAR (scmptr, scm_tc_free_cell);
+ SCM_SET_CELL_TYPE (scmptr, scm_tc_free_cell);
SCM_SETCDR (scmptr, PTR2SCM (ptr + span));
ptr += span;
}
@@ -2684,15 +2684,15 @@ scm_init_storage (scm_sizet init_heap_size_1, scm_sizet init_heap_size_2)
scm_listofnull = scm_cons (SCM_EOL, SCM_EOL);
scm_nullstr = scm_makstr (0L, 0);
scm_nullvect = scm_make_vector (SCM_INUM0, SCM_UNDEFINED);
- scm_symhash = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
- scm_weak_symhash = scm_make_weak_key_hash_table ((SCM) SCM_MAKINUM (scm_symhash_dim));
- scm_symhash_vars = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
+ scm_symhash = scm_make_vector (SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
+ scm_weak_symhash = scm_make_weak_key_hash_table (SCM_MAKINUM (scm_symhash_dim));
+ scm_symhash_vars = scm_make_vector (SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
scm_stand_in_procs = SCM_EOL;
scm_permobjs = SCM_EOL;
scm_protects = SCM_EOL;
scm_asyncs = SCM_EOL;
- scm_sysintern ("most-positive-fixnum", (SCM) SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM));
- scm_sysintern ("most-negative-fixnum", (SCM) SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM));
+ scm_sysintern ("most-positive-fixnum", SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM));
+ scm_sysintern ("most-negative-fixnum", SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM));
#ifdef SCM_BIGDIG
scm_sysintern ("bignum-radix", SCM_MAKINUM (SCM_BIGRAD));
#endif
diff --git a/libguile/hash.c b/libguile/hash.c
index 4883aba2f..4113bcd2a 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -157,7 +157,7 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
unsigned int
scm_ihashq (SCM obj, unsigned int n)
{
- return (((unsigned int) obj) >> 1) % n;
+ return (SCM_UNPACK (obj) >> 1) % n;
}
@@ -192,7 +192,7 @@ scm_ihashv (SCM obj, unsigned int n)
if (SCM_NUMP(obj))
return (unsigned int) scm_hasher(obj, n, 10);
else
- return ((unsigned int)obj) % n;
+ return SCM_UNPACK (obj) % n;
}
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index f78d0b79a..66b2c6621 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -200,7 +200,7 @@ SCM_DEFINE (scm_hashq_ref, "hashq-ref", 2, 1, 0,
"supplied). Uses `eq?' for equality testing.")
#define FUNC_NAME s_scm_hashq_ref
{
- if (dflt == SCM_UNDEFINED)
+ if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihashq, scm_sloppy_assq, 0);
}
@@ -268,7 +268,7 @@ SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0,
"supplied). Uses `eqv?' for equality testing.")
#define FUNC_NAME s_scm_hashv_ref
{
- if (dflt == SCM_UNDEFINED)
+ if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihashv, scm_sloppy_assv, 0);
}
@@ -334,7 +334,7 @@ SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0,
"supplied). Uses `equal?' for equality testing.")
#define FUNC_NAME s_scm_hash_ref
{
- if (dflt == SCM_UNDEFINED)
+ if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihash, scm_sloppy_assoc, 0);
}
@@ -469,7 +469,7 @@ SCM_DEFINE (scm_hashx_ref, "hashx-ref", 4, 1, 0,
#define FUNC_NAME s_scm_hashx_ref
{
struct scm_ihashx_closure closure;
- if (dflt == SCM_UNDEFINED)
+ if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
closure.hash = hash;
closure.assoc = assoc;
@@ -514,7 +514,7 @@ scm_hashx_remove_x (SCM hash,SCM assoc,SCM delete,SCM table,SCM obj)
static SCM
fold_proc (void *proc, SCM key, SCM data, SCM value)
{
- return scm_apply ((SCM) proc, SCM_LIST3 (key, data, value), SCM_EOL);
+ return scm_apply (SCM_PACK (proc), SCM_LIST3 (key, data, value), SCM_EOL);
}
SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
@@ -531,7 +531,7 @@ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
{
SCM_VALIDATE_PROC (1,proc);
SCM_VALIDATE_VECTOR (3,table);
- return scm_internal_hash_fold (fold_proc, (void *) proc, init, table);
+ return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table);
}
#undef FUNC_NAME
diff --git a/libguile/init.c b/libguile/init.c
index ea7113fe1..cb9274bde 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -177,7 +177,7 @@ start_stack (void *base)
SCM_NEWCELL (scm_rootcont);
SCM_SET_CONTREGS (scm_rootcont, scm_must_malloc (sizeof (scm_contregs),
"continuation"));
- SCM_SETCAR (scm_rootcont, scm_tc7_contin);
+ SCM_SET_CELL_TYPE (scm_rootcont, scm_tc7_contin);
SCM_SEQ (scm_rootcont) = 0;
/* The root continuation if further initialized by restart_stack. */
diff --git a/libguile/keywords.c b/libguile/keywords.c
index d722e2de4..e4388d0d6 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -83,10 +83,10 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
SCM_DEFER_INTS;
vcell = scm_sym2ovcell_soft (symbol, scm_keyword_obarray);
- if (vcell == SCM_BOOL_F)
+ if (SCM_FALSEP (vcell))
{
SCM keyword;
- SCM_NEWSMOB (keyword, scm_tc16_keyword, symbol);
+ SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol));
scm_intern_symbol (scm_keyword_obarray, symbol);
vcell = scm_sym2ovcell_soft (symbol, scm_keyword_obarray);
SCM_SETCDR (vcell, keyword);
diff --git a/libguile/lang.c b/libguile/lang.c
index 21bd3ff8d..3b93462a9 100644
--- a/libguile/lang.c
+++ b/libguile/lang.c
@@ -137,7 +137,7 @@ SCM_DEFINE1 (scm_nil_eq, "nil-eq", scm_tc7_rpsubr,
"")
#define FUNC_NAME s_scm_nil_eq
{
- return (((x==y)
+ return ((SCM_EQ_P (x, y)
|| (SCM_NILP (x) && (SCM_NULLP (y) || SCM_FALSEP (y)))
|| (SCM_NILP (y) && (SCM_NULLP (x) || SCM_FALSEP (x))))
? scm_lisp_t
diff --git a/libguile/lang.h b/libguile/lang.h
index 4062c779f..f0514d0c6 100644
--- a/libguile/lang.h
+++ b/libguile/lang.h
@@ -51,9 +51,9 @@
extern SCM scm_lisp_nil;
extern SCM scm_lisp_t;
-#define SCM_NILP(x) ((x) == scm_lisp_nil)
+#define SCM_NILP(x) (SCM_EQ_P ((x), scm_lisp_nil))
#define SCM_NILNULLP(x) (SCM_NILP (x) || SCM_NULLP (x))
-#define SCM_NIL2EOL(x, tmp) ((tmp = (x)) == scm_lisp_nil ? SCM_EOL : tmp)
+#define SCM_NIL2EOL(x, tmp) (SCM_EQ_P ((tmp = (x)), scm_lisp_nil) ? SCM_EOL : tmp)
#define SCM_EOL2NIL(x, tmp) (SCM_NULLP (tmp = (x)) ? scm_lisp_nil : tmp)
#define SCM_EOL_IFY(x, tmp) (tmp = (x), SCM_NILP (tmp) ? SCM_EOL : tmp)
#define SCM_NIL_IFY(x, tmp) (tmp = (x), SCM_NILP (tmp) ? scm_lisp_nil : tmp)
diff --git a/libguile/load.c b/libguile/load.c
index 450badda4..20b555500 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -88,10 +88,10 @@ swap_port (void *data)
static SCM
load (void *data)
{
- SCM port = (SCM) data, form;
+ SCM port = SCM_PACK (data);
while (1)
{
- form = scm_read (port);
+ SCM form = scm_read (port);
if (SCM_EOF_OBJECT_P (form))
break;
scm_eval_x (form);
@@ -111,12 +111,11 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
{
SCM hook = *scm_loc_load_hook;
SCM_VALIDATE_ROSTRING (1,filename);
- SCM_ASSERT (hook == SCM_BOOL_F
- || (scm_procedure_p (hook) == SCM_BOOL_T),
+ SCM_ASSERT (SCM_FALSEP (hook) || (SCM_TRUE_P (scm_procedure_p (hook))),
hook, "value of %load-hook is neither a procedure nor #f",
FUNC_NAME);
- if (hook != SCM_BOOL_F)
+ if (! SCM_FALSEP (hook))
scm_apply (hook, scm_listify (filename, SCM_UNDEFINED), SCM_EOL);
{ /* scope */
@@ -127,7 +126,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
scm_internal_dynamic_wind (swap_port,
load,
swap_port,
- (void *) port,
+ (void *) SCM_UNPACK (port),
&save_port);
scm_close_port (port);
}
diff --git a/libguile/macros.c b/libguile/macros.c
index 86dea1479..87ec8abd9 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -61,7 +61,7 @@ SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0,
#define FUNC_NAME s_scm_makacro
{
SCM_VALIDATE_PROC (1,code);
- SCM_RETURN_NEWSMOB (scm_tc16_macro, code);
+ SCM_RETURN_NEWSMOB (scm_tc16_macro, SCM_UNPACK (code));
}
#undef FUNC_NAME
@@ -83,7 +83,7 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0,
#define FUNC_NAME s_scm_makmacro
{
SCM_VALIDATE_PROC (1,code);
- SCM_RETURN_NEWSMOB (scm_tc16_macro | (1L << 16), code);
+ SCM_RETURN_NEWSMOB (scm_tc16_macro | (1L << 16), SCM_UNPACK (code));
}
#undef FUNC_NAME
@@ -105,7 +105,7 @@ SCM_DEFINE (scm_makmmacro, "procedure->memoizing-macro", 1, 0, 0,
#define FUNC_NAME s_scm_makmmacro
{
SCM_VALIDATE_PROC (1,code);
- SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), code);
+ SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), SCM_UNPACK (code));
}
#undef FUNC_NAME
diff --git a/libguile/mallocs.c b/libguile/mallocs.c
index 00ef56956..65bff6fcb 100644
--- a/libguile/mallocs.c
+++ b/libguile/mallocs.c
@@ -54,7 +54,7 @@ static int
prinmalloc (SCM exp,SCM port,scm_print_state *pstate)
{
scm_puts("#<malloc ", port);
- scm_intprint((int) SCM_CDR(exp), 16, port);
+ scm_intprint (SCM_CELL_WORD_1 (exp), 16, port);
scm_putc('>', port);
return 1;
}
@@ -67,11 +67,7 @@ int scm_tc16_malloc;
SCM
scm_malloc_obj (scm_sizet n)
{
- SCM mem;
-
- mem = (n
- ? (SCM)malloc (n)
- : 0);
+ scm_bits_t mem = n ? (scm_bits_t) malloc (n) : 0;
if (n && !mem)
{
SCM_ALLOW_INTS;
diff --git a/libguile/mallocs.h b/libguile/mallocs.h
index 1f3240b63..0a1dbad0d 100644
--- a/libguile/mallocs.h
+++ b/libguile/mallocs.h
@@ -49,8 +49,8 @@
extern int scm_tc16_malloc;
#define SCM_MALLOCP(X) (SCM_TYP16 (X) == scm_tc16_malloc)
-#define SCM_MALLOCDATA(obj) ((char *)SCM_CDR(obj))
-#define SCM_SETMALLOCDATA(obj, val) ((char *)SCM_SETCDR(obj, val))
+#define SCM_MALLOCDATA(obj) ((char *) SCM_CELL_WORD_1 (obj))
+#define SCM_SETMALLOCDATA(obj, val) (SCM_SET_CELL_WORD_1 (obj, val))
diff --git a/libguile/modules.c b/libguile/modules.c
index f8d5b3714..3fc576bcd 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -85,7 +85,7 @@ static SCM module_prefix;
static SCM
scm_module_full_name (SCM name)
{
- if (SCM_CAR (name) == scm_sym_app)
+ if (SCM_EQ_P (SCM_CAR (name), scm_sym_app))
return name;
else
return scm_append (SCM_LIST2 (module_prefix, name));
diff --git a/libguile/objects.c b/libguile/objects.c
index 6421e1032..d1473d3bb 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -179,7 +179,7 @@ scm_class_of (SCM x)
else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
{
/* Goops object */
- if (SCM_OBJ_CLASS_REDEF (x) != SCM_BOOL_F)
+ if (! SCM_FALSEP (SCM_OBJ_CLASS_REDEF (x)))
scm_change_object_class (x,
SCM_CLASS_OF (x), /* old */
SCM_OBJ_CLASS_REDEF (x)); /* new */
@@ -295,7 +295,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
do
{
/* More arguments than specifiers => CLASS != ENV */
- if (scm_class_of (SCM_CAR (ls)) != SCM_CAR (z))
+ if (! SCM_EQ_P (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
goto next_method;
ls = SCM_CDR (ls);
z = SCM_CDR (z);
@@ -441,7 +441,7 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0,
unsigned long flags = 0;
SCM_VALIDATE_STRUCT (1,metaclass);
SCM_VALIDATE_STRING (2,layout);
- if (metaclass == scm_metaclass_operator)
+ if (SCM_EQ_P (metaclass, scm_metaclass_operator))
flags = SCM_CLASSF_OPERATOR;
return scm_i_make_class_object (metaclass, layout, flags);
}
diff --git a/libguile/ports.c b/libguile/ports.c
index 5f941c5b6..1c1d52af0 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -640,9 +640,6 @@ SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1,
"Close all open file ports used by the interpreter\n"
"except for those supplied as arguments. This procedure\n"
"is intended to be used before an exec call to close file descriptors\n"
- "which are not needed in the new process.Close all open file ports used by the interpreter\n"
- "except for those supplied as arguments. This procedure\n"
- "is intended to be used before an exec call to close file descriptors\n"
"which are not needed in the new process.")
#define FUNC_NAME s_scm_close_all_ports_except
{
@@ -659,7 +656,7 @@ SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1,
SCM port = SCM_COERCE_OUTPORT (SCM_CAR (ports_ptr));
if (i == 0)
SCM_VALIDATE_OPPORT (SCM_ARG1,port);
- if (port == thisport)
+ if (SCM_EQ_P (port, thisport))
found = 1;
ports_ptr = SCM_CDR (ports_ptr);
}
@@ -1342,7 +1339,7 @@ scm_void_port (char *mode_str)
scm_port_non_buffer (pt);
SCM_SETPTAB_ENTRY (answer, pt);
SCM_SETSTREAM (answer, 0);
- SCM_SETCAR (answer, scm_tc16_void_port | mode_bits);
+ SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits);
SCM_ALLOW_INTS;
return answer;
}
diff --git a/libguile/ports.h b/libguile/ports.h
index 152264535..8bb476586 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -138,7 +138,7 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
-#define SCM_EOF_OBJECT_P(x) ((x) == SCM_EOF_VAL)
+#define SCM_EOF_OBJECT_P(x) (SCM_EQ_P ((x), SCM_EOF_VAL))
/* PORT FLAGS
* A set of flags characterizes a port.
diff --git a/libguile/print.c b/libguile/print.c
index 809c1e002..bc903e7bd 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -297,7 +297,7 @@ void
scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
{
taloop:
- switch (7 & (int) exp)
+ switch (SCM_ITAG3 (exp))
{
case 2:
case 6:
@@ -328,9 +328,9 @@ taloop:
else if (SCM_ILOCP (exp))
{
scm_puts ("#@", port);
- scm_intprint ((long) SCM_IFRAME (exp), 10, port);
+ scm_intprint (SCM_UNPACK (SCM_IFRAME (exp)), 10, port);
scm_putc (SCM_ICDRP (exp) ? '-' : '+', port);
- scm_intprint ((long) SCM_IDIST (exp), 10, port);
+ scm_intprint (SCM_UNPACK (SCM_IDIST (exp)), 10, port);
}
else
goto idef;
@@ -359,7 +359,7 @@ taloop:
goto print_struct;
SCM_NEWSMOB (pwps,
scm_tc16_port_with_ps,
- scm_cons (port, pstate->handle));
+ SCM_UNPACK (scm_cons (port, pstate->handle)));
scm_call_generic_2 (print, exp, pwps);
}
else
@@ -620,7 +620,7 @@ taloop:
case scm_tc7_cclo:
{
SCM proc = SCM_CCLO_SUBR (exp);
- if (proc == scm_f_gsubr_apply)
+ if (SCM_EQ_P (proc, scm_f_gsubr_apply))
{
/* Print gsubrs as primitives */
SCM name = scm_procedure_name (exp);
@@ -728,7 +728,7 @@ scm_prin1 (SCM exp, SCM port, int writingp)
SCM_SETCDR (print_state_pool, SCM_CDDR (print_state_pool));
}
SCM_ALLOW_INTS;
- if (handle == SCM_BOOL_F)
+ if (SCM_FALSEP (handle))
handle = scm_cons (make_print_state (), SCM_EOL);
pstate_scm = SCM_CAR (handle);
}
@@ -740,7 +740,7 @@ scm_prin1 (SCM exp, SCM port, int writingp)
/* Return print state to pool if it has been created above and
hasn't escaped to Scheme. */
- if (handle != SCM_BOOL_F && !pstate->revealed)
+ if (!SCM_FALSEP (handle) && !pstate->revealed)
{
SCM_DEFER_INTS;
SCM_SETCDR (handle, SCM_CDR (print_state_pool));
@@ -771,13 +771,13 @@ scm_ipruk (char *hdr, SCM ptr, SCM port)
if (SCM_CELLP (ptr))
{
scm_puts (" (0x", port);
- scm_intprint ((int) SCM_CAR (ptr), 16, port);
+ scm_intprint (SCM_CELL_WORD_0 (ptr), 16, port);
scm_puts (" . 0x", port);
- scm_intprint ((int) SCM_CDR (ptr), 16, port);
+ scm_intprint (SCM_CELL_WORD_1 (ptr), 16, port);
scm_puts (") @", port);
}
scm_puts (" 0x", port);
- scm_intprint ((int) ptr, 16, port);
+ scm_intprint (SCM_UNPACK (ptr), 16, port);
scm_putc ('>', port);
}
@@ -801,7 +801,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
tortoise = exp;
while (SCM_ECONSP (hare))
{
- if (hare == tortoise)
+ if (SCM_EQ_P (hare, tortoise))
goto fancy_printing;
hare = SCM_CDR (hare);
if (SCM_IMP (hare) || SCM_NECONSP (hare))
@@ -957,9 +957,9 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
char *start;
char *p;
- if (SCM_BOOL_T == destination) {
+ if (SCM_TRUE_P (destination)) {
destination = scm_cur_outp;
- } else if (SCM_BOOL_F == destination) {
+ } else if (SCM_FALSEP (destination)) {
fReturnString = 1;
destination = scm_mkstrport (SCM_INUM0,
scm_make_string (SCM_INUM0, SCM_UNDEFINED),
@@ -1064,7 +1064,7 @@ scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *pstate)
{
SCM pwps;
SCM pair = scm_cons (port, pstate->handle);
- SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, pair);
+ SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (pair));
pstate->revealed = 1;
return scm_apply (proc, exp, scm_cons (pwps, scm_listofnull));
}
@@ -1078,7 +1078,7 @@ SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 2, 0, 0,
SCM_VALIDATE_OPORT_VALUE (1,port);
SCM_VALIDATE_PRINTSTATE (2,pstate);
port = SCM_COERCE_OUTPORT (port);
- SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, scm_cons (port, pstate));
+ SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (scm_cons (port, pstate)));
return pwps;
}
#undef FUNC_NAME
diff --git a/libguile/print.h b/libguile/print.h
index fa3d00935..1f2702be0 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -60,8 +60,8 @@ extern scm_option scm_print_opts[];
/* State information passed around during printing.
*/
#define SCM_PRINT_STATE_P(obj) (SCM_STRUCTP(obj) \
- && (SCM_STRUCT_VTABLE(obj) \
- == scm_print_state_vtable))
+ && (SCM_EQ_P (SCM_STRUCT_VTABLE(obj), \
+ scm_print_state_vtable)))
#define SCM_PRINT_STATE(obj) ((scm_print_state *) SCM_STRUCT_DATA (obj))
#define RESET_PRINT_STATE(pstate) \
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 999af9994..b4cafa65b 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -99,7 +99,7 @@ scm_i_procedure_arity (SCM proc)
break;
#ifdef CCLO
case scm_tc7_cclo:
- if (SCM_CCLO_SUBR (proc) == scm_f_gsubr_apply)
+ if (SCM_EQ_P (SCM_CCLO_SUBR (proc), scm_f_gsubr_apply))
{
int type = SCM_INUM (SCM_GSUBR_TYPE (proc));
a += SCM_GSUBR_REQ (type);
@@ -152,7 +152,7 @@ scm_stand_in_scm_proc(SCM proc)
{
SCM answer;
answer = scm_assoc (proc, scm_stand_in_procs);
- if (answer == SCM_BOOL_F)
+ if (SCM_FALSEP (answer))
{
answer = scm_closure (scm_listify (SCM_EOL, SCM_BOOL_F, SCM_UNDEFINED),
SCM_EOL);
@@ -196,7 +196,7 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0,
#define FUNC_NAME s_scm_procedure_property
{
SCM assoc;
- if (k == scm_sym_arity)
+ if (SCM_EQ_P (k, scm_sym_arity))
{
SCM arity;
SCM_ASSERT (SCM_NFALSEP (arity = scm_i_procedure_arity (p)),
@@ -222,7 +222,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
if (!SCM_CLOSUREP (p))
p = scm_stand_in_scm_proc(p);
SCM_VALIDATE_CLOSURE (1,p);
- if (k == scm_sym_arity)
+ if (SCM_EQ_P (k, scm_sym_arity))
SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p));
if (SCM_NIMP (assoc))
diff --git a/libguile/procs.c b/libguile/procs.c
index a42756b09..8578ff887 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -96,7 +96,7 @@ scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
scm_subr_table[entry].documentation = SCM_BOOL_F;
SCM_SUBRF (z) = fcn;
- SCM_SETCAR (z, (entry << 8) + type);
+ SCM_SET_CELL_TYPE (z, (entry << 8) + type);
scm_subr_table_size++;
if (set)
@@ -271,7 +271,7 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
#define FUNC_NAME s_scm_procedure_documentation
{
SCM code;
- SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (proc) && SCM_NIMP (proc) && SCM_TYP7 (proc) != scm_tc7_contin,
+ SCM_ASSERT (SCM_TRUE_P (scm_procedure_p (proc)) && SCM_NIMP (proc) && SCM_TYP7 (proc) != scm_tc7_contin,
proc, SCM_ARG1, FUNC_NAME);
switch (SCM_TYP7 (proc))
{
@@ -321,7 +321,7 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
SCM_ENTER_A_SECTION;
SCM_SET_CELL_OBJECT_1 (z, procedure);
SCM_SET_CELL_OBJECT_2 (z, setter);
- SCM_SETCAR (z, scm_tc7_pws);
+ SCM_SET_CELL_TYPE (z, scm_tc7_pws);
SCM_EXIT_A_SECTION;
return z;
}
diff --git a/libguile/procs.h b/libguile/procs.h
index dbd448a58..3230fb6a7 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -84,9 +84,9 @@ typedef struct
SCM documentation;
} scm_subr_entry;
-#define SCM_SUBRNUM(subr) (SCM_UNPACK_CAR (subr) >> 8)
+#define SCM_SUBRNUM(subr) (SCM_CELL_WORD_0 (subr) >> 8)
#define SCM_SET_SUBRNUM(subr, num) \
- SCM_SETCAR (subr, (num >> 8) + SCM_TYP7 (subr))
+ SCM_SET_CELL_WORD_0 (subr, (num << 8) + SCM_TYP7 (subr))
#define SCM_SUBR_ENTRY(x) (scm_subr_table[SCM_SUBRNUM (x)])
#define SCM_SNAME(x) (SCM_SUBR_ENTRY (x).name)
#define SCM_SUBRF(x) (((scm_subr *)(SCM2PTR(x)))->cproc)
diff --git a/libguile/random.h b/libguile/random.h
index d519d1ca6..a765b2af9 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -109,7 +109,7 @@ extern SCM scm_c_random_bignum (scm_rstate *, SCM m);
* Scheme level interface
*/
extern long scm_tc16_rstate;
-#define SCM_RSTATE(obj) ((scm_rstate *) SCM_CDR (obj))
+#define SCM_RSTATE(obj) ((scm_rstate *) SCM_CELL_WORD_1 (obj))
#define SCM_RSTATEP(obj) (SCM_NIMP(obj) && (SCM_TYP16 (obj) == scm_tc16_rstate))
extern unsigned char scm_masktab[256];
diff --git a/libguile/read.c b/libguile/read.c
index 7af3b735d..051e75511 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -407,7 +407,7 @@ tryagain_no_flush_ws:
got = scm_apply (sharp,
SCM_MAKE_CHAR (c),
scm_acons (port, SCM_EOL, SCM_EOL));
- if (SCM_UNSPECIFIED == got)
+ if (SCM_EQ_P (got, SCM_UNSPECIFIED))
goto unkshrp;
if (SCM_RECORD_POSITIONS_P)
return *copy = recsexpr (got, line, column,
@@ -611,7 +611,7 @@ scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
if (')' == c)
return SCM_EOL;
scm_ungetc (c, port);
- if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
+ if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
{
ans = scm_lreadr (tok_buf, port, copy);
closeit:
@@ -623,7 +623,7 @@ scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
while (')' != (c = scm_flush_ws (port, name)))
{
scm_ungetc (c, port);
- if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
+ if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
{
SCM_SETCDR (tl, scm_lreadr (tok_buf, port, copy));
goto closeit;
@@ -650,7 +650,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
if (')' == c)
return SCM_EOL;
scm_ungetc (c, port);
- if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
+ if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
{
ans = scm_lreadr (tok_buf, port, copy);
if (')' != (c = scm_flush_ws (port, name)))
@@ -667,7 +667,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
while (')' != (c = scm_flush_ws (port, name)))
{
scm_ungetc (c, port);
- if (scm_sym_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
+ if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
{
SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy));
if (SCM_COPY_SOURCE_P)
@@ -731,13 +731,13 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0,
}
break;
}
- if (chr == SCM_CAAR (this))
+ if (SCM_EQ_P (chr, SCM_CAAR (this)))
{
/* already in the alist. */
if (SCM_FALSEP (proc))
{
/* remove it. */
- if (prev == SCM_BOOL_F)
+ if (SCM_FALSEP (prev))
{
*scm_read_hash_procedures =
SCM_CDR (*scm_read_hash_procedures);
diff --git a/libguile/root.c b/libguile/root.c
index ebfdf2c32..9330b24b0 100644
--- a/libguile/root.c
+++ b/libguile/root.c
@@ -272,7 +272,7 @@ scm_internal_cwdr (scm_catch_body_t body, void *body_data,
scm_must_malloc (sizeof (scm_contregs),
"inferior root continuation"));
#endif
- SCM_SETCAR (new_rootcont, scm_tc7_contin);
+ SCM_SET_CELL_TYPE (new_rootcont, scm_tc7_contin);
SCM_DYNENV (new_rootcont) = SCM_EOL;
SCM_BASE (new_rootcont) = stack_start;
SCM_SEQ (new_rootcont) = ++n_dynamic_roots;
diff --git a/libguile/root.h b/libguile/root.h
index 682cacae5..02929b7ba 100644
--- a/libguile/root.h
+++ b/libguile/root.h
@@ -86,7 +86,7 @@ extern SCM scm_sys_protects[];
extern long scm_tc16_root;
#define SCM_ROOTP(obj) (SCM_NIMP(obj) && (scm_tc16_root == SCM_TYP16 (obj)))
-#define SCM_ROOT_STATE(root) ((scm_root_state *) SCM_CDR (root))
+#define SCM_ROOT_STATE(root) ((scm_root_state *) SCM_CELL_WORD_1 (root))
typedef struct scm_root_state
{
diff --git a/libguile/script.c b/libguile/script.c
index 9e428f3b8..1b9de76c6 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -459,7 +459,7 @@ scm_compile_shell_switches (int argc, char **argv)
/* If we specified the -ds option, do_script points to the
cdr of an expression like (load #f); we replace the car
(i.e., the #f) with the script name. */
- if (do_script != SCM_EOL)
+ if (!SCM_NULLP (do_script))
{
SCM_SETCAR (do_script, scm_makfrom0str (argv[i]));
do_script = SCM_EOL;
@@ -518,7 +518,7 @@ scm_compile_shell_switches (int argc, char **argv)
{
/* We put a dummy "load" expression, and let the -s put the
filename in. */
- if (do_script != SCM_EOL)
+ if (!SCM_NULLP (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),
@@ -561,7 +561,7 @@ scm_compile_shell_switches (int argc, char **argv)
}
/* Check to make sure the -ds got a -s. */
- if (do_script != SCM_EOL)
+ if (!SCM_NULLP (do_script))
scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
/* Make any remaining arguments available to the
@@ -575,7 +575,7 @@ scm_compile_shell_switches (int argc, char **argv)
}
/* Handle the `-e' switch, if it was specified. */
- if (entry_point != SCM_EOL)
+ if (!SCM_NULLP (entry_point))
tail = scm_cons (scm_cons2 (entry_point,
scm_cons (sym_command_line, SCM_EOL),
SCM_EOL),
diff --git a/libguile/smob.c b/libguile/smob.c
index 8ffae882b..6e5cab1e9 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -103,7 +103,7 @@ scm_free0 (SCM ptr)
scm_sizet
scm_smob_free (SCM obj)
{
- scm_must_free ((char *) SCM_CDR (obj));
+ scm_must_free ((char *) SCM_CELL_WORD_1 (obj));
return scm_smobs[SCM_SMOBNUM (obj)].size;
}
@@ -234,7 +234,7 @@ scm_make_smob (long tc)
#endif
SCM_SET_SMOB_DATA (z, scm_must_malloc (size, SCM_SMOBNAME (n)));
}
- SCM_SETCAR (z, tc);
+ SCM_SET_CELL_TYPE (z, tc);
return z;
}
@@ -249,7 +249,7 @@ freeprint (SCM exp,
{
char buf[100];
- sprintf (buf, "#<freed cell %p; GC missed a reference>", (void *) exp);
+ sprintf (buf, "#<freed cell %p; GC missed a reference>", (void *) SCM_UNPACK (exp));
scm_puts (buf, port);
return 1;
diff --git a/libguile/snarf.h b/libguile/snarf.h
index 9115fe1dd..3dbeb88ce 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -116,8 +116,9 @@ $$$R STR | REQ | OPT | VAR | __FILE__:__LINE__ | @@@ CFN @!!! \
#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
SCM_HERE(\
static const char RANAME[]=STR;\
-static SCM GF = 0 \
+static SCM GF \
)SCM_INIT(\
+GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
scm_make_gsubr_with_generic (RANAME, REQ, OPT, VAR, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
)
@@ -131,8 +132,9 @@ scm_make_subr (RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \
#define SCM_GPROC1(RANAME, STR, TYPE, CFN, GF) \
SCM_HERE(\
static const char RANAME[]=STR; \
-static SCM GF = 0 \
+static SCM GF \
)SCM_INIT(\
+GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
scm_make_subr_with_generic (RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
)
@@ -141,35 +143,35 @@ SCM_HERE(static const char RANAME[]=STR)\
SCM_INIT(scm_make_synt (RANAME, TYPE, CFN))
#define SCM_SYMBOL(c_name, scheme_name) \
-SCM_HERE(static SCM c_name = SCM_BOOL_F) \
+SCM_HERE(static SCM c_name) \
SCM_INIT(c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name))))
#define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
-SCM_HERE(SCM c_name = SCM_BOOL_F) \
+SCM_HERE(SCM c_name) \
SCM_INIT(c_name = scm_permanent_object (SCM_CAR (scm_intern0 (scheme_name))))
#define SCM_KEYWORD(c_name, scheme_name) \
-SCM_HERE(static SCM c_name = SCM_BOOL_F) \
+SCM_HERE(static SCM c_name) \
SCM_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name)))
#define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
-SCM_HERE(SCM c_name = SCM_BOOL_F) \
+SCM_HERE(SCM c_name) \
SCM_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name)))
#define SCM_VCELL(c_name, scheme_name) \
-SCM_HERE(static SCM c_name = SCM_BOOL_F) \
+SCM_HERE(static SCM c_name) \
SCM_INIT(c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, SCM_BOOL_F))
#define SCM_GLOBAL_VCELL(c_name, scheme_name) \
-SCM_HERE(SCM c_name = SCM_BOOL_F) \
+SCM_HERE(SCM c_name) \
SCM_INIT(c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, SCM_BOOL_F))
#define SCM_VCELL_INIT(c_name, scheme_name, init_val) \
-SCM_HERE(static SCM c_name = SCM_BOOL_F) \
+SCM_HERE(static SCM c_name) \
SCM_INIT(c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, init_val))
#define SCM_GLOBAL_VCELL_INIT(c_name, scheme_name, init_val) \
-SCM_HERE(SCM c_name = SCM_BOOL_F) \
+SCM_HERE(SCM c_name) \
SCM_INIT(c_name = scm_permanent_object (scm_intern0 (scheme_name)); SCM_SETCDR (c_name, init_val))
#define SCM_CONST_LONG(c_name, scheme_name,value) \
diff --git a/libguile/sort.c b/libguile/sort.c
index 28decf028..7fba0df4c 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -384,7 +384,7 @@ closureless (SCM code, const void *a, const void *b)
static int
applyless (SCM less, const void *a, const void *b)
{
- return SCM_NFALSEP (scm_apply ((SCM) less,
+ return SCM_NFALSEP (scm_apply (less,
scm_cons (*(SCM *) a,
scm_cons (*(SCM *) b, SCM_EOL)),
SCM_EOL));
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index 59c1fdc6e..6dd200b1d 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -99,8 +99,8 @@ marksrcprops (SCM obj)
static scm_sizet
freesrcprops (SCM obj)
{
- *((scm_srcprops **) SCM_CDR (obj)) = srcprops_freelist;
- srcprops_freelist = (scm_srcprops *) SCM_CDR (obj);
+ *((scm_srcprops **) SCM_CELL_WORD_1 (obj)) = srcprops_freelist;
+ srcprops_freelist = (scm_srcprops *) SCM_CELL_WORD_1 (obj);
return 0; /* srcprops_chunks are not freed until leaving guile */
}
@@ -221,11 +221,11 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
if (SCM_IMP (p) || !SRCPROPSP (p))
goto plist;
- if (scm_sym_breakpoint == key) p = SRCPROPBRK (p);
- else if (scm_sym_line == key) p = SCM_MAKINUM (SRCPROPLINE (p));
- else if (scm_sym_column == key) p = SCM_MAKINUM (SRCPROPCOL (p));
- else if (scm_sym_filename == key) p = SRCPROPFNAME (p);
- else if (scm_sym_copy == key) p = SRCPROPCOPY (p);
+ if (SCM_EQ_P (scm_sym_breakpoint, key)) p = SRCPROPBRK (p);
+ else if (SCM_EQ_P (scm_sym_line, key)) p = SCM_MAKINUM (SRCPROPLINE (p));
+ else if (SCM_EQ_P (scm_sym_column, key)) p = SCM_MAKINUM (SRCPROPCOL (p));
+ else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (p);
+ else if (SCM_EQ_P (scm_sym_copy, key)) p = SRCPROPCOPY (p);
else
{
p = SRCPROPPLIST (p);
@@ -259,7 +259,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
h = scm_whash_create_handle (scm_source_whash, obj);
p = SCM_EOL;
}
- if (scm_sym_breakpoint == key)
+ if (SCM_EQ_P (scm_sym_breakpoint, key))
{
if (SCM_FALSEP (datum))
CLEARSRCPROPBRK (SRCPROPSP (p)
@@ -280,7 +280,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
SCM_UNDEFINED,
p)));
}
- else if (scm_sym_line == key)
+ else if (SCM_EQ_P (scm_sym_line, key))
{
SCM_VALIDATE_INUM (3,datum);
if (SRCPROPSP (p))
@@ -290,7 +290,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
scm_make_srcprops (SCM_INUM (datum), 0,
SCM_UNDEFINED, SCM_UNDEFINED, p));
}
- else if (scm_sym_column == key)
+ else if (SCM_EQ_P (scm_sym_column, key))
{
SCM_VALIDATE_INUM (3,datum);
if (SRCPROPSP (p))
@@ -300,14 +300,14 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
scm_make_srcprops (0, SCM_INUM (datum),
SCM_UNDEFINED, SCM_UNDEFINED, p));
}
- else if (scm_sym_filename == key)
+ else if (SCM_EQ_P (scm_sym_filename, key))
{
if (SRCPROPSP (p))
SRCPROPFNAME (p) = datum;
else
SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, datum, SCM_UNDEFINED, p));
}
- else if (scm_sym_filename == key)
+ else if (SCM_EQ_P (scm_sym_filename, key))
{
if (SRCPROPSP (p))
SRCPROPCOPY (p) = datum;
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index 2d92044f4..ca51a704f 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -63,7 +63,7 @@
#define scm_whash_handle SCM
#define scm_whash_get_handle(whash, key) scm_hash_fn_get_handle (whash, key, scm_ihashq, scm_sloppy_assq, 0)
-#define SCM_WHASHFOUNDP(h) ((h) != SCM_BOOL_F)
+#define SCM_WHASHFOUNDP(h) (!SCM_FALSEP (h))
#define SCM_WHASHREF(whash, handle) SCM_CDR (handle)
#define SCM_WHASHSET(whash, handle, obj) SCM_SETCDR (handle, obj)
#define scm_whash_create_handle(whash, key) scm_hash_fn_create_handle_x (whash, key, SCM_UNSPECIFIED, scm_ihashq, scm_sloppy_assq, 0)
@@ -96,13 +96,13 @@ typedef struct scm_srcprops_chunk
} scm_srcprops_chunk;
#define SRCPROPSP(p) (SCM_NIMP(p) && (SCM_TYP16 (p) == scm_tc16_srcprops))
-#define SRCPROPBRK(p) (SCM_BOOL((1L << 16) & SCM_UNPACK_CAR (p)))
-#define SRCPROPPOS(p) ((scm_srcprops *) SCM_CDR (p))->pos
+#define SRCPROPBRK(p) (SCM_BOOL (SCM_CELL_WORD_0 (p) & (1L << 16)))
+#define SRCPROPPOS(p) ((scm_srcprops *) SCM_CELL_WORD_1 (p))->pos
#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12)
#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL)
-#define SRCPROPFNAME(p) ((scm_srcprops *) SCM_CDR (p))->fname
-#define SRCPROPCOPY(p) ((scm_srcprops *) SCM_CDR (p))->copy
-#define SRCPROPPLIST(p) ((scm_srcprops *) SCM_CDR (p))->plist
+#define SRCPROPFNAME(p) ((scm_srcprops *) SCM_CELL_WORD_1 (p))->fname
+#define SRCPROPCOPY(p) ((scm_srcprops *) SCM_CELL_WORD_1 (p))->copy
+#define SRCPROPPLIST(p) ((scm_srcprops *) SCM_CELL_WORD_1 (p))->plist
#define SETSRCPROPBRK(p) (SCM_SETOR_CAR (p, (1L << 16)))
#define CLEARSRCPROPBRK(p) SCM_SETAND_CAR (p, ~(1L << 16))
#define SRCPROPMAKPOS(l,c) (((l) << 12) + (c))
@@ -112,7 +112,7 @@ typedef struct scm_srcprops_chunk
#define SRCBRKP(x) (SCM_NIMP (t.arg1 = scm_whash_lookup (scm_source_whash, (x)))\
&& SRCPROPSP (t.arg1)\
- && ((1L << 16) & SCM_UNPACK (SCM_CAR (t.arg1))))
+ && (SCM_CELL_WORD_0 (t.arg1) & (1L << 16)))
#define PROCTRACEP(x) SCM_NFALSEP (scm_procedure_property (x, scm_sym_trace))
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 355bd8fe4..8f3ab9b1d 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -201,7 +201,7 @@ read_frame (scm_debug_frame *dframe,long offset,scm_info_frame *iframe)
{
/* Debug.vect ends with apply info. */
--info;
- if (info[1].a.proc != SCM_UNDEFINED)
+ if (!SCM_UNBNDP (info[1].a.proc))
{
flags |= SCM_FRAMEF_PROC;
iframe->proc = info[1].a.proc;
@@ -237,7 +237,7 @@ get_applybody ()
#define NEXT_FRAME(iframe, n, quit) \
do { \
if (SCM_NIMP (iframe->source) \
- && SCM_MEMOIZED_EXP (iframe->source) == applybody) \
+ && SCM_EQ_P (SCM_MEMOIZED_EXP (iframe->source), applybody)) \
{ \
iframe->source = SCM_BOOL_F; \
if (SCM_FALSEP (iframe->proc)) \
@@ -317,7 +317,7 @@ read_frames (scm_debug_frame *dframe,long offset,int n,scm_info_frame *iframes)
NEXT_FRAME (iframe, n, quit);
}
}
- else if (iframe->proc == scm_f_gsubr_apply)
+ else if (SCM_EQ_P (iframe->proc, scm_f_gsubr_apply))
/* Skip gsubr apply frames. */
continue;
else
@@ -360,7 +360,7 @@ narrow_stack (SCM stack,int inner,SCM inner_key,int outer,SCM outer_key)
int n = s->length;
/* Cut inner part. */
- if (inner_key == SCM_BOOL_T)
+ if (SCM_TRUE_P (inner_key))
/* Cut all frames up to user module code */
{
for (i = 0; inner; ++i, --inner)
@@ -440,7 +440,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 0, 0, 1,
scm_make_stack was given. */
/* just use dframe == scm_last_debug_frame
(from initialization of dframe, above) if obj is #t */
- if (obj != SCM_BOOL_T)
+ if (!SCM_TRUE_P (obj))
{
SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, FUNC_NAME);
if (SCM_DEBUGOBJP (obj))
@@ -519,7 +519,7 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
{
scm_debug_frame *dframe;
long offset = 0;
- if (stack == SCM_BOOL_T)
+ if (SCM_TRUE_P (stack))
dframe = scm_last_debug_frame;
else
{
diff --git a/libguile/strop.c b/libguile/strop.c
index 633553a00..630ecbbca 100644
--- a/libguile/strop.c
+++ b/libguile/strop.c
@@ -64,7 +64,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
SCM_ASSERT (SCM_ROSTRINGP (*str), *str, SCM_ARG1, why);
SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why);
- if (sub_start == SCM_BOOL_F)
+ if (SCM_FALSEP (sub_start))
sub_start = SCM_MAKINUM (0);
SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why);
@@ -73,7 +73,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
|| lower > SCM_ROLENGTH (*str))
scm_out_of_range (why, sub_start);
- if (sub_end == SCM_BOOL_F)
+ if (SCM_FALSEP (sub_end))
sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str));
SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why);
@@ -125,9 +125,9 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
{
int pos;
- if (frm == SCM_UNDEFINED)
+ if (SCM_UNBNDP (frm))
frm = SCM_BOOL_F;
- if (to == SCM_UNDEFINED)
+ if (SCM_UNBNDP (to))
to = SCM_BOOL_F;
pos = scm_i_index (&str, chr, 1, frm, to, FUNC_NAME);
return (pos < 0
@@ -156,9 +156,9 @@ SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0,
{
int pos;
- if (frm == SCM_UNDEFINED)
+ if (SCM_UNBNDP (frm))
frm = SCM_BOOL_F;
- if (to == SCM_UNDEFINED)
+ if (SCM_UNBNDP (to))
to = SCM_BOOL_F;
pos = scm_i_index (&str, chr, -1, frm, to, FUNC_NAME);
return (pos < 0
@@ -328,7 +328,7 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
unsigned char *src;
SCM_VALIDATE_ROSTRING (1,str);
src = SCM_ROUCHARS (str);
- for (i = SCM_ROLENGTH (str)-1;i >= 0;i--) res = scm_cons ((SCM)SCM_MAKE_CHAR (src[i]), res);
+ for (i = SCM_ROLENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res);
return res;
}
#undef FUNC_NAME
diff --git a/libguile/strports.c b/libguile/strports.c
index 4a1fc09c5..03ee0e73f 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -273,7 +273,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
SCM_NEWCELL (z);
SCM_DEFER_INTS;
pt = scm_add_to_port_table (z);
- SCM_SETCAR (z, scm_tc16_strport | modes);
+ SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
SCM_SETPTAB_ENTRY (z, pt);
SCM_SETSTREAM (z, SCM_UNPACK (str));
pt->write_buf = pt->read_buf = SCM_ROCHARS (str);
diff --git a/libguile/struct.c b/libguile/struct.c
index f6d8b9dd6..19f3e790c 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -196,7 +196,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
#endif
case 'u':
- if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
+ if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
*mem = 0;
else
{
@@ -208,7 +208,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
break;
case 'p':
- if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
+ if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
*mem = SCM_BOOL_F;
else
{
@@ -409,7 +409,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
data = scm_alloc_struct (basic_size + tail_elts,
scm_struct_n_extra_words,
"make-struct");
- SCM_SETCDR (handle, data);
+ SCM_SET_CELL_WORD_1 (handle, data);
SCM_SETCAR (handle, ((SCM)SCM_STRUCT_DATA (vtable)) + scm_tc3_cons_gloc);
scm_struct_init (handle, tail_elts, init);
SCM_ALLOW_INTS;
@@ -498,7 +498,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
data = scm_alloc_struct (basic_size + tail_elts,
scm_struct_n_extra_words,
"make-vtable-vtable");
- SCM_SETCDR (handle, data);
+ SCM_SET_CELL_WORD_1 (handle, data);
SCM_SETCAR (handle, ((SCM)data) + scm_tc3_cons_gloc);
SCM_STRUCT_LAYOUT (handle) = layout;
scm_struct_init (handle, tail_elts, scm_cons (layout, init));
@@ -758,9 +758,9 @@ scm_print_struct (SCM exp, SCM port, scm_print_state *pstate)
else
scm_puts ("struct", port);
scm_putc (' ', port);
- scm_intprint ((int) vtable, 16, port);
+ scm_intprint (SCM_UNPACK (vtable), 16, port);
scm_putc (':', port);
- scm_intprint ((int)exp, 16, port);
+ scm_intprint (SCM_UNPACK (exp), 16, port);
scm_putc ('>', port);
}
}
diff --git a/libguile/tags.h b/libguile/tags.h
index 3b0fdf6c9..74317caaf 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -73,7 +73,7 @@ typedef long scm_bits_t;
typedef union { struct { scm_bits_t n; } n; } SCM;
static SCM scm_pack(scm_bits_t b) { SCM s; s.n.n = b; return s; }
#define SCM_UNPACK(x) ((x).n.n)
- #define SCM_PACK(x) (scm_pack (x))
+ #define SCM_PACK(x) (scm_pack ((scm_bits_t) (x)))
#elif defined (SCM_VOIDP_TEST)
/* This is the default, which provides an intermediate level of compile time
* type checking while still resulting in very efficient code.
@@ -88,7 +88,7 @@ typedef long scm_bits_t;
*/
typedef scm_bits_t SCM;
#define SCM_UNPACK(x) (x)
- #define SCM_PACK(x) (x)
+ #define SCM_PACK(x) ((scm_bits_t) (x))
#endif
diff --git a/libguile/validate.h b/libguile/validate.h
index bc773f441..f928f64e7 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -1,4 +1,4 @@
-/* $Id: validate.h,v 1.2 2000-03-19 19:01:14 cmm Exp $ */
+/* $Id: validate.h,v 1.3 2000-04-03 08:47:51 dirk Exp $ */
/* Copyright (C) 1999 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
@@ -98,7 +98,7 @@
#define SCM_VALIDATE_BOOL_COPY(pos,flag,cvar) \
do { SCM_ASSERT(SCM_BOOLP(flag), flag, pos, FUNC_NAME); \
- cvar = (SCM_BOOL_T == flag)? 1: 0; } while (0)
+ cvar = (SCM_TRUE_P (flag))? 1: 0; } while (0)
#define SCM_VALIDATE_CHAR(pos,scm) SCM_MAKE_VALIDATE(pos,scm,ICHRP)
@@ -162,11 +162,11 @@
SCM_ASSERT_RANGE(pos,k,(cvar >= min)); } while (0)
#define SCM_VALIDATE_INUM_DEF(pos,k,default) \
- do { if (SCM_UNDEFINED==k) k = SCM_MAKINUM(default); \
+ do { if (SCM_UNBNDP (k)) k = SCM_MAKINUM(default); \
else SCM_ASSERT(SCM_INUMP(k), k, pos, FUNC_NAME); } while (0)
#define SCM_VALIDATE_INUM_DEF_COPY(pos,k,default,cvar) \
- do { if (SCM_UNDEFINED==k) { k = SCM_MAKINUM(default); cvar=default; } \
+ do { if (SCM_UNBNDP (k)) { k = SCM_MAKINUM(default); cvar=default; } \
else { SCM_ASSERT(SCM_INUMP(k), k, pos, FUNC_NAME); cvar = SCM_INUM(k); } } while (0)
/* [low,high) */
@@ -230,7 +230,7 @@
#define SCM_VALIDATE_CLOSURE(pos,obj) SCM_MAKE_VALIDATE(pos,obj,CLOSUREP)
#define SCM_VALIDATE_PROC(pos,proc) \
- do { SCM_ASSERT ( SCM_BOOL_T == scm_procedure_p(proc), proc, pos, FUNC_NAME); } while (0)
+ do { SCM_ASSERT ( SCM_TRUE_P (scm_procedure_p(proc)), proc, pos, FUNC_NAME); } while (0)
#define SCM_VALIDATE_NULLORCONS(pos,env) \
do { SCM_ASSERT (SCM_NULLP (env) || SCM_CONSP (env), env, pos, FUNC_NAME); } while (0)
@@ -270,7 +270,7 @@
#define SCM_VALIDATE_ARRAY(pos,v) \
do { SCM_ASSERT (SCM_NIMP (v) && \
- SCM_BOOL_F != scm_array_p(v,SCM_UNDEFINED), \
+ !SCM_FALSEP (scm_array_p(v,SCM_UNDEFINED)), \
v, pos, FUNC_NAME); } while (0)
#define SCM_VALIDATE_VECTOR(pos,v) SCM_MAKE_VALIDATE(pos,v,VECTORP)