+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
{
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;
}
}
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);
}
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);
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)));
}
}
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))
{
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,
"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
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,
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))
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
"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
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;
}
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:
{
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))
{
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];
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;
}
/* 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))
{
{
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;
}
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
unsigned int
scm_ihashq (SCM obj, unsigned int n)
{
- return (((unsigned int) obj) >> 1) % n;
+ return (SCM_UNPACK (obj) >> 1) % n;
}
if (SCM_NUMP(obj))
return (unsigned int) scm_hasher(obj, n, 10);
else
- return ((unsigned int)obj) % n;
+ return SCM_UNPACK (obj) % n;
}
"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);
}
"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);
}
"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);
}
#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;
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,
{
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
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. */
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);
"")
#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
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)
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);
{
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 */
scm_internal_dynamic_wind (swap_port,
load,
swap_port,
- (void *) port,
+ (void *) SCM_UNPACK (port),
&save_port);
scm_close_port (port);
}
#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
#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
#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
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;
}
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;
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))
\f
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));
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 */
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);
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);
}
"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
{
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);
}
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;
}
\f
-#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.
scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
{
taloop:
- switch (7 & (int) exp)
+ switch (SCM_ITAG3 (exp))
{
case 2:
case 6:
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;
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
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);
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);
}
/* 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));
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);
}
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))
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),
{
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));
}
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
/* 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) \
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);
{
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);
#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)),
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))
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)
#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))
{
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;
}
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)
* 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];
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,
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:
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;
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)))
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)
}
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);
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;
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
{
/* 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;
{
/* 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),
}
/* 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
}
/* 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),
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;
}
#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;
}
{
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;
#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) \
)
#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) \
)
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) \
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));
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 */
}
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);
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)
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))
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))
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;
#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)
} 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))
#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))
{
/* 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;
#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)) \
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
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)
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))
{
scm_debug_frame *dframe;
long offset = 0;
- if (stack == SCM_BOOL_T)
+ if (SCM_TRUE_P (stack))
dframe = scm_last_debug_frame;
else
{
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);
|| 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);
{
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
{
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
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
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);
#endif
case 'u':
- if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
+ if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
*mem = 0;
else
{
break;
case 'p':
- if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
+ if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
*mem = SCM_BOOL_F;
else
{
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;
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));
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);
}
}
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.
*/
typedef scm_bits_t SCM;
#define SCM_UNPACK(x) (x)
- #define SCM_PACK(x) (x)
+ #define SCM_PACK(x) ((scm_bits_t) (x))
#endif
-/* $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
#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)
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) */
#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)
#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)
HCoop / bpt / guile.git / commitdiff