summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1999-07-07 09:44:01 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1999-07-07 09:44:01 +0000
commit23a621512f6a034a8624f589a3862dbddcec6b9d (patch)
treeefb8b5a0f046402b74a5851fa1a902c40bc91561
parent8ac40ce8871ccfa5e8c0a4fe3a1d55dfb69f839c (diff)
downloadguile-23a621512f6a034a8624f589a3862dbddcec6b9d.tar.gz
Greg's smob patch
-rw-r--r--libguile/arbiters.c10
-rw-r--r--libguile/async.c14
-rw-r--r--libguile/coop-threads.c52
-rw-r--r--libguile/debug.c21
-rw-r--r--libguile/dynl.c10
-rw-r--r--libguile/dynwind.c16
-rw-r--r--libguile/eval.c8
-rw-r--r--libguile/filesys.c13
-rw-r--r--libguile/fluids.c17
-rw-r--r--libguile/guardians.c25
-rw-r--r--libguile/keywords.c22
-rw-r--r--libguile/macros.c23
-rw-r--r--libguile/mallocs.c14
-rw-r--r--libguile/mit-pthreads.c12
-rw-r--r--libguile/numbers.c18
-rw-r--r--libguile/random.c22
-rw-r--r--libguile/regex-posix.c9
-rw-r--r--libguile/root.c24
-rw-r--r--libguile/smob.c51
-rw-r--r--libguile/smob.h38
-rw-r--r--libguile/srcprop.c13
-rw-r--r--libguile/threads.c67
-rw-r--r--libguile/throw.c53
-rw-r--r--libguile/unif.c16
-rw-r--r--libguile/variable.c23
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 (&macrosmob);
+ 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"
}