diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1999-07-07 09:44:01 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1999-07-07 09:44:01 +0000 |
commit | 23a621512f6a034a8624f589a3862dbddcec6b9d (patch) | |
tree | efb8b5a0f046402b74a5851fa1a902c40bc91561 | |
parent | 8ac40ce8871ccfa5e8c0a4fe3a1d55dfb69f839c (diff) | |
download | guile-23a621512f6a034a8624f589a3862dbddcec6b9d.tar.gz |
Greg's smob patch
-rw-r--r-- | libguile/arbiters.c | 10 | ||||
-rw-r--r-- | libguile/async.c | 14 | ||||
-rw-r--r-- | libguile/coop-threads.c | 52 | ||||
-rw-r--r-- | libguile/debug.c | 21 | ||||
-rw-r--r-- | libguile/dynl.c | 10 | ||||
-rw-r--r-- | libguile/dynwind.c | 16 | ||||
-rw-r--r-- | libguile/eval.c | 8 | ||||
-rw-r--r-- | libguile/filesys.c | 13 | ||||
-rw-r--r-- | libguile/fluids.c | 17 | ||||
-rw-r--r-- | libguile/guardians.c | 25 | ||||
-rw-r--r-- | libguile/keywords.c | 22 | ||||
-rw-r--r-- | libguile/macros.c | 23 | ||||
-rw-r--r-- | libguile/mallocs.c | 14 | ||||
-rw-r--r-- | libguile/mit-pthreads.c | 12 | ||||
-rw-r--r-- | libguile/numbers.c | 18 | ||||
-rw-r--r-- | libguile/random.c | 22 | ||||
-rw-r--r-- | libguile/regex-posix.c | 9 | ||||
-rw-r--r-- | libguile/root.c | 24 | ||||
-rw-r--r-- | libguile/smob.c | 51 | ||||
-rw-r--r-- | libguile/smob.h | 38 | ||||
-rw-r--r-- | libguile/srcprop.c | 13 | ||||
-rw-r--r-- | libguile/threads.c | 67 | ||||
-rw-r--r-- | libguile/throw.c | 53 | ||||
-rw-r--r-- | libguile/unif.c | 16 | ||||
-rw-r--r-- | libguile/variable.c | 23 |
25 files changed, 183 insertions, 408 deletions
diff --git a/libguile/arbiters.c b/libguile/arbiters.c index febb261a6..0e11b86c2 100644 --- a/libguile/arbiters.c +++ b/libguile/arbiters.c @@ -78,9 +78,7 @@ SCM scm_make_arbiter (name) SCM name; { - SCM z; - SCM_NEWSMOB (z, scm_tc16_arbiter, name); - return z; + SCM_RETURN_NEWSMOB (scm_tc16_arbiter, name); } SCM_PROC(s_try_arbiter, "try-arbiter", 1, 0, 0, scm_try_arbiter); @@ -121,9 +119,7 @@ scm_release_arbiter (arb) void scm_init_arbiters () { - 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, prinarb); - + scm_tc16_arbiter = scm_make_smob_type_mfpe ("arbiter", 0, + scm_markcdr, NULL, prinarb, NULL); #include "arbiters.x" } diff --git a/libguile/async.c b/libguile/async.c index b7b138ca3..cd0a0c68b 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -282,13 +282,11 @@ SCM scm_async (thunk) SCM thunk; { - SCM it; struct scm_async * async = (struct scm_async *) scm_must_malloc (sizeof (*async), s_async); async->got_it = 0; async->thunk = thunk; - SCM_NEWSMOB (it, scm_tc16_async, async); - return it; + SCM_RETURN_NEWSMOB (scm_tc16_async, async); } SCM_PROC(s_system_async, "system-async", 1, 0, 0, scm_system_async); @@ -301,12 +299,8 @@ scm_system_async (thunk) SCM list; it = scm_async (thunk); - SCM_NEWCELL (list); - SCM_DEFER_INTS; - SCM_SETCAR (list, it); - SCM_SETCDR (list, scm_asyncs); + SCM_NEWSMOB (list, it, scm_asyncs); scm_asyncs = list; - SCM_ALLOW_INTS; return it; } @@ -473,8 +467,8 @@ void scm_init_async () { SCM a_thunk; - scm_tc16_async = scm_make_smob_type ("async", sizeof (struct scm_async)); - scm_set_smob_mark (scm_tc16_async, mark_async); + scm_tc16_async = scm_make_smob_type_mfpe ("async", sizeof (struct scm_async), + mark_async, NULL, NULL, NULL); scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F); a_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk); scm_gc_async = scm_system_async (a_thunk); diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index 3bdeb28c7..88d83967b 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -56,45 +56,6 @@ size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT; coop_m scm_critical_section_mutex; #ifdef __STDC__ -static size_t -scm_threads_free_thread (SCM t) -#else -static size_t -scm_threads_free_thread (t) - SCM t; -#endif -{ - scm_must_free (SCM_THREAD_DATA (t)); - return sizeof (coop_t); -} - -#ifdef __STDC__ -static size_t -scm_threads_free_mutex (SCM m) -#else -static size_t -scm_threads_free_mutex (m) - SCM m; -#endif -{ - scm_must_free (SCM_MUTEX_DATA (m)); - return sizeof (coop_m); -} - -#ifdef __STDC__ -static size_t -scm_threads_free_condvar (SCM c) -#else -static size_t -scm_threads_free_condvar (c) - SCM c; -#endif -{ - scm_must_free (SCM_CONDVAR_DATA (c)); - return sizeof (coop_c); -} - -#ifdef __STDC__ void scm_threads_init (SCM_STACKITEM *i) #else @@ -474,11 +435,8 @@ scm_make_mutex () { SCM m; coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex"); - SCM_NEWCELL (m); - SCM_DEFER_INTS; - SCM_SETCAR (m, scm_tc16_mutex); - SCM_SETCDR (m, data); - SCM_ALLOW_INTS; + + SCM_NEWSMOB (m, scm_tc16_mutex, data); coop_mutex_init (data); return m; } @@ -526,11 +484,7 @@ scm_make_condition_variable () { SCM c; coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar"); - SCM_NEWCELL (c); - SCM_DEFER_INTS; - SCM_SETCAR (c, scm_tc16_condvar); - SCM_SETCDR (c, data); - SCM_ALLOW_INTS; + SCM_NEWSMOB (c, scm_tc16_condvar, data); coop_condition_variable_init (SCM_CONDVAR_DATA (c)); return c; } diff --git a/libguile/debug.c b/libguile/debug.c index f5c9f8c55..3345c6ba1 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -164,9 +164,6 @@ prinmemoized (obj, port, pstate) return 1; } -static scm_smobfuns memoizedsmob = -{scm_markcdr, scm_free0, prinmemoized, 0}; - SCM_PROC (s_memoized_p, "memoized?", 1, 0, 0, scm_memoized_p); SCM @@ -184,12 +181,8 @@ scm_make_memoized (exp, env) /* *fixme* Check that env is a valid environment. */ register SCM z, ans; SCM_ENTER_A_SECTION; - SCM_NEWCELL (z); - SCM_SETCDR (z, env); - SCM_SETCAR (z, exp); - SCM_NEWCELL (ans); - SCM_SETCDR (ans, z); - SCM_SETCAR (ans, scm_tc16_memoized); + SCM_NEWSMOB (z, exp, env); + SCM_NEWSMOB (ans, scm_tc16_memoized, z); SCM_EXIT_A_SECTION; return ans; } @@ -589,9 +582,6 @@ prindebugobj (obj, port, pstate) return 1; } -static scm_smobfuns debugobjsmob = -{0, scm_free0, prindebugobj, 0}; - SCM_PROC (s_debug_object_p, "debug-object?", 1, 0, 0, scm_debug_object_p); SCM @@ -638,8 +628,11 @@ scm_init_debug () { scm_init_opts (scm_debug_options, scm_debug_opts, SCM_N_DEBUG_OPTIONS); - scm_tc16_memoized = scm_newsmob (&memoizedsmob); - scm_tc16_debugobj = scm_newsmob (&debugobjsmob); + scm_tc16_memoized = scm_make_smob_type_mfpe ("memoized", 0, + scm_markcdr, NULL, prinmemoized, NULL); + + scm_tc16_debugobj = scm_make_smob_type_mfpe ("debug-object", 0, + NULL, NULL, prindebugobj, NULL); scm_i_procname = SCM_CAR (scm_sysintern ("procname", SCM_UNDEFINED)); scm_i_more = SCM_CAR (scm_sysintern ("...", SCM_UNDEFINED)); diff --git a/libguile/dynl.c b/libguile/dynl.c index a08bcc572..79345de8e 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -332,12 +332,6 @@ print_dynl_obj (exp, port, pstate) return 1; } -static scm_smobfuns dynl_obj_smob = { - mark_dynl_obj, - free_dynl_obj, - print_dynl_obj -}; - static SCM kw_global; SCM_SYMBOL (sym_global, "-global"); @@ -496,7 +490,9 @@ scm_dynamic_args_call (func, dobj, args) void scm_init_dynamic_linking () { - scm_tc16_dynamic_obj = scm_newsmob (&dynl_obj_smob); + scm_tc16_dynamic_obj = scm_make_smob_type_mfpe ("dynamic-object", sizeof (struct dynl_obj), + mark_dynl_obj, free_dynl_obj, + print_dynl_obj, NULL); sysdep_dynl_init (); #include "dynl.x" kw_global = scm_make_keyword_from_dash_symbol (sym_global); diff --git a/libguile/dynwind.c b/libguile/dynwind.c index 8ae6fd0a1..2cc4f1041 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -118,13 +118,6 @@ printguards (SCM exp, SCM port, scm_print_state *pstate) return 1; } -static scm_smobfuns guardsmob = { - 0, - freeguards, - printguards, - 0 -}; - SCM scm_internal_dynamic_wind (scm_guard_t before, scm_inner_t inner, @@ -135,15 +128,11 @@ scm_internal_dynamic_wind (scm_guard_t before, SCM guards, ans; guardsmem *g; before (guard_data); - SCM_NEWCELL (guards); - SCM_DEFER_INTS; g = (guardsmem *) scm_must_malloc (sizeof (*g), "guards"); g->before = before; g->after = after; g->data = guard_data; - SCM_SETCDR (guards, g); - SCM_SETCAR (guards, tc16_guards); - SCM_ALLOW_INTS; + SCM_NEWSMOB (guards, tc16_guards, g); scm_dynwinds = scm_acons (guards, SCM_BOOL_F, scm_dynwinds); ans = inner (inner_data); scm_dynwinds = SCM_CDR (scm_dynwinds); @@ -239,6 +228,7 @@ scm_dowinds (to, delta) void scm_init_dynwind () { - tc16_guards = scm_newsmob (&guardsmob); + tc16_guards = scm_make_smob_type_mfpe ("guards", sizeof (struct guardsmem), + NULL, freeguards, printguards, NULL); #include "dynwind.x" } diff --git a/libguile/eval.c b/libguile/eval.c index 6a4913dde..5d9fab90e 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -3256,13 +3256,7 @@ SCM scm_makprom (code) SCM code; { - register SCM z; - SCM_NEWCELL (z); - SCM_ENTER_A_SECTION; - SCM_SETCDR (z, code); - SCM_SETCAR (z, scm_tc16_promise); - SCM_EXIT_A_SECTION; - return z; + SCM_RETURN_NEWSMOB (scm_tc16_promise, code); } diff --git a/libguile/filesys.c b/libguile/filesys.c index 6d6b2e2ba..976409494 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -610,19 +610,13 @@ scm_opendir (dirname) SCM dirname; { DIR *ds; - SCM dir; SCM_ASSERT (SCM_NIMP (dirname) && SCM_ROSTRINGP (dirname), dirname, SCM_ARG1, s_opendir); SCM_COERCE_SUBSTR (dirname); - SCM_NEWCELL (dir); - SCM_DEFER_INTS; SCM_SYSCALL (ds = opendir (SCM_ROCHARS (dirname))); if (ds == NULL) scm_syserror (s_opendir); - SCM_SETCAR (dir, scm_tc16_dir | SCM_OPN); - SCM_SETCDR (dir, ds); - SCM_ALLOW_INTS; - return dir; + SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_OPN, ds); } @@ -704,8 +698,6 @@ scm_dir_free (p) return 0; } -static scm_smobfuns dir_smob = {0, scm_dir_free, scm_dir_print, 0}; - /* {Navigating Directories} */ @@ -1226,7 +1218,8 @@ scm_init_filesys () { scm_add_feature ("i/o-extensions"); - scm_tc16_dir = scm_newsmob (&dir_smob); + scm_tc16_dir = scm_make_smob_type_mfpe ("directory", 0, + NULL, scm_dir_free,scm_dir_print, NULL); scm_dot_string = scm_permanent_object (scm_makfrom0str (".")); diff --git a/libguile/fluids.c b/libguile/fluids.c index cc20eed64..ee7651d5f 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -107,12 +107,6 @@ print_fluid (exp, port, pstate) return 1; } -static scm_smobfuns fluid_smob = { - 0, - scm_free0, - print_fluid -}; - static int next_fluid_num () { @@ -132,17 +126,11 @@ SCM_PROC (s_make_fluid, "make-fluid", 0, 0, 0, scm_make_fluid); SCM scm_make_fluid () { - SCM z; int n; SCM_DEFER_INTS; n = next_fluid_num (); - SCM_NEWCELL (z); - SCM_SETCAR (z, scm_tc16_fluid); - SCM_SETCDR (z, n); - SCM_ALLOW_INTS; - - return z; + SCM_RETURN_NEWSMOB (scm_tc16_fluid, n); } SCM_PROC (s_fluid_p, "fluid?", 1, 0, 0, scm_fluid_p); @@ -265,6 +253,7 @@ scm_with_fluids (fluids, vals, thunk) void scm_init_fluids () { - scm_tc16_fluid = scm_newsmob(&fluid_smob); + scm_tc16_fluid = scm_make_smob_type_mfpe ("fluid", 0, + NULL, NULL, print_fluid, NULL); #include "fluids.x" } diff --git a/libguile/guardians.c b/libguile/guardians.c index b2fa0a946..d9cfc129b 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -116,13 +116,6 @@ g_mark (SCM ptr) return SCM_BOOL_F; } -static scm_sizet -g_free (SCM ptr) -{ - scm_must_free ((char *) GUARDIAN (ptr)); - return sizeof (guardian_t); -} - static int g_print (SCM exp, SCM port, scm_print_state *pstate) { @@ -135,13 +128,6 @@ g_print (SCM exp, SCM port, scm_print_state *pstate) return 1; } -static scm_smobfuns g_smob = { - g_mark, - g_free, - g_print, - 0 /* g_equalp */ -}; - #define CCLO_G(cclo) (SCM_VELTS (cclo)[1]) static SCM @@ -168,15 +154,11 @@ scm_make_guardian () SCM z1 = scm_cons (SCM_BOOL_F, SCM_BOOL_F); SCM z2 = scm_cons (SCM_BOOL_F, SCM_BOOL_F); SCM z; - SCM_NEWCELL (z); - - SCM_DEFER_INTS; /* A tconc starts out with one tail pair. */ g->live.head = g->live.tail = z1; g->zombies.head = g->zombies.tail = z2; - SCM_SETCDR (z, g); - SCM_SETCAR (z, scm_tc16_guardian); - SCM_ALLOW_INTS; + + SCM_NEWSMOB (z, scm_tc16_guardian, g); CCLO_G (cclo) = z; @@ -277,7 +259,8 @@ scm_get_one_zombie (SCM guardian) void scm_init_guardian() { - scm_tc16_guardian = scm_newsmob (&g_smob); + scm_tc16_guardian = scm_make_smob_type_mfpe ("guardian", sizeof (guardian_t), + g_mark, NULL, g_print, NULL); guard1 = scm_make_subr_opt ("guardian", scm_tc7_subr_2o, guard, 0); #include "guardians.x" diff --git a/libguile/keywords.c b/libguile/keywords.c index dce5aeea8..376a424ad 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -48,17 +48,6 @@ #include "keywords.h" - -static scm_sizet free_keyword SCM_P ((SCM obj)); - -static scm_sizet -free_keyword (obj) - SCM obj; -{ - return 0; -} - - static int prin_keyword SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); static int @@ -78,10 +67,6 @@ int scm_tc16_keyword; Will be removed in next release. */ int scm_tc16_kw; -static scm_smobfuns keyword_smob = -{scm_markcdr, free_keyword, prin_keyword, 0}; - - SCM_PROC (s_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", 1, 0, 0, scm_make_keyword_from_dash_symbol); @@ -101,9 +86,7 @@ scm_make_keyword_from_dash_symbol (symbol) if (vcell == SCM_BOOL_F) { SCM keyword; - SCM_NEWCELL(keyword); - SCM_SETCAR (keyword, (SCM)scm_tc16_keyword); - SCM_SETCDR (keyword, symbol); + SCM_NEWSMOB (keyword, scm_tc16_keyword, symbol); scm_intern_symbol (scm_keyword_obarray, symbol); vcell = scm_sym2ovcell_soft (symbol, scm_keyword_obarray); SCM_SETCDR (vcell, keyword); @@ -155,7 +138,8 @@ scm_keyword_dash_symbol (keyword) void scm_init_keywords () { - scm_tc16_keyword = scm_newsmob (&keyword_smob); + scm_tc16_keyword = scm_make_smob_type_mfpe ("keyword", 0, + scm_markcdr, NULL, prin_keyword, NULL); scm_tc16_kw = scm_tc16_keyword; scm_keyword_obarray = scm_make_vector (SCM_MAKINUM (256), SCM_EOL); #include "keywords.x" diff --git a/libguile/macros.c b/libguile/macros.c index 467524df7..c7b9af06b 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -47,21 +47,15 @@ long scm_tc16_macro; -static const scm_smobfuns macrosmob = {scm_markcdr, scm_free0}; - SCM_PROC(s_makacro, "procedure->syntax", 1, 0, 0, scm_makacro); SCM scm_makacro (code) SCM code; { - register SCM z; SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (code)), code, SCM_ARG1, s_makacro); - SCM_NEWCELL (z); - SCM_SETCDR (z, code); - SCM_SETCAR (z, scm_tc16_macro); - return z; + SCM_RETURN_NEWSMOB (scm_tc16_macro, code); } @@ -71,13 +65,9 @@ SCM scm_makmacro (code) SCM code; { - register SCM z; SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (code)), code, SCM_ARG1, s_makmacro); - SCM_NEWCELL (z); - SCM_SETCDR (z, code); - SCM_SETCAR (z, scm_tc16_macro | (1L << 16)); - return z; + SCM_RETURN_NEWSMOB (scm_tc16_macro | (1L << 16), code); } @@ -87,13 +77,9 @@ SCM scm_makmmacro (code) SCM code; { - register SCM z; SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (code)), code, SCM_ARG1, s_makmmacro); - SCM_NEWCELL (z); - SCM_SETCDR (z, code); - SCM_SETCAR (z, scm_tc16_macro | (2L << 16)); - return z; + SCM_RETURN_NEWSMOB (scm_tc16_macro | (2L << 16), code); } @@ -179,6 +165,7 @@ scm_make_synt (name, macroizer, fcn) void scm_init_macros () { - scm_tc16_macro = scm_newsmob (¯osmob); + scm_tc16_macro = scm_make_smob_type_mfpe ("macro", 0, + scm_markcdr, NULL, NULL, NULL); #include "macros.x" } diff --git a/libguile/mallocs.c b/libguile/mallocs.c index b8332a765..a832bdb1c 100644 --- a/libguile/mallocs.c +++ b/libguile/mallocs.c @@ -66,8 +66,6 @@ prinmalloc (exp, port, pstate) int scm_tc16_malloc; -static scm_smobfuns mallocsmob = {0, fmalloc, prinmalloc, 0}; - @@ -75,11 +73,8 @@ SCM scm_malloc_obj (n) scm_sizet n; { - SCM answer; SCM mem; - SCM_NEWCELL (answer); - SCM_DEFER_INTS; mem = (n ? (SCM)malloc (n) : 0); @@ -88,10 +83,7 @@ scm_malloc_obj (n) SCM_ALLOW_INTS; return SCM_BOOL_F; } - SCM_SETCDR (answer, mem); - SCM_SETCAR (answer, scm_tc16_malloc); - SCM_ALLOW_INTS; - return answer; + SCM_RETURN_NEWSMOB (scm_tc16_malloc, mem); } @@ -100,6 +92,6 @@ scm_malloc_obj (n) void scm_init_mallocs () { - scm_tc16_malloc = scm_newsmob (&mallocsmob); + scm_tc16_malloc = scm_make_smob_type_mfpe ("malloc", 0, + NULL, fmalloc, prinmalloc, NULL); } - diff --git a/libguile/mit-pthreads.c b/libguile/mit-pthreads.c index 891889722..7fb787a2e 100644 --- a/libguile/mit-pthreads.c +++ b/libguile/mit-pthreads.c @@ -405,11 +405,7 @@ scm_make_mutex () { SCM m; pthread_mutex_t *data = (pthread_mutex_t *) scm_must_malloc (sizeof (pthread_mutex_t), "mutex"); - SCM_NEWCELL (m); - SCM_DEFER_INTS; - SCM_SETCAR (m, scm_tc16_mutex); - SCM_SETCDR (m, data); - SCM_ALLOW_INTS; + SCM_NEWSMOB (m,scm_tc16_mutex, data); pthread_mutex_init (SCM_MUTEX_DATA (m), NULL); return m; } @@ -452,11 +448,7 @@ scm_make_condition_variable () { SCM c; pthread_cond_t *data = (pthread_cond_t *) scm_must_malloc (sizeof (pthread_cond_t), "condvar"); - SCM_NEWCELL (c); - SCM_DEFER_INTS; - SCM_SETCAR (c, scm_tc16_condvar); - SCM_SETCDR (c, data); - SCM_ALLOW_INTS; + SCM_NEWSMOB (c, scm_tc16_condvar, data); pthread_cond_init (SCM_CONDVAR_DATA (c), NULL); return c; } diff --git a/libguile/numbers.c b/libguile/numbers.c index 0a18af675..d8b6950e5 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -46,6 +46,7 @@ #include "genio.h" #include "unif.h" #include "feature.h" +#include "smob.h" #include "numbers.h" @@ -2450,7 +2451,6 @@ scm_makdbl (x, y) SCM z; if ((y == 0.0) && (x == 0.0)) return scm_flo0; - SCM_NEWCELL (z); SCM_DEFER_INTS; if (y == 0.0) { @@ -2460,20 +2460,17 @@ scm_makdbl (x, y) if ((-FLTMAX < x) && (x < FLTMAX) && (fx == x)) #endif { - SCM_SETCAR (z, scm_tc_flo); + SCM_NEWSMOB(z,scm_tc_flo,NULL); SCM_FLO (z) = x; SCM_ALLOW_INTS; return z; } #endif /* def SCM_SINGLES */ - SCM_SETCDR (z, (SCM) scm_must_malloc (1L * sizeof (double), "real")); - SCM_SETCAR (z, scm_tc_dblr); + SCM_NEWSMOB(z,scm_tc_dblr,scm_must_malloc (1L * sizeof (double), "real")); } else { - SCM_SETCDR (z, (SCM) scm_must_malloc (2L * sizeof (double), "complex")); - SCM_SETCAR (z, scm_tc_dblc); - SCM_IMAG (z) = y; + SCM_NEWSMOB(z,scm_tc_dblc,scm_must_malloc (2L * sizeof (double), "comkplex")); } SCM_REAL (z) = x; SCM_ALLOW_INTS; @@ -4805,14 +4802,11 @@ scm_init_numbers () { #ifdef SCM_FLOATS scm_add_feature("inexact"); - SCM_NEWCELL (scm_flo0); #ifdef SCM_SINGLES - SCM_SETCAR (scm_flo0, scm_tc_flo); - SCM_FLO (scm_flo0) = 0.0; + SCM_NEWSMOB(scm_flo0,scm_tc_flo,NULL); #else - SCM_SETCDR (scm_flo0, (SCM) scm_must_malloc (1L * sizeof (double), "real")); + SCM_NEWSMOB(scm_flo0,scm_tc_dblr,scm_must_malloc (1L * sizeof (double), "real")); SCM_REAL (scm_flo0) = 0.0; - SCM_SETCAR (scm_flo0, scm_tc_dblr); #endif #ifdef DBL_DIG scm_dblprec = (DBL_DIG > 20) ? 20 : DBL_DIG; diff --git a/libguile/random.c b/libguile/random.c index 75fe6ab3d..6dd82294a 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -320,22 +320,7 @@ long scm_tc16_rstate; static SCM make_rstate (scm_rstate *state) { - SCM cell; - SCM_NEWCELL (cell); - SCM_ENTER_A_SECTION; - SCM_SETCDR (cell, state); - SCM_SETCAR (cell, scm_tc16_rstate); - SCM_EXIT_A_SECTION; - return cell; -} - -static int -print_rstate (SCM rstate, SCM port, scm_print_state *pstate) -{ - scm_puts ("#<random-state ", port); - scm_intprint ((long) SCM_RSTATE (rstate), 16, port); - scm_putc ('>', port); - return 1; + SCM_RETURN_NEWSMOB (scm_tc16_rstate, state); } static scm_sizet @@ -345,8 +330,6 @@ free_rstate (SCM rstate) return scm_the_rng.rstate_size; } -static scm_smobfuns rstate_smob = { 0, free_rstate, print_rstate, 0}; - /* * Scheme level interface. */ @@ -564,7 +547,8 @@ scm_init_random () }; scm_the_rng = rng; - scm_tc16_rstate = scm_newsmob (&rstate_smob); + scm_tc16_rstate = scm_make_smob_type_mfpe ("random-state", 0, + NULL, free_rstate, NULL, NULL); for (m = 1; m <= 0x100; m <<= 1) for (i = m >> 1; i < m; ++i) diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 5c730ff3a..3b2af914d 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -144,7 +144,7 @@ SCM_PROC (s_make_regexp, "make-regexp", 1, 0, 1, scm_make_regexp); SCM scm_make_regexp (SCM pat, SCM flags) { - SCM result, flag; + SCM flag; regex_t *rx; int status, cflags; @@ -179,8 +179,7 @@ scm_make_regexp (SCM pat, SCM flags) SCM_BOOL_F); /* never returns */ } - SCM_NEWSMOB (result, scm_tc16_regex, rx); - return result; + SCM_RETURN_NEWSMOB (scm_tc16_regex, rx); } SCM_PROC (s_regexp_exec, "regexp-exec", 2, 2, 0, scm_regexp_exec); @@ -252,8 +251,8 @@ scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags) void scm_init_regex_posix () { - scm_tc16_regex = scm_make_smob_type ("regexp", sizeof (regex_t)); - scm_set_smob_free (scm_tc16_regex, free_regex); + scm_tc16_regex = scm_make_smob_type_mfpe ("regexp", sizeof (regex_t), + NULL, free_regex, NULL, NULL); /* Compilation flags. */ scm_sysintern ("regexp/basic", scm_long2num (REG_BASIC)); diff --git a/libguile/root.c b/libguile/root.c index dce89e21f..1dbdbcd57 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -97,15 +97,6 @@ mark_root (root) return SCM_ROOT_STATE (root) -> parent; } -static scm_sizet free_root SCM_P ((SCM)); - -static scm_sizet -free_root (root) - SCM root; -{ - scm_must_free ((char *) SCM_ROOT_STATE (root)); - return sizeof (scm_root_state); -} static int print_root SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); @@ -121,13 +112,6 @@ print_root (exp, port, pstate) return 1; } -static scm_smobfuns root_smob = -{ - mark_root, - free_root, - print_root, - 0 -}; @@ -150,10 +134,8 @@ scm_make_root (parent) { root_state->parent = SCM_BOOL_F; } - SCM_NEWCELL (root); SCM_REDEFER_INTS; - SCM_SETCAR (root, scm_tc16_root); - SCM_SETCDR (root, root_state); + SCM_NEWSMOB (root, scm_tc16_root, root_state); root_state->handle = root; SCM_REALLOW_INTS; return root; @@ -411,6 +393,8 @@ scm_call_catching_errors (thunk, err_filter, closure) void scm_init_root () { - scm_tc16_root = scm_newsmob (&root_smob); + scm_tc16_root = scm_make_smob_type_mfpe ("root", sizeof (struct scm_root_state), + mark_root, NULL, print_root, NULL); + #include "root.x" } diff --git a/libguile/smob.c b/libguile/smob.c index 6315ab979..53e8a413d 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -153,6 +153,18 @@ scm_make_smob_type (char *name, scm_sizet size) return scm_tc7_smob + (scm_numsmob - 1) * 256; } +long +scm_make_smob_type_mfpe (char *name, scm_sizet size, + SCM (*mark) (SCM), + scm_sizet (*free) (SCM), + int (*print) (SCM, SCM, scm_print_state *), + SCM (*equalp) (SCM, SCM)) +{ + long answer = scm_make_smob_type (name, size); + scm_set_smob_mfpe (answer, mark, free, print, equalp); + return answer; +} + void scm_set_smob_mark (long tc, SCM (*mark) (SCM)) { @@ -177,7 +189,21 @@ scm_set_smob_equalp (long tc, SCM (*equalp) (SCM, SCM)) scm_smobs[SCM_TC2SMOBNUM (tc)].equalp = equalp; } -/* Deprecated function - use scm_make_smob_type instead. */ +void +scm_set_smob_mfpe (long tc, + SCM (*mark) (SCM), + scm_sizet (*free) (SCM), + int (*print) (SCM, SCM, scm_print_state *), + SCM (*equalp) (SCM, SCM)) +{ + if (mark) scm_set_smob_mark (tc, mark); + if (free) scm_set_smob_free (tc, free); + if (print) scm_set_smob_print (tc, print); + if (equalp) scm_set_smob_equalp (tc, equalp); +} + +/* Deprecated function - use scm_make_smob_type, or scm_make_smob_type_mfpe + instead. */ long scm_newsmob (const scm_smobfuns *smob) { @@ -232,21 +258,20 @@ freeprint (SCM exp, void scm_smob_prehistory () { - long 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 */ - tc = scm_make_smob_type ("free", 0); - scm_set_smob_print (tc, freeprint); - tc = scm_make_smob_type ("flo", 0); /* freed in gc */ - scm_set_smob_print (tc, scm_floprint); - scm_set_smob_equalp (tc, scm_floequal); - tc = scm_make_smob_type ("bigpos", 0); /* freed in gc */ - scm_set_smob_print (tc, scm_bigprint); - scm_set_smob_equalp (tc, scm_bigequal); - tc = scm_make_smob_type ("bigneg", 0); - scm_set_smob_print (tc, scm_bigprint); - scm_set_smob_equalp (tc, scm_bigequal); + scm_make_smob_type_mfpe ("free", 0, + NULL, NULL, freeprint, NULL); + + scm_make_smob_type_mfpe ("flo", 0, /* freed in gc */ + NULL, NULL, scm_floprint, scm_floequal); + + scm_make_smob_type_mfpe ("bigpos", 0, /* freed in gc */ + NULL, NULL, scm_bigprint, scm_bigequal); + + scm_make_smob_type_mfpe ("bigneg", 0, + NULL, NULL, scm_bigprint, scm_bigequal); } diff --git a/libguile/smob.h b/libguile/smob.h index ff294640e..110044dc0 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -72,11 +72,18 @@ typedef struct scm_smobfuns #define SCM_NEWSMOB(z, tc, data) \ -{ \ +do { \ SCM_NEWCELL (z); \ SCM_SETCDR (z, data); \ SCM_SETCAR (z, tc); \ -} \ +} while (0) + +#define SCM_RETURN_NEWSMOB(tc, data) \ + do { SCM __SCM_smob_answer; \ + SCM_NEWSMOB (__SCM_smob_answer, tc, data); \ + return __SCM_smob_answer; \ + } while (0) + #define SCM_SMOB_DATA(x) SCM_CDR (x) #define SCM_SET_SMOB_DATA(x, data) SCM_SETCDR (x, data) @@ -94,13 +101,40 @@ extern SCM scm_markcdr SCM_P ((SCM ptr)); extern scm_sizet scm_free0 SCM_P ((SCM ptr)); extern scm_sizet scm_smob_free (SCM obj); extern int scm_smob_print (SCM exp, SCM port, scm_print_state *pstate); + +/* These next two functions are the supported way to create new SMOB types. + + scm_make_smob_type is useful if there are no special smob functions + and the defaults work for mark,free,print,equal_p, or you want to use + scm_set_smob_{mark,free,print,equalp}, below. + + scm_make_smob_type_mfpe is ideal if you need to set one or more of + the special smob functions-- use NULL for when the default function + is fine +*/ + extern long scm_make_smob_type (char *name, scm_sizet size); + +extern long scm_make_smob_type_mfpe (char *name, scm_sizet size, + SCM (*mark) (SCM), + scm_sizet (*free) (SCM), + int (*print) (SCM, SCM, scm_print_state*), + SCM (*equalp) (SCM, SCM)); + extern void scm_set_smob_mark (long tc, SCM (*mark) (SCM)); extern void scm_set_smob_free (long tc, scm_sizet (*free) (SCM)); extern void scm_set_smob_print (long tc, int (*print) (SCM, SCM, scm_print_state*)); extern void scm_set_smob_equalp (long tc, SCM (*equalp) (SCM, SCM)); +/* convenience function for registering multiple handler fns */ +extern void scm_set_smob_mfpe (long tc, + SCM (*mark) (SCM), + scm_sizet (*free) (SCM), + int (*print) (SCM, SCM, scm_print_state*), + SCM (*equalp) (SCM, SCM)); + + extern SCM scm_make_smob (long tc); extern void scm_smob_prehistory (void); diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 25f08f97c..94ff30674 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -122,9 +122,6 @@ prinsrcprops (obj, port, pstate) return 1; } -static scm_smobfuns srcpropssmob = -{marksrcprops, freesrcprops, prinsrcprops, 0}; - SCM scm_make_srcprops (line, col, filename, copy, plist) @@ -134,7 +131,6 @@ scm_make_srcprops (line, col, filename, copy, plist) SCM copy; SCM plist; { - register SCM ans; register scm_srcprops *ptr; SCM_DEFER_INTS; if ((ptr = srcprops_freelist) != NULL) @@ -156,15 +152,11 @@ scm_make_srcprops (line, col, filename, copy, plist) *(scm_srcprops **)&ptr[SRCPROPS_CHUNKSIZE - 1] = 0; srcprops_freelist = (scm_srcprops *) &ptr[1]; } - SCM_NEWCELL (ans); - SCM_SETCAR (ans, scm_tc16_srcprops); ptr->pos = SRCPROPMAKPOS (line, col); ptr->fname = filename; ptr->copy = copy; ptr->plist = plist; - SCM_SETCDR (ans, (SCM) ptr); - SCM_ALLOW_INTS; - return ans; + SCM_RETURN_NEWSMOB (scm_tc16_srcprops, ptr); } @@ -349,7 +341,8 @@ scm_set_source_property_x (obj, key, datum) void scm_init_srcprop () { - scm_tc16_srcprops = scm_newsmob (&srcpropssmob); + scm_tc16_srcprops = scm_make_smob_type_mfpe ("srcprops", 0, + marksrcprops, freesrcprops, prinsrcprops, NULL); scm_source_whash = scm_make_weak_key_hash_table (SCM_MAKINUM (2047)); scm_i_filename = SCM_CAR (scm_sysintern ("filename", SCM_UNDEFINED)); diff --git a/libguile/threads.c b/libguile/threads.c index 55e7c9477..c6347546c 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -101,66 +101,6 @@ SCM_PROC(s_signal_condition_variable, "signal-condition-variable", 1, 0, 0, scm_ #include "coop-threads.c" #endif -static int -print_thread (exp, port, pstate) - SCM exp; - SCM port; - scm_print_state *pstate; -{ - scm_puts ("#<thread ", port); - scm_intprint (SCM_CDR (exp), 16, port); - scm_putc ('>', port); - return 1; -} - -static scm_smobfuns thread_smob = -{ - 0, - scm_threads_free_thread, - print_thread, - 0 -}; - -static int -print_mutex (exp, port, pstate) - SCM exp; - SCM port; - scm_print_state *pstate; -{ - scm_puts ("#<mutex ", port); - scm_intprint (SCM_CDR (exp), 16, port); - scm_putc ('>', port); - return 1; -} - -static scm_smobfuns mutex_smob = -{ - 0, - scm_threads_free_mutex, - print_mutex, - 0 -}; - -static int -print_condvar (exp, port, pstate) - SCM exp; - SCM port; - scm_print_state *pstate; -{ - scm_puts ("#<condition-variable ", port); - scm_intprint (SCM_CDR (exp), 16, port); - scm_putc ('>', port); - return 1; -} - -static scm_smobfuns condvar_smob = -{ - 0, - scm_threads_free_condvar, - print_condvar, - 0 -}; - #ifdef __STDC__ @@ -172,9 +112,10 @@ scm_init_threads (i) SCM_STACKITEM *i; #endif { - scm_tc16_thread = scm_newsmob (&thread_smob); - scm_tc16_mutex = scm_newsmob (&mutex_smob); - scm_tc16_condvar = scm_newsmob (&condvar_smob); + scm_tc16_thread = scm_make_smob_type ("thread", sizeof (coop_t)); + scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (coop_m)); + scm_tc16_condvar = scm_make_smob_type ("condition-variable", sizeof (coop_c)); + #include "threads.x" /* Initialize implementation specific details of the threads support */ scm_threads_init (i); diff --git a/libguile/throw.c b/libguile/throw.c index 5f886637a..816743391 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -102,30 +102,22 @@ printjb (exp, port, pstate) return 1 ; } -static scm_smobfuns jbsmob = { - 0, -#ifdef DEBUG_EXTENSIONS - freejb, -#else - scm_free0, -#endif - printjb, - 0 -}; static SCM make_jmpbuf SCM_P ((void)); static SCM make_jmpbuf () { SCM answer; - SCM_NEWCELL (answer); SCM_REDEFER_INTS; { #ifdef DEBUG_EXTENSIONS char *mem = scm_must_malloc (sizeof (scm_cell), "jb"); - SCM_SETCDR (answer, (SCM) mem); #endif - SCM_SETCAR (answer, scm_tc16_jmpbuffer); +#ifdef DEBUG_EXTENSIONS + SCM_NEWSMOB (answer, scm_tc16_jmpbuffer, mem); +#else + SCM_NEWSMOB (answer, scm_tc16_jmpbuffer, 0); +#endif SETJBJMPBUF(answer, (jmp_buf *)0); DEACTIVATEJB(answer); } @@ -279,10 +271,6 @@ print_lazy_catch (SCM closure, SCM port, scm_print_state *pstate) return 1; } -static scm_smobfuns lazy_catch_funs = { - 0, scm_free0, print_lazy_catch, 0 -}; - /* Given a pointer to a lazy catch structure, return a smob for it, suitable for inclusion in the wind list. ("Ah yes, a Château @@ -290,13 +278,7 @@ static scm_smobfuns lazy_catch_funs = { static SCM make_lazy_catch (struct lazy_catch *c) { - SCM smob; - - SCM_NEWCELL (smob); - SCM_SETCDR (smob, c); - SCM_SETCAR (smob, tc16_lazy_catch); - - return smob; + SCM_RETURN_NEWSMOB (tc16_lazy_catch, c); } #define SCM_LAZY_CATCH_P(obj) \ @@ -749,7 +731,26 @@ scm_ithrow (key, args, noreturn) void scm_init_throw () { - scm_tc16_jmpbuffer = scm_newsmob (&jbsmob); - tc16_lazy_catch = scm_newsmob (&lazy_catch_funs); +#ifdef DEBUG_EXTENSIONS + scm_tc16_jmpbuffer = scm_make_smob_type_mfpe ("jmpbuffer", + sizeof (scm_cell), + NULL, /* mark */ + freejb, + printjb, + NULL); +#else + scm_tc16_jmpbuffer = scm_make_smob_type_mfpe ("jmpbuffer", + 0, + NULL, /* mark */ + NULL + printjb, + NULL); +#endif + + tc16_lazy_catch = scm_make_smob_type_mfpe ("lazy-catch", 0, + NULL, + NULL, + print_lazy_catch, + NULL); #include "throw.x" } diff --git a/libguile/unif.c b/libguile/unif.c index 5889405a7..4619d7cf5 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -504,9 +504,9 @@ scm_make_ra (ndim) SCM ra; SCM_NEWCELL (ra); SCM_DEFER_INTS; - SCM_SETCDR (ra, scm_must_malloc ((long) (sizeof (scm_array) + ndim * sizeof (scm_array_dim)), + SCM_NEWSMOB(ra, ((long) ndim << 17) + scm_tc16_array, + scm_must_malloc ((long) (sizeof (scm_array) + ndim * sizeof (scm_array_dim)), "array")); - SCM_SETCAR (ra, ((long) ndim << 17) + scm_tc16_array); SCM_ARRAY_V (ra) = scm_nullvect; SCM_ALLOW_INTS; return ra; @@ -2595,18 +2595,18 @@ freera (ptr) return sizeof (scm_array) + SCM_ARRAY_NDIM (ptr) * sizeof (scm_array_dim); } -static scm_smobfuns rasmob = -{markra, freera, scm_raprin1, scm_array_equal_p}; - - /* This must be done after scm_init_scl() */ void scm_init_unif () { -#include "unif.x" - scm_tc16_array = scm_newsmob (&rasmob); + scm_tc16_array = scm_make_smob_type_mfpe ("array", 0, + markra, + freera, + scm_raprin1, + scm_array_equal_p); scm_add_feature ("array"); +#include "unif.x" } #else /* ARRAYS */ diff --git a/libguile/variable.c b/libguile/variable.c index 17ecacf0b..6fe9df9cf 100644 --- a/libguile/variable.c +++ b/libguile/variable.c @@ -49,17 +49,6 @@ #include "variable.h" -static scm_sizet free_var SCM_P ((SCM obj)); - -static scm_sizet -free_var (obj) - SCM obj; -{ - return 0; -} - - - static int prin_var SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); static int @@ -106,7 +95,6 @@ var_equal (var1, var2) } int scm_tc16_variable; -static scm_smobfuns variable_smob = {scm_markvar, free_var, prin_var, var_equal}; static SCM anonymous_variable_sym; @@ -118,13 +106,7 @@ static SCM make_vcell_variable (vcell) SCM vcell; { - SCM answer; - SCM_NEWCELL(answer); - SCM_REDEFER_INTS; - SCM_SETCAR (answer, scm_tc16_variable); - SCM_SETCDR (answer, vcell); - SCM_REALLOW_INTS; - return answer; + SCM_RETURN_NEWSMOB (scm_tc16_variable, vcell); } SCM_PROC(s_make_variable, "make-variable", 1, 1, 0, scm_make_variable); @@ -250,7 +232,8 @@ scm_variable_bound_p (var) void scm_init_variable () { - scm_tc16_variable = scm_newsmob (&variable_smob); + scm_tc16_variable = scm_make_smob_type_mfpe ("variable", 0, + scm_markvar, NULL, prin_var, var_equal); anonymous_variable_sym = SCM_CAR (scm_sysintern ("anonymous-variable", SCM_UNDEFINED)); #include "variable.x" } |