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

Smob-related creanup.

Browse source
This commit is contained in:
Keisuke Nishida 2000-12-08 17:32:56 +00:00
parent 38ae064c6e
commit e841c3e0c0
51 changed files with 385 additions and 259 deletions
Download patch file Download diff file Expand all files Collapse all files

142
libguile/ChangeLog
View file

@ -1,3 +1,145 @@
2000-12-08 Keisuke Nishida <kxn30@po.cwru.edu>
* 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 <D.Herrmann@tu-bs.de>
* feature.c (scm_add_feature), gh_data.c (gh_symbol2scm), goops.c

9
libguile/arbiters.c
View file

@ -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 ("#<arbiter ", port);
if (SCM_ARB_LOCKED (exp))
@ -126,8 +126,9 @@ SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0,
void
scm_init_arbiters ()
{
scm_tc16_arbiter = scm_make_smob_type_mfpe ("arbiter", 0,
scm_markcdr, NULL, prinarb, NULL);
scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0);
scm_set_smob_mark (scm_tc16_arbiter, scm_markcdr);
scm_set_smob_print (scm_tc16_arbiter, arbiter_print);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/arbiters.x"
#endif

11
libguile/async.c
View file

@ -110,15 +110,14 @@ static unsigned int scm_desired_switch_rate = 0;
int scm_asyncs_pending_p = 0;
#endif
static long tc16_async;
static scm_bits_t tc16_async;
/* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it.
this is ugly. */
#define SCM_ASYNCP(X) (SCM_NIMP(X) && (tc16_async == SCM_TYP16 (X)))
#define VALIDATE_ASYNC(pos,a) SCM_MAKE_VALIDATE(pos, a, ASYNCP)
#define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X)
#define VALIDATE_ASYNC(pos,a) SCM_MAKE_VALIDATE(pos, a, ASYNCP)
#define ASYNC_GOT_IT(X) (SCM_CELL_WORD_0 (X) >> 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"

10
libguile/continuations.c
View file

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

3
libguile/continuations.h
View file

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

18
libguile/debug.c
View file

@ -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 ("#<memoized ", port);
@ -553,10 +552,10 @@ scm_m_start_stack (SCM exp, SCM env)
* The debugging evaluator throws these on frame traps.
*/
long scm_tc16_debugobj;
scm_bits_t scm_tc16_debugobj;
static int
prindebugobj (SCM obj,SCM port,scm_print_state *pstate)
debugobj_print (SCM obj, SCM port, scm_print_state *pstate)
{
scm_puts ("#<debug-object ", port);
scm_intprint ((int) SCM_DEBUGOBJ_FRAME (obj), 16, port);
@ -609,11 +608,12 @@ scm_init_debug ()
{
scm_init_opts (scm_debug_options, scm_debug_opts, SCM_N_DEBUG_OPTIONS);
scm_tc16_memoized = scm_make_smob_type_mfpe ("memoized", 0,
scm_markcdr, NULL, prinmemoized, NULL);
scm_tc16_memoized = scm_make_smob_type ("memoized", 0);
scm_set_smob_mark (scm_tc16_memoized, scm_markcdr);
scm_set_smob_print (scm_tc16_memoized, memoized_print);
scm_tc16_debugobj = scm_make_smob_type_mfpe ("debug-object", 0,
NULL, NULL, prindebugobj, NULL);
scm_tc16_debugobj = scm_make_smob_type ("debug-object", 0);
scm_set_smob_print (scm_tc16_debugobj, debugobj_print);
scm_sym_procname = SCM_CAR (scm_sysintern ("procname", SCM_UNDEFINED));
scm_sym_dots = SCM_CAR (scm_sysintern ("...", SCM_UNDEFINED));

17
libguile/debug.h
View file

@ -164,21 +164,20 @@ extern scm_debug_frame *scm_last_debug_frame;
/* {Debug Objects}
*/
extern long scm_tc16_debugobj;
extern scm_bits_t scm_tc16_debugobj;
#define SCM_DEBUGOBJP(x) (SCM_NIMP (x) \
&& (SCM_TYP16 (x) == scm_tc16_debugobj))
#define SCM_DEBUGOBJ_FRAME(x) (SCM_CELL_WORD_1 (x))
#define SCM_SET_DEBUGOBJ_FRAME(x, f) (SCM_SET_CELL_WORD_1 (x, f))
#define SCM_DEBUGOBJP(x) SCM_TYP16_PREDICATE (scm_tc16_debugobj, x)
#define SCM_DEBUGOBJ_FRAME(x) SCM_CELL_WORD_1 (x)
#define SCM_SET_DEBUGOBJ_FRAME(x, f) SCM_SET_CELL_WORD_1 (x, f)
/* {Memoized Source}
*/
extern long scm_tc16_memoized;
extern scm_bits_t scm_tc16_memoized;
#define SCM_MEMOIZEDP(x) (SCM_NIMP(x) && (scm_tc16_memoized == SCM_TYP16 (x)))
#define SCM_MEMOIZED_EXP(x) SCM_CAR (SCM_CDR (x))
#define SCM_MEMOIZED_ENV(x) SCM_CDR (SCM_CDR (x))
#define SCM_MEMOIZEDP(x) SCM_TYP16_PREDICATE (scm_tc16_memoized, x)
#define SCM_MEMOIZED_EXP(x) SCM_CAR (SCM_CELL_OBJECT_1 (x))
#define SCM_MEMOIZED_ENV(x) SCM_CDR (SCM_CELL_OBJECT_1 (x))

13
libguile/dynl.c
View file

@ -321,7 +321,7 @@ sysdep_dynl_func (const char *symbol,
#endif
int scm_tc16_dynamic_obj;
scm_bits_t scm_tc16_dynamic_obj;
#define DYNL_FILENAME(x) (SCM_CELL_OBJECT_1 (x))
#define DYNL_HANDLE(x) ((void *) SCM_CELL_WORD_2 (x))
@ -329,13 +329,14 @@ int scm_tc16_dynamic_obj;
static SCM
mark_dynl_obj (SCM ptr)
dynl_obj_mark (SCM ptr)
{
return DYNL_FILENAME (ptr);
}
static int
print_dynl_obj (SCM exp,SCM port,scm_print_state *pstate)
dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<dynamic-object ", port);
scm_iprin1 (DYNL_FILENAME (exp), port, pstate);
@ -369,7 +370,7 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
"otherwise.")
#define FUNC_NAME s_scm_dynamic_object_p
{
return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_dynamic_obj, obj));
return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_dynamic_obj, obj));
}
#undef FUNC_NAME
@ -513,8 +514,8 @@ void
scm_init_dynamic_linking ()
{
scm_tc16_dynamic_obj = scm_make_smob_type ("dynamic-object", 0);
scm_set_smob_mark (scm_tc16_dynamic_obj, mark_dynl_obj);
scm_set_smob_print (scm_tc16_dynamic_obj, print_dynl_obj);
scm_set_smob_mark (scm_tc16_dynamic_obj, dynl_obj_mark);
scm_set_smob_print (scm_tc16_dynamic_obj, dynl_obj_print);
sysdep_dynl_init ();
#ifndef SCM_MAGIC_SNARFER
#include "libguile/dynl.x"

10
libguile/dynwind.c
View file

@ -135,15 +135,15 @@ SCM_DEFINE (scm_dynamic_wind, "dynamic-wind", 3, 0, 0,
* smob. Objects of this type are pushed onto the dynwind chain.
*/
#define SCM_GUARDSP(obj) SCM_SMOB_PREDICATE (tc16_guards, obj)
#define SCM_GUARDSP(obj) SCM_TYP16_PREDICATE (tc16_guards, obj)
#define SCM_BEFORE_GUARD(obj) ((scm_guard_t) SCM_CELL_WORD (obj, 1))
#define SCM_AFTER_GUARD(obj) ((scm_guard_t) SCM_CELL_WORD (obj, 2))
#define SCM_GUARD_DATA(obj) ((void *) SCM_CELL_WORD (obj, 3))
static long tc16_guards;
static scm_bits_t tc16_guards;
static int
printguards (SCM exp, SCM port, scm_print_state *pstate)
guards_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<guards ", port);
scm_intprint (SCM_UNPACK (SCM_CDR (exp)), 16, port);
@ -271,8 +271,8 @@ scm_dowinds (SCM to, long delta)
void
scm_init_dynwind ()
{
tc16_guards = scm_make_smob_type_mfpe ("guards", 0,
NULL, scm_free0, printguards, NULL);
tc16_guards = scm_make_smob_type ("guards", 0);
scm_set_smob_print (tc16_guards, guards_print);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/dynwind.x"
#endif

80
libguile/environments.c
View file

@ -56,8 +56,8 @@
long scm_tc16_environment;
long scm_tc16_observer;
scm_bits_t scm_tc16_environment;
scm_bits_t scm_tc16_observer;
#define DEFAULT_OBARRAY_SIZE 137
@ -453,21 +453,21 @@ SCM_DEFINE (scm_environment_unobserve, "environment-unobserve", 1, 0, 0,
static SCM
mark_environment (SCM env)
environment_mark (SCM env)
{
return (*(SCM_ENVIRONMENT_FUNCS (env)->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);
}

4
libguile/environments.h
View file

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

8
libguile/eval.c
View file

@ -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 ("#<promise ", port);
@ -3708,7 +3708,7 @@ SCM_DEFINE (scm_promise_p, "promise?", 1, 0, 0,
"(@pxref{Delayed evaluation,,,r4rs.info,The Revised^4 Report on Scheme}).")
#define FUNC_NAME s_scm_promise_p
{
return SCM_BOOL (SCM_SMOB_PREDICATE (scm_tc16_promise, x));
return SCM_BOOL (SCM_TYP16_PREDICATE (scm_tc16_promise, x));
}
#undef FUNC_NAME
@ -3875,7 +3875,7 @@ scm_init_eval ()
scm_tc16_promise = scm_make_smob_type ("promise", 0);
scm_set_smob_mark (scm_tc16_promise, scm_markcdr);
scm_set_smob_print (scm_tc16_promise, prinprom);
scm_set_smob_print (scm_tc16_promise, promise_print);
scm_f_apply = scm_make_subr ("apply", scm_tc7_lsubr_2, scm_apply);
scm_system_transformer = scm_sysintern ("scm:eval-transformer",

2
libguile/eval.h
View file

@ -172,7 +172,7 @@ extern SCM scm_sym_args;
extern SCM scm_f_apply;
extern long scm_tc16_macro;
extern scm_bits_t scm_tc16_macro;
/* A resolved global variable reference in the CAR position
* of a list is stored (in code only) as a pointer to a pair with a

7
libguile/filesys.c
View file

@ -676,7 +676,7 @@ SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
/* {Examining Directories}
*/
long scm_tc16_dir;
scm_bits_t scm_tc16_dir;
SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
(SCM obj),
@ -1414,8 +1414,9 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
void
scm_init_filesys ()
{
scm_tc16_dir = scm_make_smob_type_mfpe ("directory", 0,
NULL, scm_dir_free,scm_dir_print, NULL);
scm_tc16_dir = scm_make_smob_type ("directory", 0);
scm_set_smob_free (scm_tc16_dir, scm_dir_free);
scm_set_smob_print (scm_tc16_dir, scm_dir_print);
scm_dot_string = scm_permanent_object (scm_makfrom0str ("."));

2
libguile/filesys.h
View file

@ -52,7 +52,7 @@
extern long scm_tc16_dir;
extern scm_bits_t scm_tc16_dir;
#define SCM_DIRP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_dir))
#define SCM_OPDIRP(x) (!SCM_IMP (x) && (SCM_CELL_WORD_0 (x) == (scm_tc16_dir | SCM_OPN)))

8
libguile/fluids.c
View file

@ -56,7 +56,7 @@
#include "libguile/validate.h"
static volatile int n_fluids;
long scm_tc16_fluid;
scm_bits_t scm_tc16_fluid;
SCM
scm_make_initial_fluids ()
@ -96,7 +96,7 @@ scm_copy_fluids (scm_root_state *root_state)
}
static int
print_fluid (SCM exp, SCM port, scm_print_state *pstate)
fluid_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<fluid ", port);
scm_intprint ((int) SCM_FLUID_NUM (exp), 10, port);
@ -258,8 +258,8 @@ scm_internal_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
void
scm_init_fluids ()
{
scm_tc16_fluid = scm_make_smob_type_mfpe ("fluid", 0,
NULL, NULL, print_fluid, NULL);
scm_tc16_fluid = scm_make_smob_type ("fluid", 0);
scm_set_smob_print (scm_tc16_fluid, fluid_print);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/fluids.x"
#endif

2
libguile/fluids.h
View file

@ -73,7 +73,7 @@
implement a more lightweight version of fluids on top of this basic
mechanism. */
extern long scm_tc16_fluid;
extern scm_bits_t scm_tc16_fluid;
#define SCM_FLUIDP(x) (!SCM_IMP (x) && (SCM_CELL_TYPE (x) == scm_tc16_fluid))
#define SCM_FLUID_NUM(x) (SCM_CELL_WORD_1 (x))

4
libguile/fports.c
View file

@ -427,7 +427,7 @@ fport_input_waiting (SCM port)
static int
prinfport (SCM exp,SCM port,scm_print_state *pstate)
fport_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<", port);
scm_print_port_mode (exp, port);
@ -733,7 +733,7 @@ scm_make_fptob ()
{
long tc = scm_make_port_type ("file", fport_fill_input, fport_write);
scm_set_port_free (tc, fport_free);
scm_set_port_print (tc, prinfport);
scm_set_port_print (tc, fport_print);
scm_set_port_flush (tc, fport_flush);
scm_set_port_end_input (tc, fport_end_input);
scm_set_port_close (tc, fport_close);

2
libguile/guardians.c
View file

@ -93,7 +93,7 @@ do { \
} while (0)
static long tc16_guardian;
static scm_bits_t tc16_guardian;
typedef struct guardian_t
{

7
libguile/hooks.c
View file

@ -148,7 +148,7 @@ scm_c_hook_run (scm_c_hook_t *hook, void *data)
* programs.
*/
long scm_tc16_hook;
scm_bits_t scm_tc16_hook;
static SCM
@ -172,7 +172,7 @@ make_hook (SCM n_args, const char *subr)
static int
print_hook (SCM hook, SCM port, scm_print_state *pstate)
hook_print (SCM hook, SCM port, scm_print_state *pstate)
{
SCM ls, name;
scm_puts ("#<hook ", port);
@ -352,8 +352,7 @@ scm_init_hooks ()
{
scm_tc16_hook = scm_make_smob_type ("hook", 0);
scm_set_smob_mark (scm_tc16_hook, scm_markcdr);
scm_set_smob_print (scm_tc16_hook, print_hook);
scm_set_smob_print (scm_tc16_hook, hook_print);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/hooks.x"
#endif

10
libguile/hooks.h
View file

@ -96,12 +96,12 @@ extern void *scm_c_hook_run (scm_c_hook_t *hook, void *data);
* Scheme level hooks
*/
#define SCM_HOOKP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_hook))
#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_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);

11
libguile/keywords.c
View file

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

3
libguile/keywords.h
View file

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

10
libguile/macros.c
View file

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

2
libguile/macros.h
View file

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

16
libguile/mallocs.c
View file

@ -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("#<malloc ", port);
scm_intprint (SCM_CELL_WORD_1 (exp), 16, port);
@ -60,10 +60,6 @@ prinmalloc (SCM exp,SCM port,scm_print_state *pstate)
}
int scm_tc16_malloc;
SCM
scm_malloc_obj (scm_sizet n)
{
@ -78,12 +74,12 @@ scm_malloc_obj (scm_sizet n)
void
scm_init_mallocs ()
{
scm_tc16_malloc = scm_make_smob_type_mfpe ("malloc", 0,
NULL, fmalloc, prinmalloc, NULL);
scm_tc16_malloc = scm_make_smob_type ("malloc", 0);
scm_set_smob_free (scm_tc16_malloc, malloc_free);
scm_set_smob_print (scm_tc16_malloc, malloc_print);
}
/*

2
libguile/mallocs.h
View file

@ -46,7 +46,7 @@
#include "libguile/__scm.h"
extern int scm_tc16_malloc;
extern scm_bits_t scm_tc16_malloc;
#define SCM_MALLOCP(X) (SCM_TYP16 (X) == scm_tc16_malloc)
#define SCM_MALLOCDATA(obj) ((char *) SCM_CELL_WORD_1 (obj))

10
libguile/modules.c
View file

@ -241,7 +241,7 @@ module_variable (SCM module, SCM sym)
}
}
SCM scm_eval_closure_tag;
scm_bits_t scm_tc16_eval_closure;
/* NOTE: This function may be called by a smob application
or from another C function directly. */
@ -262,7 +262,7 @@ SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0,
"")
#define FUNC_NAME s_scm_standard_eval_closure
{
SCM_RETURN_NEWSMOB (scm_eval_closure_tag, SCM_UNPACK (module));
SCM_RETURN_NEWSMOB (scm_tc16_eval_closure, SCM_UNPACK (module));
}
#undef FUNC_NAME
@ -274,9 +274,9 @@ scm_init_modules ()
#endif
module_make_local_var_x = scm_sysintern ("module-make-local-var!",
SCM_UNDEFINED);
scm_eval_closure_tag = scm_make_smob_type ("eval-closure", 0);
scm_set_smob_mark (scm_eval_closure_tag, scm_markcdr);
scm_set_smob_apply (scm_eval_closure_tag, scm_eval_closure_lookup, 2, 0, 0);
scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0);
scm_set_smob_mark (scm_tc16_eval_closure, scm_markcdr);
scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0);
}
void

5
libguile/modules.h
View file

@ -73,13 +73,14 @@
#define SCM_MODULE_EVAL_CLOSURE(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
#define SCM_EVAL_CLOSURE_P(OBJ) SCM_SMOB_PREDICATE (scm_eval_closure_tag, OBJ)
extern scm_bits_t scm_tc16_eval_closure;
#define SCM_EVAL_CLOSURE_P(x) SCM_TYP16_PREDICATE (scm_tc16_eval_closure, x)
extern SCM scm_module_system_booted_p;
extern SCM scm_module_tag;
extern SCM scm_eval_closure_tag;
extern SCM scm_the_root_module (void);
extern SCM scm_selected_module (void);

2
libguile/ports.c
View file

@ -1384,7 +1384,7 @@ scm_ports_prehistory ()
/* Void ports. */
long scm_tc16_void_port = 0;
scm_bits_t scm_tc16_void_port = 0;
static int fill_input_void_port (SCM port)
{

6
libguile/print.c
View file

@ -1079,12 +1079,12 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
* escaped to Scheme and thus has to be freed by the GC.
*/
long scm_tc16_port_with_ps;
scm_bits_t scm_tc16_port_with_ps;
/* Print exactly as the port itself would */
static int
print_port_with_ps (SCM obj, SCM port, scm_print_state *pstate)
port_with_ps_print (SCM obj, SCM port, scm_print_state *pstate)
{
obj = SCM_PORT_WITH_PS_PORT (obj);
return scm_ptobs[SCM_PTOBNUM (obj)].print (obj, port, pstate);
@ -1146,7 +1146,7 @@ scm_init_print ()
/* Don't want to bind a wrapper class in GOOPS, so pass 0 as arg1. */
scm_tc16_port_with_ps = scm_make_smob_type (0, 0);
scm_set_smob_mark (scm_tc16_port_with_ps, scm_markcdr);
scm_set_smob_print (scm_tc16_port_with_ps, print_port_with_ps);
scm_set_smob_print (scm_tc16_port_with_ps, port_with_ps_print);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/print.x"

6
libguile/print.h
View file

@ -73,9 +73,9 @@ do { \
#define SCM_WRITINGP(pstate) ((pstate)->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);

8
libguile/random.c
View file

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

6
libguile/random.h
View file

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

8
libguile/regex-posix.c
View file

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

2
libguile/regex-posix.h
View file

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

10
libguile/root.c
View file

@ -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 ("#<root ", port);
scm_intprint(SCM_SEQ (SCM_ROOT_STATE (exp) -> 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"

4
libguile/root.h
View file

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

29
libguile/smob.c
View file

@ -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, "#<freed cell %p; GC missed a reference>", (void *) SCM_UNPACK (exp));
sprintf (buf, "#<freed cell %p; GC missed a reference>",
(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);
}
/*

3
libguile/smob.h
View file

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

15
libguile/srcprop.c
View file

@ -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 ("#<srcprops ", port);
@ -323,8 +323,11 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
void
scm_init_srcprop ()
{
scm_tc16_srcprops = scm_make_smob_type_mfpe ("srcprops", 0,
marksrcprops, freesrcprops, prinsrcprops, NULL);
scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0);
scm_set_smob_mark (scm_tc16_srcprops, srcprops_mark);
scm_set_smob_free (scm_tc16_srcprops, srcprops_free);
scm_set_smob_print (scm_tc16_srcprops, srcprops_print);
scm_source_whash = scm_make_weak_key_hash_table (SCM_MAKINUM (2047));
scm_sym_filename = SCM_CAR (scm_sysintern ("filename", SCM_UNDEFINED));

4
libguile/srcprop.h
View file

@ -78,7 +78,7 @@ do { \
/* {Source properties}
*/
extern long scm_tc16_srcprops;
extern scm_bits_t scm_tc16_srcprops;
typedef struct scm_srcprops
{
@ -95,7 +95,7 @@ typedef struct scm_srcprops_chunk
scm_srcprops srcprops[1];
} scm_srcprops_chunk;
#define SRCPROPSP(p) (SCM_NIMP(p) && (SCM_TYP16 (p) == scm_tc16_srcprops))
#define SRCPROPSP(p) (SCM_TYP16_PREDICATE (scm_tc16_srcprops, p))
#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)

2
libguile/tags.h
View file

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

8
libguile/threads.c
View file

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

16
libguile/threads.h
View file

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

40
libguile/throw.c
View file

@ -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 ("#<jmpbuffer ", port);
scm_puts (JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
scm_intprint((long) JBJMPBUF (exp), 16, port);
scm_putc ('>', 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_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);
tc16_lazy_catch = scm_make_smob_type_mfpe ("lazy-catch", 0,
NULL,
NULL,
print_lazy_catch,
NULL);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/throw.x"
#endif

16
libguile/unif.c
View file

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

4
libguile/unif.h
View file

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

4
libguile/validate.h
View file

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

21
libguile/variable.c
View file

@ -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 ("#<variable ", port);
scm_intprint(SCM_UNPACK (exp), 16, port);
@ -75,20 +76,11 @@ prin_var (SCM exp,SCM port,scm_print_state *pstate)
return 1;
}
static SCM
scm_markvar (SCM ptr)
{
return SCM_CDR (ptr);
}
static SCM
var_equal (SCM var1, SCM var2)
variable_equalp (SCM var1, SCM var2)
{
return scm_equal_p (SCM_CDR (var1), SCM_CDR (var2));
}
int scm_tc16_variable;
static SCM anonymous_variable_sym;
@ -232,8 +224,11 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
void
scm_init_variable ()
{
scm_tc16_variable = scm_make_smob_type_mfpe ("variable", 0,
scm_markvar, NULL, prin_var, var_equal);
scm_tc16_variable = scm_make_smob_type ("variable", 0);
scm_set_smob_mark (scm_tc16_variable, scm_markcdr);
scm_set_smob_print (scm_tc16_variable, variable_print);
scm_set_smob_equalp (scm_tc16_variable, variable_equalp);
anonymous_variable_sym = SCM_CAR (scm_sysintern ("anonymous-variable", SCM_UNDEFINED));
#ifndef SCM_MAGIC_SNARFER
#include "libguile/variable.x"

2
libguile/variable.h
View file

@ -53,7 +53,7 @@
/* Variables
*/
extern int scm_tc16_variable;
extern scm_bits_t scm_tc16_variable;
#define SCM_VARVCELL(V) SCM_CDR(V)
#define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_CELL_TYPE (X) == scm_tc16_variable)