From 54778cd31205b1f50397cf7bf92f7d8b37c99870 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Mon, 3 Apr 2000 08:47:51 +0000 Subject: [PATCH] Lots of fixes to make guile (at some time) compile with strict typing. --- libguile/ChangeLog | 84 +++++++++++++++++++++++++++++++++++++++++++++ libguile/evalext.c | 8 ++--- libguile/feature.c | 4 +-- libguile/fluids.c | 4 +-- libguile/fports.c | 10 +++--- libguile/gc.c | 36 +++++++++---------- libguile/hash.c | 4 +-- libguile/hashtab.c | 12 +++---- libguile/init.c | 2 +- libguile/keywords.c | 4 +-- libguile/lang.c | 2 +- libguile/lang.h | 4 +-- libguile/load.c | 11 +++--- libguile/macros.c | 6 ++-- libguile/mallocs.c | 8 ++--- libguile/mallocs.h | 4 +-- libguile/modules.c | 2 +- libguile/objects.c | 6 ++-- libguile/ports.c | 7 ++-- libguile/ports.h | 2 +- libguile/print.c | 30 ++++++++-------- libguile/print.h | 4 +-- libguile/procprop.c | 8 ++--- libguile/procs.c | 6 ++-- libguile/procs.h | 4 +-- libguile/random.h | 2 +- libguile/read.c | 14 ++++---- libguile/root.c | 2 +- libguile/root.h | 2 +- libguile/script.c | 8 ++--- libguile/smob.c | 6 ++-- libguile/snarf.h | 22 ++++++------ libguile/sort.c | 2 +- libguile/srcprop.c | 24 ++++++------- libguile/srcprop.h | 14 ++++---- libguile/stacks.c | 12 +++---- libguile/strop.c | 14 ++++---- libguile/strports.c | 2 +- libguile/struct.c | 12 +++---- libguile/tags.h | 4 +-- libguile/validate.h | 12 +++---- 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 + + * 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 * 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("#', 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, "#", (void *) exp); + sprintf (buf, "#", (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) -- 2.20.1