From e841c3e0c006a4c80d873f93cb512f0ec71a5705 Mon Sep 17 00:00:00 2001 From: Keisuke Nishida Date: Fri, 8 Dec 2000 17:32:56 +0000 Subject: [PATCH] Smob-related creanup. --- libguile/ChangeLog | 142 +++++++++++++++++++++++++++++++++++++++ libguile/arbiters.c | 9 +-- libguile/async.c | 11 ++- libguile/continuations.c | 10 +-- libguile/continuations.h | 3 +- libguile/debug.c | 18 ++--- libguile/debug.h | 17 +++-- libguile/dynl.c | 13 ++-- libguile/dynwind.c | 10 +-- libguile/environments.c | 80 ++++++++++------------ libguile/environments.h | 4 +- libguile/eval.c | 8 +-- libguile/eval.h | 2 +- libguile/filesys.c | 7 +- libguile/filesys.h | 2 +- libguile/fluids.c | 8 +-- libguile/fluids.h | 2 +- libguile/fports.c | 4 +- libguile/guardians.c | 2 +- libguile/hooks.c | 7 +- libguile/hooks.h | 10 +-- libguile/keywords.c | 11 +-- libguile/keywords.h | 3 +- libguile/macros.c | 10 +-- libguile/macros.h | 2 +- libguile/mallocs.c | 16 ++--- libguile/mallocs.h | 2 +- libguile/modules.c | 10 +-- libguile/modules.h | 5 +- libguile/ports.c | 2 +- libguile/print.c | 6 +- libguile/print.h | 6 +- libguile/random.c | 8 +-- libguile/random.h | 6 +- libguile/regex-posix.c | 8 +-- libguile/regex-posix.h | 2 +- libguile/root.c | 10 +-- libguile/root.h | 4 +- libguile/smob.c | 29 ++++---- libguile/smob.h | 3 +- libguile/srcprop.c | 15 +++-- libguile/srcprop.h | 4 +- libguile/tags.h | 2 + libguile/threads.c | 8 +-- libguile/threads.h | 16 ++--- libguile/throw.c | 42 +++++------- libguile/unif.c | 16 ++--- libguile/unif.h | 4 +- libguile/validate.h | 4 +- libguile/variable.c | 21 +++--- libguile/variable.h | 2 +- 51 files changed, 386 insertions(+), 260 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 94f730661..37d79f592 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,145 @@ +2000-12-08 Keisuke Nishida + + * tags.h (SCM_TYP16_PREDICATE): New macro. + * arbiters.c (scm_tc16_arbiter): Typed as scm_bits_t. + (arbiter_print): Renamed from prinarb. + (scm_init_arbiters): Don't use scm_make_smob_type_mfpe. + * async.c (tc16_async): Typed as scm_bits_t. + (SCM_ASYNCP): Use SCM_TYP16_PREDICATE. + (async_mark): Renamed from mark_async. + (scm_init_async): Updated. + * continuations.h (SCM_CONTINUATIONP): Use SCM_TYP16_PREDICATE. + * debug.c (scm_tc16_memoized, scm_tc16_debugobj): Typed as scm_bits_t. + (memoized_print): Renamed from prinmemoized. + (debugobj_print): Renamed from prindebugobj. + (scm_init_debug): Don't use scm_make_smob_type_mfpe. + * debug.h (scm_tc16_memoized, scm_tc16_debugobj): Typed as scm_bits_t. + (SCM_DEBUGOBJP, SCM_MEMOIZEDP): Use SCM_TYP16_PREDICATE. + * dynl.c (scm_tc16_dynamic_obj): Typed as scm_bits_t. + (dynl_obj_mark): Renamed from mark_dynl_obj. + (dynl_obj_print): Renamed from print_dynl_obj. + (scm_dynamic_object_p): Use SCM_TYP16_PREDICATE. + (scm_init_dynamic_linking): Updated. + * dynwind.c (SCM_GUARDSP): Use SCM_TYP16_PREDICATE. + (tc16_guards): Typed as scm_bits_t. + (guards_print): Renamed from printguards. + (scm_init_dynwind): Don't use scm_make_smob_type_mfpe. + * environments.c (scm_tc16_environment, scm_tc16_observer): + Typed as scm_bits_t. + (environment_mark, environment_free, environment_print, + observer_mark, observer_print, leaf_environment_mark, + leaf_environment_free, leaf_environment_print, + eval_environment_mark, eval_environment_free, + eval_environment_print, import_environment_mark, + import_environment_free, import_environment_print, + export_environment_mark, export_environment_free, + export_environment_print): Renamed from mark_environment, + free_environment, print_environment, mark_observer, + print_observer, mark_leaf_environment, free_leaf_environment, + print_leaf_environment, mark_eval_environment, + free_eval_environment, print_eval_environment, + mark_import_environment, free_import_environment, + print_import_environment, mark_export_environment, + free_export_environment, and print_export_environment, respectively. + (free_observer): Removed. + (leaf_environment_funcs, eval_environment_funcs, + import_environment_funcs, export_environment_funcs, + scm_environments_prehistory): Updated. + * environments.h (scm_tc16_environment, scm_tc16_observer): + Typed as scm_bits_t. + * eval.c (scm_tc16_promise): Typed as scm_bits_t. + (promise_print): Renamed from prinprom. + (scm_promise_p): Use SCM_TYP16_PREDICATE. + (scm_init_eval): Updated. + * eval.h (scm_tc16_promise): Typed as scm_bits_t. + * filesys.c (scm_tc16_dir): Typed as scm_bits_t. + (scm_init_filesys): Don't use scm_make_smob_type_mfpe. + * filesys.h (scm_tc16_dir): Typed as scm_bits_t. + * fluids.c (scm_tc16_fluid): Typed as scm_bits_t. + (fluid_print): Renamed from print_fluid. + (scm_init_fluids): Don't use scm_make_smob_type_mfpe. + * fluids.h (scm_tc16_fluid): Typed as scm_bits_t. + * fports.c (fport_print): Renamed from prinfport. + (scm_make_fptob): Updated. + * guardians.c (tc16_guardian): Typed as scm_bits_t. + * hooks.c (scm_tc16_hook): Typed as scm_bits_t. + (hook_print): Renamed from print_hook. + (scm_init_hooks): Updated. + * hooks.h (scm_tc16_hook): Typed as scm_bits_t. + (SCM_HOOKP): Use SCM_TYP16_PREDICATE. + * keywords.c (scm_tc16_keyword): Typed as scm_bits_t. + (keyword_print): Renamed from prin_keyword. + (scm_init_keywords): Don't use scm_make_smob_type_mfpe. + * keywords.h (scm_tc16_keyword): Typed as scm_bits_t. + * macros.c (scm_tc16_macro): Typed as scm_bits_t. + (scm_macro_p, scm_macro_type): Use SCM_TYP16_PREDICATE. + (scm_init_macros): Don't use scm_make_smob_type_mfpe. + * macros.h (scm_tc16_macro): Typed as scm_bits_t. + * mallocs.c (scm_tc16_malloc): Typed as scm_bits_t. + (malloc_free): Renamed from fmalloc. + (malloc_print): Renamed from prinmalloc. + (scm_init_mallocs): Don't use scm_make_smob_type_mfpe. + * mallocs.h (scm_tc16_malloc): Typed as scm_bits_t. + * modules.h (SCM_EVAL_CLOSURE_P): Use SCM_TYP16_PREDICATE. + (scm_tc16_eval_closure): Renamed from scm_eval_closure_tag. + (scm_standard_eval_closure, scm_init_modules): Updated. + * ports.c (scm_tc16_void_port): Typed as scm_bits_t. + * print.c (scm_tc16_port_with_ps): Typed as scm_bits_t. + (port_with_ps_print): Renamed from print_port_with_ps. + (scm_init_print): Updated. + * print.h (scm_tc16_port_with_ps): Typed as scm_bits_t. + (SCM_PORT_WITH_PS_P): Use SCM_TYP16_PREDICATE. + * random.c (scm_tc16_rstate): Typed as scm_bits_t. + (rstate_free): Renamed from free_rstate. + (scm_init_random): Don't use scm_make_smob_type_mfpe. + * random.h (scm_tc16_rstate): Typed as scm_bits_t. + (SCM_RSTATEP): Use SCM_TYP16_PREDICATE. + * regex-posix.c (scm_tc16_regex): Typed as scm_bits_t. + (regex_free): Renamed from free_regex. + (scm_init_regex_posix): Don't use scm_make_smob_type_mfpe. + * regex-posix.h (scm_tc16_regex): Typed as scm_bits_t. + * root.c (scm_tc16_root): Typed as scm_bits_t. + (root_mark): Renamed from mark_root. + (root_print): Renamed from print_root. + (scm_init_root): Updated. + * root.h (scm_tc16_root): Typed as scm_bits_t. + (SCM_ROOTP): Use SCM_TYP16_PREDICATE. + * smob.c (free_print): Renamed from freeprint. + (scm_smob_prehistory): Don't use scm_make_smob_type_mfpe. + * smob.h (SCM_SMOB_PREDICATE): Use SCM_TYP16_PREDICATE. + * srcprop.c (scm_tc16_srcprops): Typed as scm_bits_t. + (srcprops_mark): Renamed from marksrcprops. + (srcprops_free): Renamed from freesrcprops. + (srcprops_print): Renamed from prinsrcprops. + (scm_init_srcprop): Don't use scm_make_smob_type_mfpe. + * srcprop.h (scm_tc16_srcprops): Typed as scm_bits_t. + (SRCPROPSP): Use SCM_TYP16_PREDICATE. + * threads.c (scm_tc16_thread, scm_tc16_mutex, scm_tc16_condvar): + Typed as scm_bits_t. + * threads.h (scm_tc16_thread, scm_tc16_mutex, scm_tc16_condvar): + Typed as scm_bits_t. + (SCM_THREADP, SCM_MUTEXP, SCM_CONDVARP): Use SCM_TYP16_PREDICATE. + * throw.c (tc16_jmpbuffer): Renamed from scm_tc16_jmpbuffer. + (make_jmpbuf): Updated. + (tc16_lazy_catch): Typed as scm_bits_t. + (SCM_JMPBUFP, SCM_LAZY_CATCH_P): Use SCM_TYP16_PREDICATE. + (jmpbuffer_print): Renamed from printjb. + (lazy_catch_print): Renamed from print_lazy_catch. + (scm_init_throw): Don't use scm_make_smob_type_mfpe. + * unif.c (scm_tc16_array): Typed as scm_bits_t. + (array_mark): Renamed from markra. + (array_free): Renamed from freera. + (scm_init_unif): Don't use scm_make_smob_type_mfpe. + * unif.h (scm_tc16_array): Typed as scm_bits_t. + (SCM_ARRAYP): Use SCM_TYP16_PREDICATE. + * validate.h (SCM_VALIDATE_SMOB): Use SCM_TYP16_PREDICATE. + * variable.c (scm_tc16_variable): Typed as scm_bits_t. + (variable_print): Renamed from prin_var. + (variable_equalp): Renamed from var_equal. + (scm_markvar): Removed. + (scm_init_variable): Don't use scm_make_smob_type_mfpe. + * variable.h (scm_tc16_variable): Typed as scm_bits_t. + 2000-12-08 Dirk Herrmann * feature.c (scm_add_feature), gh_data.c (gh_symbol2scm), goops.c diff --git a/libguile/arbiters.c b/libguile/arbiters.c index 69e68d7f3..073d80bb6 100644 --- a/libguile/arbiters.c +++ b/libguile/arbiters.c @@ -60,7 +60,7 @@ * SCM_DEFER_INTS). */ -static long scm_tc16_arbiter; +static scm_bits_t scm_tc16_arbiter; #define SCM_ARB_LOCKED(arb) ((SCM_CELL_WORD_0 (arb)) & (1L << 16)) @@ -68,7 +68,7 @@ static long scm_tc16_arbiter; #define SCM_UNLOCK_ARB(arb) (SCM_SET_CELL_WORD_0 ((arb), scm_tc16_arbiter)); static int -prinarb (SCM exp, SCM port, scm_print_state *pstate) +arbiter_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts ("#> 16) #define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) << 16))) @@ -280,7 +279,7 @@ scm_async_click () static SCM -mark_async (SCM obj) +async_mark (SCM obj) { return ASYNC_THUNK (obj); } @@ -460,7 +459,7 @@ scm_init_async () { scm_asyncs = SCM_EOL; tc16_async = scm_make_smob_type ("async", 0); - scm_set_smob_mark (tc16_async, mark_async); + scm_set_smob_mark (tc16_async, async_mark); #ifndef SCM_MAGIC_SNARFER #include "libguile/async.x" diff --git a/libguile/continuations.c b/libguile/continuations.c index 5ef2219f1..7624f637b 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -66,7 +66,8 @@ scm_bits_t scm_tc16_continuation; -static SCM continuation_mark (SCM obj) +static SCM +continuation_mark (SCM obj) { scm_contregs *continuation = SCM_CONTREGS (obj); @@ -75,7 +76,8 @@ static SCM continuation_mark (SCM obj) return continuation->dynenv; } -static scm_sizet continuation_free (SCM obj) +static scm_sizet +continuation_free (SCM obj) { scm_contregs *continuation = SCM_CONTREGS (obj); /* stack array size is 1 if num_stack_items is 0 (rootcont). */ @@ -89,7 +91,8 @@ static scm_sizet continuation_free (SCM obj) return bytes_free; } -static int continuation_print (SCM obj, SCM port, scm_print_state *state) +static int +continuation_print (SCM obj, SCM port, scm_print_state *state) { scm_contregs *continuation = SCM_CONTREGS (obj); @@ -243,7 +246,6 @@ scm_init_continuations () scm_set_smob_free (scm_tc16_continuation, continuation_free); scm_set_smob_print (scm_tc16_continuation, continuation_print); scm_set_smob_apply (scm_tc16_continuation, continuation_apply, 0, 0, 1); - #ifndef SCM_MAGIC_SNARFER #include "libguile/continuations.x" #endif diff --git a/libguile/continuations.h b/libguile/continuations.h index ba87a3f27..adc962976 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -74,8 +74,7 @@ typedef struct SCM_STACKITEM stack[1]; /* copied stack of size num_stack_items. */ } scm_contregs; -#define SCM_CONTINUATIONP(x)\ - (SCM_NIMP (x) && (SCM_TYP16 (x) == scm_tc16_continuation)) +#define SCM_CONTINUATIONP(x) SCM_TYP16_PREDICATE (scm_tc16_continuation, x) #define SCM_CONTREGS(x) ((scm_contregs *) SCM_CELL_WORD_1 (x)) diff --git a/libguile/debug.c b/libguile/debug.c index f530c3f66..946306db1 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -144,11 +144,10 @@ static SCM scm_sym_procname; /* {Memoized Source} */ -long scm_tc16_memoized; - +scm_bits_t scm_tc16_memoized; static int -prinmemoized (SCM obj,SCM port,scm_print_state *pstate) +memoized_print (SCM obj, SCM port, scm_print_state *pstate) { int writingp = SCM_WRITINGP (pstate); scm_puts ("#mark)) (env); } static scm_sizet -free_environment (SCM env) +environment_free (SCM env) { return (*(SCM_ENVIRONMENT_FUNCS (env)->free)) (env); } static int -print_environment (SCM env, SCM port, scm_print_state *pstate) +environment_print (SCM env, SCM port, scm_print_state *pstate) { return (*(SCM_ENVIRONMENT_FUNCS (env)->print)) (env, port, pstate); } @@ -477,7 +477,7 @@ print_environment (SCM env, SCM port, scm_print_state *pstate) /* observers */ static SCM -mark_observer (SCM observer) +observer_mark (SCM observer) { scm_gc_mark (SCM_OBSERVER_ENVIRONMENT (observer)); scm_gc_mark (SCM_OBSERVER_DATA (observer)); @@ -485,15 +485,8 @@ mark_observer (SCM observer) } -static scm_sizet -free_observer (SCM observer_smob) -{ - return 0; -} - - static int -print_observer (SCM type, SCM port, scm_print_state *pstate) +observer_print (SCM type, SCM port, scm_print_state *pstate) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -971,7 +964,7 @@ leaf_environment_cell(SCM env, SCM sym, int for_write) static SCM -mark_leaf_environment (SCM env) +leaf_environment_mark (SCM env) { scm_gc_mark (LEAF_ENVIRONMENT (env)->obarray); return core_environments_mark (env); @@ -979,7 +972,7 @@ mark_leaf_environment (SCM env) static scm_sizet -free_leaf_environment (SCM env) +leaf_environment_free (SCM env) { core_environments_finalize (env); @@ -989,7 +982,7 @@ free_leaf_environment (SCM env) static int -print_leaf_environment (SCM type, SCM port, scm_print_state *pstate) +leaf_environment_print (SCM type, SCM port, scm_print_state *pstate) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -1011,9 +1004,9 @@ static struct scm_environment_funcs leaf_environment_funcs = { leaf_environment_cell, core_environments_observe, core_environments_unobserve, - mark_leaf_environment, - free_leaf_environment, - print_leaf_environment + leaf_environment_mark, + leaf_environment_free, + leaf_environment_print }; @@ -1324,7 +1317,7 @@ eval_environment_cell (SCM env, SCM sym, int for_write) static SCM -mark_eval_environment (SCM env) +eval_environment_mark (SCM env) { struct eval_environment *body = EVAL_ENVIRONMENT (env); @@ -1339,7 +1332,7 @@ mark_eval_environment (SCM env) static scm_sizet -free_eval_environment (SCM env) +eval_environment_free (SCM env) { core_environments_finalize (env); @@ -1349,7 +1342,7 @@ free_eval_environment (SCM env) static int -print_eval_environment (SCM type, SCM port, scm_print_state *pstate) +eval_environment_print (SCM type, SCM port, scm_print_state *pstate) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -1371,9 +1364,9 @@ static struct scm_environment_funcs eval_environment_funcs = { eval_environment_cell, core_environments_observe, core_environments_unobserve, - mark_eval_environment, - free_eval_environment, - print_eval_environment + eval_environment_mark, + eval_environment_free, + eval_environment_print }; @@ -1740,7 +1733,7 @@ import_environment_cell (SCM env, SCM sym, int for_write) static SCM -mark_import_environment (SCM env) +import_environment_mark (SCM env) { scm_gc_mark (IMPORT_ENVIRONMENT (env)->imports); scm_gc_mark (IMPORT_ENVIRONMENT (env)->import_observers); @@ -1750,7 +1743,7 @@ mark_import_environment (SCM env) static scm_sizet -free_import_environment (SCM env) +import_environment_free (SCM env) { core_environments_finalize (env); @@ -1760,7 +1753,7 @@ free_import_environment (SCM env) static int -print_import_environment (SCM type, SCM port, scm_print_state *pstate) +import_environment_print (SCM type, SCM port, scm_print_state *pstate) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -1782,9 +1775,9 @@ static struct scm_environment_funcs import_environment_funcs = { import_environment_cell, core_environments_observe, core_environments_unobserve, - mark_import_environment, - free_import_environment, - print_import_environment + import_environment_mark, + import_environment_free, + import_environment_print }; @@ -2034,7 +2027,7 @@ export_environment_cell (SCM env, SCM sym, int for_write) static SCM -mark_export_environment (SCM env) +export_environment_mark (SCM env) { struct export_environment *body = EXPORT_ENVIRONMENT (env); @@ -2047,7 +2040,7 @@ mark_export_environment (SCM env) static scm_sizet -free_export_environment (SCM env) +export_environment_free (SCM env) { core_environments_finalize (env); @@ -2057,7 +2050,7 @@ free_export_environment (SCM env) static int -print_export_environment (SCM type, SCM port, scm_print_state *pstate) +export_environment_print (SCM type, SCM port, scm_print_state *pstate) { SCM address = scm_ulong2num (SCM_UNPACK (type)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); @@ -2079,9 +2072,9 @@ static struct scm_environment_funcs export_environment_funcs = { export_environment_cell, core_environments_observe, core_environments_unobserve, - mark_export_environment, - free_export_environment, - print_export_environment + export_environment_mark, + export_environment_free, + export_environment_print }; @@ -2303,15 +2296,14 @@ scm_environments_prehistory () { /* create environment smob */ scm_tc16_environment = scm_make_smob_type ("environment", 0); - scm_set_smob_mark (scm_tc16_environment, mark_environment); - scm_set_smob_free (scm_tc16_environment, free_environment); - scm_set_smob_print (scm_tc16_environment, print_environment); + scm_set_smob_mark (scm_tc16_environment, environment_mark); + scm_set_smob_free (scm_tc16_environment, environment_free); + scm_set_smob_print (scm_tc16_environment, environment_print); /* create observer smob */ scm_tc16_observer = scm_make_smob_type ("observer", 0); - scm_set_smob_mark (scm_tc16_observer, mark_observer); - scm_set_smob_free (scm_tc16_observer, free_observer); - scm_set_smob_print (scm_tc16_observer, print_observer); + scm_set_smob_mark (scm_tc16_observer, observer_mark); + scm_set_smob_print (scm_tc16_observer, observer_print); } diff --git a/libguile/environments.h b/libguile/environments.h index 9ed5cabc0..4e0d0b054 100644 --- a/libguile/environments.h +++ b/libguile/environments.h @@ -85,7 +85,7 @@ struct scm_environment_funcs { #define SCM_ENVIRONMENT_LOCATION_IMMUTABLE SCM_MAKINUM (1) #define SCM_ENVIRONMENT_LOCATION_NO_CELL SCM_BOOL_F -extern long scm_tc16_environment; +extern scm_bits_t scm_tc16_environment; #define SCM_ENVIRONMENT_P(x) \ (!SCM_IMP (x) && SCM_CELL_TYPE (x) == scm_tc16_environment) @@ -110,7 +110,7 @@ extern long scm_tc16_environment; #define SCM_ENVIRONMENT_UNOBSERVE(env, token) \ ((*(SCM_ENVIRONMENT_FUNCS (env)->unobserve)) (env, token)) -extern long scm_tc16_observer; +extern scm_bits_t scm_tc16_observer; #define SCM_OBSERVER_P(x) \ (!SCM_IMP (x) && (SCM_CELL_TYPE (x) == scm_tc16_observer)) diff --git a/libguile/eval.c b/libguile/eval.c index dbabf73af..4a3b8e12e 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -3656,7 +3656,7 @@ scm_closure (SCM code, SCM env) } -long scm_tc16_promise; +scm_bits_t scm_tc16_promise; SCM scm_makprom (SCM code) @@ -3667,7 +3667,7 @@ scm_makprom (SCM code) static int -prinprom (SCM exp,SCM port,scm_print_state *pstate) +promise_print (SCM exp, SCM port, scm_print_state *pstate) { int writingp = SCM_WRITINGP (pstate); scm_puts ("#> 16) -#define SCM_HOOK_PROCEDURES(hook) SCM_CELL_OBJECT_1 (hook) -#define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SET_CELL_OBJECT_1 ((hook), (procs)) +extern scm_bits_t scm_tc16_hook; -extern long scm_tc16_hook; +#define SCM_HOOKP(x) SCM_TYP16_PREDICATE (scm_tc16_hook, x) +#define SCM_HOOK_ARITY(hook) (SCM_CELL_WORD_0 (hook) >> 16) +#define SCM_HOOK_PROCEDURES(hook) SCM_CELL_OBJECT_1 (hook) +#define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SET_CELL_OBJECT_1 ((hook), (procs)) extern SCM scm_make_hook (SCM n_args); extern SCM scm_create_hook (const char* name, int n_args); diff --git a/libguile/keywords.c b/libguile/keywords.c index 017b6fc51..b8af91c08 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -55,16 +55,16 @@ #include "libguile/keywords.h" +scm_bits_t scm_tc16_keyword; + static int -prin_keyword (SCM exp,SCM port,scm_print_state *pstate) +keyword_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts ("#:", port); scm_puts(1 + SCM_SYMBOL_CHARS (SCM_CDR (exp)), port); return 1; } -int scm_tc16_keyword; - SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", 1, 0, 0, (SCM symbol), @@ -130,8 +130,9 @@ SCM_DEFINE (scm_keyword_dash_symbol, "keyword-dash-symbol", 1, 0, 0, void scm_init_keywords () { - scm_tc16_keyword = scm_make_smob_type_mfpe ("keyword", 0, - scm_markcdr, NULL, prin_keyword, NULL); + scm_tc16_keyword = scm_make_smob_type ("keyword", 0); + scm_set_smob_mark (scm_tc16_keyword, scm_markcdr); + scm_set_smob_print (scm_tc16_keyword, keyword_print); scm_keyword_obarray = scm_make_vector (SCM_MAKINUM (256), SCM_EOL); #ifndef SCM_MAGIC_SNARFER diff --git a/libguile/keywords.h b/libguile/keywords.h index b4f5d7811..4bac54acc 100644 --- a/libguile/keywords.h +++ b/libguile/keywords.h @@ -51,7 +51,8 @@ -extern int scm_tc16_keyword; +extern scm_bits_t scm_tc16_keyword; + #define SCM_KEYWORDP(X) (!SCM_IMP (X) && (SCM_CELL_TYPE (X) == scm_tc16_keyword)) #define SCM_KEYWORDSYM(X) (SCM_CELL_OBJECT_1 (X)) diff --git a/libguile/macros.c b/libguile/macros.c index 977abd41d..fd6ae53b2 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -51,7 +51,7 @@ #include "libguile/validate.h" #include "libguile/macros.h" -long scm_tc16_macro; +scm_bits_t scm_tc16_macro; SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0, (SCM code), @@ -116,7 +116,7 @@ SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0, "syntax transformer.") #define FUNC_NAME s_scm_macro_p { - return SCM_BOOL(SCM_NIMP (obj) && SCM_TYP16 (obj) == scm_tc16_macro); + return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_macro, obj)); } #undef FUNC_NAME @@ -133,7 +133,7 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, "@code{#f} is returned.") #define FUNC_NAME s_scm_macro_type { - if (!(SCM_NIMP (m) && SCM_TYP16 (m) == scm_tc16_macro)) + if (!SCM_TYP16_PREDICATE (scm_tc16_macro, m)) return SCM_BOOL_F; switch (SCM_CELL_WORD_0 (m) >> 16) { @@ -179,8 +179,8 @@ scm_make_synt (const char *name, SCM (*macroizer) (), SCM (*fcn)() ) void scm_init_macros () { - scm_tc16_macro = scm_make_smob_type_mfpe ("macro", 0, - scm_markcdr, NULL, NULL, NULL); + scm_tc16_macro = scm_make_smob_type ("macro", 0); + scm_set_smob_mark (scm_tc16_macro, scm_markcdr); #ifndef SCM_MAGIC_SNARFER #include "libguile/macros.x" #endif diff --git a/libguile/macros.h b/libguile/macros.h index 7871be156..af7ee7014 100644 --- a/libguile/macros.h +++ b/libguile/macros.h @@ -50,7 +50,7 @@ #define SCM_ASSYNT(_cond, _arg, _pos, _subr) if(!(_cond))scm_wta(_arg, (char *)_pos, _subr); -extern long scm_tc16_macro; +extern scm_bits_t scm_tc16_macro; extern SCM scm_makacro (SCM code); extern SCM scm_makmacro (SCM code); diff --git a/libguile/mallocs.c b/libguile/mallocs.c index fd58a2f4c..f0f9606c6 100644 --- a/libguile/mallocs.c +++ b/libguile/mallocs.c @@ -38,11 +38,11 @@ - +scm_bits_t scm_tc16_malloc; static scm_sizet -fmalloc(SCM ptr) +malloc_free (SCM ptr) { if (SCM_MALLOCDATA (ptr)) free (SCM_MALLOCDATA (ptr)); @@ -51,7 +51,7 @@ fmalloc(SCM ptr) static int -prinmalloc (SCM exp,SCM port,scm_print_state *pstate) +malloc_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts("#writingp) #define SCM_SET_WRITINGP(pstate, x) { (pstate)->writingp = (x); } -#define SCM_PORT_WITH_PS_P(p) (SCM_NIMP(p) && (SCM_TYP16 (p) == scm_tc16_port_with_ps)) +#define SCM_PORT_WITH_PS_P(p) SCM_TYP16_PREDICATE (scm_tc16_port_with_ps, p) #define SCM_PORT_WITH_PS_PORT(p) SCM_CADR (p) -#define SCM_PORT_WITH_PS_PS(p) SCM_CDDR (p) +#define SCM_PORT_WITH_PS_PS(p) SCM_CDDR (p) #define SCM_COERCE_OUTPORT(p) (SCM_NIMP (p) && SCM_PORT_WITH_PS_P (p) \ ? SCM_PORT_WITH_PS_PORT (p) \ @@ -101,7 +101,7 @@ typedef struct scm_print_state { extern SCM scm_print_state_vtable; /* ? scm or long? print.h and print.c disagree */ -extern long scm_tc16_port_with_ps; +extern scm_bits_t scm_tc16_port_with_ps; extern SCM scm_print_options (SCM setting); SCM scm_make_print_state (void); diff --git a/libguile/random.c b/libguile/random.c index b33d4e3b8..2e342467e 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -329,7 +329,7 @@ scm_c_random_bignum (scm_rstate *state, SCM m) * Scheme level representation of random states. */ -long scm_tc16_rstate; +scm_bits_t scm_tc16_rstate; static SCM make_rstate (scm_rstate *state) @@ -338,7 +338,7 @@ make_rstate (scm_rstate *state) } static scm_sizet -free_rstate (SCM rstate) +rstate_free (SCM rstate) { free (SCM_RSTATE (rstate)); return scm_the_rng.rstate_size; @@ -577,8 +577,8 @@ scm_init_random () }; scm_the_rng = rng; - scm_tc16_rstate = scm_make_smob_type_mfpe ("random-state", 0, - NULL, free_rstate, NULL, NULL); + scm_tc16_rstate = scm_make_smob_type ("random-state", 0); + scm_set_smob_free (scm_tc16_rstate, rstate_free); for (m = 1; m <= 0x100; m <<= 1) for (i = m >> 1; i < m; ++i) diff --git a/libguile/random.h b/libguile/random.h index 38aba09ff..797bae4a0 100644 --- a/libguile/random.h +++ b/libguile/random.h @@ -108,9 +108,9 @@ 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_CELL_WORD_1 (obj)) -#define SCM_RSTATEP(obj) (SCM_NIMP(obj) && (SCM_TYP16 (obj) == scm_tc16_rstate)) +extern scm_bits_t scm_tc16_rstate; +#define SCM_RSTATEP(obj) SCM_TYP16_PREDICATE (scm_tc16_rstate, obj) +#define SCM_RSTATE(obj) ((scm_rstate *) SCM_CELL_WORD_1 (obj)) extern unsigned char scm_masktab[256]; diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 6866fb071..0abb4b8da 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -92,10 +92,10 @@ #define REG_BASIC 0 #endif -long scm_tc16_regex; +scm_bits_t scm_tc16_regex; static scm_sizet -free_regex (SCM obj) +regex_free (SCM obj) { regfree (SCM_RGX (obj)); free (SCM_RGX (obj)); @@ -280,8 +280,8 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, void scm_init_regex_posix () { - scm_tc16_regex = scm_make_smob_type_mfpe ("regexp", sizeof (regex_t), - NULL, free_regex, NULL, NULL); + scm_tc16_regex = scm_make_smob_type ("regexp", sizeof (regex_t)); + scm_set_smob_free (scm_tc16_regex, regex_free); /* Compilation flags. */ scm_sysintern ("regexp/basic", scm_long2num (REG_BASIC)); diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h index ab979b799..07ff7a147 100644 --- a/libguile/regex-posix.h +++ b/libguile/regex-posix.h @@ -50,7 +50,7 @@ #include "libguile/__scm.h" -extern long scm_tc16_regex; +extern scm_bits_t scm_tc16_regex; #define SCM_RGX(X) ((regex_t *) SCM_CELL_WORD_1 (X)) #define SCM_RGXP(X) (SCM_NIMP (X) && (SCM_CELL_TYPE (X) == scm_tc16_regex)) diff --git a/libguile/root.c b/libguile/root.c index c0c8ebfa6..88ae8b0ca 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -60,7 +60,7 @@ SCM scm_sys_protects[SCM_NUM_PROTECTS]; -long scm_tc16_root; +scm_bits_t scm_tc16_root; #ifndef USE_THREADS struct scm_root_state *scm_root; @@ -69,7 +69,7 @@ struct scm_root_state *scm_root; static SCM -mark_root (SCM root) +root_mark (SCM root) { scm_root_state *s = SCM_ROOT_STATE (root); @@ -92,7 +92,7 @@ mark_root (SCM root) static int -print_root (SCM exp,SCM port,scm_print_state *pstate) +root_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts ("# rootcont), 16, port); @@ -428,8 +428,8 @@ void scm_init_root () { scm_tc16_root = scm_make_smob_type ("root", sizeof (struct scm_root_state)); - scm_set_smob_mark (scm_tc16_root, mark_root); - scm_set_smob_print (scm_tc16_root, print_root); + scm_set_smob_mark (scm_tc16_root, root_mark); + scm_set_smob_print (scm_tc16_root, root_print); #ifndef SCM_MAGIC_SNARFER #include "libguile/root.x" diff --git a/libguile/root.h b/libguile/root.h index b06285b62..cc07ec622 100644 --- a/libguile/root.h +++ b/libguile/root.h @@ -82,9 +82,9 @@ extern SCM scm_sys_protects[]; -extern long scm_tc16_root; +extern scm_bits_t scm_tc16_root; -#define SCM_ROOTP(obj) (SCM_NIMP(obj) && (scm_tc16_root == SCM_TYP16 (obj))) +#define SCM_ROOTP(obj) SCM_TYP16_PREDICATE (scm_tc16_root, obj) #define SCM_ROOT_STATE(root) ((scm_root_state *) SCM_CELL_WORD_1 (root)) typedef struct scm_root_state diff --git a/libguile/smob.c b/libguile/smob.c index 5b9a0703c..9c8463250 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -508,38 +508,41 @@ scm_set_smob_mfpe (long tc, */ static int -freeprint (SCM exp, - SCM port, - scm_print_state *pstate) +free_print (SCM exp, SCM port, scm_print_state *pstate) { char buf[100]; - sprintf (buf, "#", (void *) SCM_UNPACK (exp)); + sprintf (buf, "#", + (void *) SCM_UNPACK (exp)); scm_puts (buf, port); return 1; } - void scm_smob_prehistory () { + scm_bits_t tc; + scm_numsmob = 0; scm_smobs = ((scm_smob_descriptor *) malloc (7 * sizeof (scm_smob_descriptor))); /* WARNING: These scm_make_smob_type calls must be done in this order */ - scm_make_smob_type_mfpe ("free", 0, - NULL, NULL, freeprint, NULL); + tc = scm_make_smob_type ("free", 0); + scm_set_smob_print (tc, free_print); - scm_make_smob_type_mfpe ("big", 0, /* freed in gc */ - NULL, NULL, scm_bigprint, scm_bigequal); + tc = scm_make_smob_type ("big", 0); /* freed in gc */ + scm_set_smob_print (tc, scm_bigprint); + scm_set_smob_equalp (tc, scm_bigequal); - scm_make_smob_type_mfpe ("real", 0, /* freed in gc */ - NULL, NULL, scm_print_real, scm_real_equalp); + tc = scm_make_smob_type ("real", 0); /* freed in gc */ + scm_set_smob_print (tc, scm_print_real); + scm_set_smob_equalp (tc, scm_real_equalp); - scm_make_smob_type_mfpe ("complex", 0, /* freed in gc */ - NULL, NULL, scm_print_complex, scm_complex_equalp); + tc = scm_make_smob_type ("complex", 0); /* freed in gc */ + scm_set_smob_print (tc, scm_print_complex); + scm_set_smob_equalp (tc, scm_complex_equalp); } /* diff --git a/libguile/smob.h b/libguile/smob.h index 878bd62e8..065001b69 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -116,8 +116,7 @@ do { \ #define SCM_SMOBNUM(x) (SCM_TC2SMOBNUM (SCM_CELL_TYPE (x))) /* SCM_SMOBNAME can be 0 if name is missing */ #define SCM_SMOBNAME(smobnum) (scm_smobs[smobnum].name) -#define SCM_SMOB_PREDICATE(tag, obj) (SCM_NIMP (obj) \ - && SCM_TYP16 (obj) == (tag)) +#define SCM_SMOB_PREDICATE(tag, obj) SCM_TYP16_PREDICATE (tag, obj) #define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)]) #define SCM_SMOB_APPLICABLE_P(x) (SCM_SMOB_DESCRIPTOR (x).apply) #define SCM_SMOB_APPLY_0(x) (SCM_SMOB_DESCRIPTOR (x).apply_0 (x)) diff --git a/libguile/srcprop.c b/libguile/srcprop.c index ca3907408..7df11f8f2 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -82,13 +82,13 @@ SCM scm_sym_line; SCM scm_sym_column; SCM scm_sym_breakpoint; -long scm_tc16_srcprops; +scm_bits_t scm_tc16_srcprops; static scm_srcprops_chunk *srcprops_chunklist = 0; static scm_srcprops *srcprops_freelist = 0; static SCM -marksrcprops (SCM obj) +srcprops_mark (SCM obj) { scm_gc_mark (SRCPROPFNAME (obj)); scm_gc_mark (SRCPROPCOPY (obj)); @@ -97,7 +97,7 @@ marksrcprops (SCM obj) static scm_sizet -freesrcprops (SCM obj) +srcprops_free (SCM obj) { *((scm_srcprops **) SCM_CELL_WORD_1 (obj)) = srcprops_freelist; srcprops_freelist = (scm_srcprops *) SCM_CELL_WORD_1 (obj); @@ -106,7 +106,7 @@ freesrcprops (SCM obj) static int -prinsrcprops (SCM obj,SCM port,scm_print_state *pstate) +srcprops_print (SCM obj, SCM port, scm_print_state *pstate) { int writingp = SCM_WRITINGP (pstate); scm_puts ("#pos #define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12) diff --git a/libguile/tags.h b/libguile/tags.h index 76fe2fe51..6d4b6ed70 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -323,6 +323,8 @@ typedef long scm_bits_t; #define SCM_TYP16(x) (0xffff & SCM_CELL_TYPE (x)) #define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x)) +#define SCM_TYP16_PREDICATE(tag,x) (SCM_NIMP (x) && SCM_TYP16 (x) == (tag)) + #define scm_tc7_symbol 5 diff --git a/libguile/threads.c b/libguile/threads.c index 8bedc5453..85f38ca96 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -71,11 +71,9 @@ -long scm_tc16_thread; - -long scm_tc16_mutex; - -long scm_tc16_condvar; +scm_bits_t scm_tc16_thread; +scm_bits_t scm_tc16_mutex; +scm_bits_t scm_tc16_condvar; /* Scheme-visible thread functions. */ diff --git a/libguile/threads.h b/libguile/threads.h index 8fba1775a..10142feb0 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -55,17 +55,17 @@ /* smob tags for the thread datatypes */ -extern long scm_tc16_thread; -extern long scm_tc16_mutex; -extern long scm_tc16_condvar; +extern scm_bits_t scm_tc16_thread; +extern scm_bits_t scm_tc16_mutex; +extern scm_bits_t scm_tc16_condvar; -#define SCM_THREADP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_thread)) -#define SCM_THREAD_DATA(x) ((void *) SCM_CELL_WORD_1 (x)) +#define SCM_THREADP(x) SCM_TYP16_PREDICATE (scm_tc16_thread, x) +#define SCM_THREAD_DATA(x) ((void *) SCM_CELL_WORD_1 (x)) -#define SCM_MUTEXP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_mutex)) -#define SCM_MUTEX_DATA(x) ((void *) SCM_CELL_WORD_1 (x)) +#define SCM_MUTEXP(x) SCM_TYP16_PREDICATE (scm_tc16_mutex, x)) +#define SCM_MUTEX_DATA(x) ((void *) SCM_CELL_WORD_1 (x)) -#define SCM_CONDVARP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_condvar)) +#define SCM_CONDVARP(x) SCM_TYP16_PREDICATE (scm_tc16_condvar, x) #define SCM_CONDVAR_DATA(x) ((void *) SCM_CELL_WORD_1 (x)) /* Initialize implementation specific details of the threads support */ diff --git a/libguile/throw.c b/libguile/throw.c index ebd2a2bfe..60d5bc9cc 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -66,13 +66,13 @@ /* the jump buffer data structure */ -static int scm_tc16_jmpbuffer; +static scm_bits_t tc16_jmpbuffer; -#define SCM_JMPBUFP(OBJ) (SCM_NIMP(OBJ) && (SCM_TYP16(OBJ) == scm_tc16_jmpbuffer)) +#define SCM_JMPBUFP(OBJ) SCM_TYP16_PREDICATE (tc16_jmpbuffer, OBJ) -#define JBACTIVE(OBJ) (SCM_CELL_WORD_0 (OBJ) & (1L << 16L)) -#define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L))) -#define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L))) +#define JBACTIVE(OBJ) (SCM_CELL_WORD_0 (OBJ) & (1L << 16L)) +#define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L))) +#define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L))) #define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ)) #define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) @@ -82,17 +82,15 @@ static int scm_tc16_jmpbuffer; #endif static int -printjb (SCM exp, SCM port, scm_print_state *pstate) +jmpbuffer_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts ("#', port); return 1 ; } - static SCM make_jmpbuf (void) { @@ -100,9 +98,9 @@ make_jmpbuf (void) SCM_REDEFER_INTS; { #ifdef DEBUG_EXTENSIONS - SCM_NEWSMOB2 (answer, scm_tc16_jmpbuffer, 0, 0); + SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0); #else - SCM_NEWSMOB (answer, scm_tc16_jmpbuffer, 0); + SCM_NEWSMOB (answer, tc16_jmpbuffer, 0); #endif SETJBJMPBUF(answer, (jmp_buf *)0); DEACTIVATEJB(answer); @@ -218,7 +216,7 @@ scm_internal_catch (SCM tag, scm_catch_body_t body, void *body_data, scm_catch_h /* scm_internal_lazy_catch (the guts of lazy catching) */ /* The smob tag for lazy_catch smobs. */ -static long tc16_lazy_catch; +static scm_bits_t tc16_lazy_catch; /* This is the structure we put on the wind list for a lazy catch. It stores the handler function to call, and the data pointer to pass @@ -238,7 +236,7 @@ struct lazy_catch { appear in normal data structures, only in the wind list. However, it might be nice for debugging someday... */ static int -print_lazy_catch (SCM closure, SCM port, scm_print_state *pstate) +lazy_catch_print (SCM closure, SCM port, scm_print_state *pstate) { struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (closure); char buf[200]; @@ -260,7 +258,7 @@ make_lazy_catch (struct lazy_catch *c) SCM_RETURN_NEWSMOB (tc16_lazy_catch, c); } -#define SCM_LAZY_CATCH_P(obj) (SCM_SMOB_PREDICATE (tc16_lazy_catch, obj)) +#define SCM_LAZY_CATCH_P(obj) (SCM_TYP16_PREDICATE (tc16_lazy_catch, obj)) /* Exactly like scm_internal_catch, except: @@ -694,18 +692,12 @@ scm_ithrow (SCM key, SCM args, int noreturn) void scm_init_throw () { - scm_tc16_jmpbuffer = scm_make_smob_type_mfpe ("jmpbuffer", - 0, - NULL, /* mark */ - NULL, - printjb, - NULL); - - tc16_lazy_catch = scm_make_smob_type_mfpe ("lazy-catch", 0, - NULL, - NULL, - print_lazy_catch, - NULL); + tc16_jmpbuffer = scm_make_smob_type ("jmpbuffer", 0); + scm_set_smob_print (tc16_jmpbuffer, jmpbuffer_print); + + tc16_lazy_catch = scm_make_smob_type ("lazy-catch", 0); + scm_set_smob_print (tc16_lazy_catch, lazy_catch_print); + #ifndef SCM_MAGIC_SNARFER #include "libguile/throw.x" #endif diff --git a/libguile/unif.c b/libguile/unif.c index 0d13c46e4..96d1fd472 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -86,7 +86,7 @@ * long long llvect */ -long scm_tc16_array; +scm_bits_t scm_tc16_array; /* return the size of an element in a uniform array or 0 if type not found. */ @@ -2540,14 +2540,14 @@ loop: static SCM -markra (SCM ptr) +array_mark (SCM ptr) { return SCM_ARRAY_V (ptr); } static scm_sizet -freera (SCM ptr) +array_free (SCM ptr) { scm_must_free (SCM_ARRAY_MEM (ptr)); return sizeof (scm_array) + SCM_ARRAY_NDIM (ptr) * sizeof (scm_array_dim); @@ -2556,11 +2556,11 @@ freera (SCM ptr) void scm_init_unif () { - scm_tc16_array = scm_make_smob_type_mfpe ("array", 0, - markra, - freera, - scm_raprin1, - scm_array_equal_p); + scm_tc16_array = scm_make_smob_type ("array", 0); + scm_set_smob_mark (scm_tc16_array, array_mark); + scm_set_smob_free (scm_tc16_array, array_free); + scm_set_smob_print (scm_tc16_array, scm_raprin1); + scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p); scm_add_feature ("array"); #ifndef SCM_MAGIC_SNARFER #include "libguile/unif.x" diff --git a/libguile/unif.h b/libguile/unif.h index 432ac0e11..fd4d0e744 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -75,8 +75,8 @@ typedef struct scm_array_dim } scm_array_dim; -extern long scm_tc16_array; -#define SCM_ARRAYP(a) (SCM_NIMP(a) && (scm_tc16_array == SCM_TYP16(a))) +extern scm_bits_t scm_tc16_array; +#define SCM_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_array, a) #define SCM_ARRAY_NDIM(x) ((scm_sizet) (SCM_CELL_WORD_0 (x) >> 17)) #define SCM_ARRAY_CONTIGUOUS 0x10000 #define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (SCM_CELL_WORD_0 (x))) diff --git a/libguile/validate.h b/libguile/validate.h index 5250f7645..bab069efe 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -1,4 +1,4 @@ -/* $Id: validate.h,v 1.20 2000-11-22 09:16:06 dirk Exp $ */ +/* $Id: validate.h,v 1.21 2000-12-08 17:32:56 kei Exp $ */ /* Copyright (C) 1999, 2000 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -283,7 +283,7 @@ #define SCM_VALIDATE_SMOB(pos, obj, type) \ do { \ - SCM_ASSERT ((SCM_NIMP (obj) && SCM_TYP16 (obj) == scm_tc16_ ## type), \ + SCM_ASSERT (SCM_TYP16_PREDICATE (scm_tc16_ ## type, obj), \ obj, pos, FUNC_NAME); \ } while (0) diff --git a/libguile/variable.c b/libguile/variable.c index 304ea009b..163fb8ed2 100644 --- a/libguile/variable.c +++ b/libguile/variable.c @@ -54,9 +54,10 @@ #include "libguile/validate.h" #include "libguile/variable.h" +scm_bits_t scm_tc16_variable; static int -prin_var (SCM exp,SCM port,scm_print_state *pstate) +variable_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts ("#