mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 08:40:19 +02:00
Code Activity

Lots of fixes to make guile (at some time) compile with strict typing.

Browse source
This commit is contained in:
Dirk Herrmann 2000-04-03 08:47:51 +00:00
parent abeed82198
commit 54778cd312
41 changed files with 251 additions and 173 deletions
Download patch file Download diff file Expand all files Collapse all files

84
libguile/ChangeLog
View file

@ -1,3 +1,87 @@
2000-04-03 Dirk Herrmann <D.Herrmann@tu-bs.de>
* evalext.c (scm_definedp, scm_m_undefine), gc.c
(scm_mark_weak_vector_spines, scm_gc_sweep), hashtab.c
(scm_hashq_ref, scm_hashv_ref, scm_hash_ref, scm_hashx_ref),
keywords.c (scm_make_keyword_from_dash_symbol), lang.c
(scm_nil_eq), lang.h (SCM_NILP, SCM_NIL2EOL), load.c
(scm_primitive_load), modules.c (scm_module_full_name), objects.c
(scm_class_of, scm_mcache_lookup_cmethod, scm_make_class_object),
ports.c (scm_close_all_ports_except), ports.h (SCM_EOF_OBJECT_P),
print.c (scm_iprin1, scm_prin1, scm_iprlist, scm_simple_format),
print.h (SCM_PRINT_STATE_P), procprop.c (scm_i_procedure_arity,
scm_stand_in_scm_proc, scm_procedure_property,
scm_set_procedure_property_x), procs.c
(scm_procedure_documentation), read.c (scm_lreadr, scm_lreadparen,
scm_lreadrecparen, scm_read_hash_extend), script.c
(scm_compile_shell_switches), srcprop.c (scm_source_property,
scm_set_source_property_x), srcprop.h (SCM_WHASHFOUNDP), stacks.c
(read_frame, NEXT_FRAME, read_frames, narrow_stack,
scm_make_stack, scm_stack_id), strop.c (scm_i_index,
scm_string_index, scm_string_rindex), struct.c (scm_struct_init),
validate.h (SCM_VALIDATE_BOOL_COPY, SCM_VALIDATE_INUM_DEF,
SCM_VALIDATE_INUM_DEF_COPY, SCM_VALIDATE_PROC,
SCM_VALIDATE_ARRAY): Don't use C operators to compare SCM values.
* feature.c (make_hook), keywords.c
(scm_make_keyword_from_dash_symbol), macros.c (scm_makacro,
scm_makmacro, scm_makmmacro), print.c (scm_iprin1,
scm_printer_apply, scm_port_with_print_state): Smob data is of type
scm_bits_t.
* feature.c (print_hook), gc.c (scm_object_address), hash.c
(scm_ihashq, scm_ihashv), print.c (scm_iprin1, scm_ipruk), smob.c
(freeprint), struct.c (scm_print_struct): Must unpack
SCM values to access their raw contents.
* fluids.c (apply_thunk, scm_with_fluids), hashtab.c (fold_proc,
scm_hash_fold), load.c (load, scm_primitive_load): Passing SCM
values via void * requires unpacking / packing.
* fports.c (scm_fport_buffer_add, scm_setvbuf), procs.h
(SCM_SUBRNUM, SCM_SET_SUBRNUM), srcprop.h (SRCPROPBRK, SRCBRKP):
Read and modify data bits in cell entry #0 using
SCM_{SET_}?CELL_WORD_0.
* fports.c (scm_fdes_to_port), gc.c (scm_gc_for_newcell,
scm_gc_sweep, init_heap_seg), init.c (start_stack), ports.c
(scm_void_port), procs.c (scm_make_subr_opt,
scm_make_procedure_with_setter), root.c (scm_internal_cwdr),
smob.c (scm_make_smob), strports.c (scm_mkstrport): Use
SCM_SET_CELL_TYPE to write the cell type information.
* gc.c (scm_gc_mark): Use SCM_CELL_OBJECT* to access SCM values
from cells that are no scheme pairs.
* gc.c (scm_gc_sweep), mallocs.c (prinmalloc), mallocs.h
(SCM_MALLOCDATA, SCM_SETMALLOCDATA), print.c (scm_ipruk), random.h
(SCM_RSTATE), root.h (SCM_ROOT_STATE), smob.c (scm_smob_free),
srcprop.c (freesrcprops), srcprop.h (SRCPROPPOS, SRCPROPFNAME,
SRCPROPCOPY, SRCPROPPLIST), struct.c (scm_make_struct,
scm_make_vtable_vtable): Use SCM_{SET_}?CELL_WORD* to access cell
entries with raw data.
* gc.c (scm_init_storage), sort.c (applyless), strop.c
(scm_string_to_list): Eliminate unnecessary casts to SCM.
* mallocs.c (scm_malloc_obj): Store result of malloc as raw
data.
* ports.c (scm_close_all_ports_except): Duplicate documentation
text removed.
* print.c (scm_iprin1): Use SCM_ITAG3.
* procs.h (SCM_SET_SUBRNUM): Fix shift direction.
* snarf.h (SCM_GPROC, SCM_GPROC1, SCM_SYMBOL, SCM_GLOBAL_SYMBOL,
SCM_KEYWORD, SCM_GLOBAL_KEYWORD, SCM_VCELL, SCM_GLOBAL_VCELL,
SCM_VCELL_INIT, SCM_GLOBAL_VCELL_INIT): Don't initialize globals
and static variables at their point of declaration, but rather in
the init function.
* tags.h (SCM_PACK): Automatically cast to scm_bits_t.
2000-04-02 Gary Houston <ghouston@arglist.com>
* guardians.c (TCONC_IN, scm_make_guardian): set the CDR of the

8
libguile/evalext.c
View file

@ -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);

4
libguile/feature.c
View file

@ -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))
{

4
libguile/fluids.c
View file

@ -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

10
libguile/fports.c
View file

@ -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

36
libguile/gc.c
View file

@ -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

4
libguile/hash.c
View file

@ -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;
}

12
libguile/hashtab.c
View file

@ -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

2
libguile/init.c
View file

@ -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. */

4
libguile/keywords.c
View file

@ -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);

2
libguile/lang.c
View file

@ -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

4
libguile/lang.h
View file

@ -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)

11
libguile/load.c
View file

@ -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);
}

6
libguile/macros.c
View file

@ -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

8
libguile/mallocs.c
View file

@ -54,7 +54,7 @@ static int
prinmalloc (SCM exp,SCM port,scm_print_state *pstate)
{
scm_puts("#<malloc ", port);
scm_intprint((int) SCM_CDR(exp), 16, port);
scm_intprint (SCM_CELL_WORD_1 (exp), 16, port);
scm_putc('>', port);
return 1;
}
@ -67,11 +67,7 @@ int scm_tc16_malloc;
SCM
scm_malloc_obj (scm_sizet n)
{
SCM mem;
mem = (n
? (SCM)malloc (n)
: 0);
scm_bits_t mem = n ? (scm_bits_t) malloc (n) : 0;
if (n && !mem)
{
SCM_ALLOW_INTS;

4
libguile/mallocs.h
View file

@ -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))

2
libguile/modules.c
View file

@ -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));

6
libguile/objects.c
View file

@ -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);
}

7
libguile/ports.c
View file

@ -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;
}

2
libguile/ports.h
View file

@ -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.

30
libguile/print.c
View file

@ -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

4
libguile/print.h
View file

@ -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) \

8
libguile/procprop.c
View file

@ -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))

6
libguile/procs.c
View file

@ -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;
}

4
libguile/procs.h
View file

@ -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)

2
libguile/random.h
View file

@ -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];

14
libguile/read.c
View file

@ -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);

2
libguile/root.c
View file

@ -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;

2
libguile/root.h
View file

@ -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
{

8
libguile/script.c
View file

@ -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),

6
libguile/smob.c
View file

@ -103,7 +103,7 @@ scm_free0 (SCM ptr)
scm_sizet
scm_smob_free (SCM obj)
{
scm_must_free ((char *) SCM_CDR (obj));
scm_must_free ((char *) SCM_CELL_WORD_1 (obj));
return scm_smobs[SCM_SMOBNUM (obj)].size;
}
@ -234,7 +234,7 @@ scm_make_smob (long tc)
#endif
SCM_SET_SMOB_DATA (z, scm_must_malloc (size, SCM_SMOBNAME (n)));
}
SCM_SETCAR (z, tc);
SCM_SET_CELL_TYPE (z, tc);
return z;
}
@ -249,7 +249,7 @@ freeprint (SCM exp,
{
char buf[100];
sprintf (buf, "#<freed cell %p; GC missed a reference>", (void *) exp);
sprintf (buf, "#<freed cell %p; GC missed a reference>", (void *) SCM_UNPACK (exp));
scm_puts (buf, port);
return 1;

22
libguile/snarf.h
View file

@ -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) \

2
libguile/sort.c
View file

@ -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));

24
libguile/srcprop.c
View file

@ -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;

14
libguile/srcprop.h
View file

@ -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))

12
libguile/stacks.c
View file

@ -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
{

14
libguile/strop.c
View file

@ -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

2
libguile/strports.c
View file

@ -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);

12
libguile/struct.c
View file

@ -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);
}
}

4
libguile/tags.h
View file

@ -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

12
libguile/validate.h
View file

@ -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)