wingo pushed a commit to branch wip-whippet
in repository guile.
commit 0e8c6b6727be063bee73752ad8afe60b29a28929
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu May 15 10:31:12 2025 +0200
Remove SMOB mark functions
Oh yeah! They are almost impossible to use correctly as-is, have mostly
disappeared in practice (I am aware of only two users), have the wrong
interface for moving collectors, and current usage has cemented smobs as
conservatively-marked objects. In order to move forward with Whippet,
they have to go!
* libguile/deprecated.h (SCM_SMOB_MARK, SCM_GLOBAL_SMOB_MARK, scm_mark0)
(scm_markcdr, scm_free0, scm_set_smob_mark, scm_gc_mark): Remove these,
leaving defines to indicate that users should talk to guile-devel to
figure out what to do.
* libguile/smob.h: Remove interfaces relating to mark functions.
(scm_new_double_smob, scm_new_smob): Make not inline
* libguile/smob.c: Remove mark functions from here.
(scm_new_smob): Out-of-line-only definition.
(scm_smob_prehistory): Don't create a new GC kind for smobs.
* test-suite/standalone/test-smob-mark-race.c:
* test-suite/standalone/test-smob-mark.c: Remove.
* test-suite/standalone/Makefile.am: Update.
---
libguile/deprecated.h | 8 ++
libguile/smob.c | 201 ++--------------------------
libguile/smob.h | 58 +-------
test-suite/standalone/Makefile.am | 14 +-
test-suite/standalone/test-smob-mark-race.c | 66 ---------
test-suite/standalone/test-smob-mark.c | 136 -------------------
6 files changed, 26 insertions(+), 457 deletions(-)
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index ab99d6581..f0189a676 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -24,6 +24,14 @@
#if (SCM_ENABLE_DEPRECATED == 1)
+#define SCM_SMOB_MARK SCM_SMOB_MARK__Gone__Contact_guile_devel_for_alternatives
+#define SCM_GLOBAL_SMOB_MARK
SCM_GLOBAL_SMOB_MARK__Gone__Contact_guile_devel_for_alternatives
+#define scm_mark0 scm_mark0__Gone__Contact_guile_devel_for_alternatives
+#define scm_markcdr scm_markcdr__Gone__Contact_guile_devel_for_alternatives
+#define scm_free0 scm_free0__Gone__Contact_guile_devel_for_alternatives
+#define scm_set_smob_mark
scm_set_smob_mark__Gone__Contact_guile_devel_for_alternatives
+#define scm_gc_mark scm_gc_mark__Gone__Contact_guile_devel_for_alternatives
+
SCM_DEPRECATED SCM scm_make_guardian (void);
#define SCM_I_WVECTP(x) (scm_is_weak_vector (x))
diff --git a/libguile/smob.c b/libguile/smob.c
index 917cf1cb5..ed15186a4 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -41,8 +41,6 @@
#include "smob.h"
-#include <gc/gc_mark.h>
-
@@ -64,43 +62,6 @@ scm_assert_smob_type (scm_t_bits tag, SCM val)
scm_wrong_type_arg_msg (NULL, 0, val, scm_smobs[SCM_TC2SMOBNUM(tag)].name);
}
-/* {Mark}
- */
-
-/* This function is vestigial. It used to be the mark function's
- responsibility to set the mark bit on the smob or port, but now the
- generic marking routine in gc.c takes care of that, and a zero
- pointer for a mark function means "don't bother". So you never
- need scm_mark0.
-
- However, we leave it here because it's harmless to call it, and
- people out there have smob code that uses it, and there's no reason
- to make their links fail. */
-
-SCM
-scm_mark0 (SCM ptr SCM_UNUSED)
-{
- return SCM_BOOL_F;
-}
-
-SCM
-/* Dirk::FIXME: The name markcdr is misleading, since the term cdr should only
- be used for real pairs. */
-scm_markcdr (SCM ptr)
-{
- return SCM_CELL_OBJECT_1 (ptr);
-}
-
-
-/* {Free}
- */
-
-size_t
-scm_free0 (SCM ptr SCM_UNUSED)
-{
- return 0;
-}
-
/* {Print}
*/
@@ -230,12 +191,6 @@ scm_make_smob_type (char const *name, size_t size)
#undef FUNC_NAME
-void
-scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM))
-{
- scm_smobs[SCM_TC2SMOBNUM (tc)].mark = mark;
-}
-
void
scm_set_smob_free (scm_t_bits tc, size_t (*free) (SCM))
{
@@ -281,101 +236,6 @@ scm_make_smob (scm_t_bits tc)
-/* Marking SMOBs using user-supplied mark procedures. */
-
-
-/* The GC kind used for SMOB types that provide a custom mark procedure. */
-static int smob_gc_kind;
-
-/* Mark stack pointer and limit, used by `scm_gc_mark'. */
-static scm_i_pthread_key_t current_mark_stack_pointer;
-static scm_i_pthread_key_t current_mark_stack_limit;
-
-
-/* The generic SMOB mark procedure that gets called for SMOBs allocated
- with smob_gc_kind. */
-static struct GC_ms_entry *
-smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
- struct GC_ms_entry *mark_stack_limit, GC_word env)
-{
- register SCM cell;
- register scm_t_bits tc, smobnum;
-
- cell = SCM_PACK_POINTER (addr);
-
- if (SCM_TYP7 (cell) != scm_tc7_smob)
- /* It is likely that the GC passed us a pointer to a free-list element
- which we must ignore (see warning in `gc/gc_mark.h'). */
- return mark_stack_ptr;
-
- tc = SCM_CELL_WORD_0 (cell);
- smobnum = SCM_TC2SMOBNUM (tc);
-
- if (smobnum >= scm_numsmob)
- /* The first word looks corrupt. */
- abort ();
-
- mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_1 (cell)),
- mark_stack_ptr,
- mark_stack_limit, NULL);
- mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_2 (cell)),
- mark_stack_ptr,
- mark_stack_limit, NULL);
- mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_3 (cell)),
- mark_stack_ptr,
- mark_stack_limit, NULL);
-
- if (scm_smobs[smobnum].mark)
- {
- SCM obj;
-
- scm_i_pthread_setspecific (current_mark_stack_pointer, mark_stack_ptr);
- scm_i_pthread_setspecific (current_mark_stack_limit, mark_stack_limit);
-
- /* Invoke the SMOB's mark procedure, which will in turn invoke
- `scm_gc_mark', which may modify `current_mark_stack_pointer'. */
- obj = scm_smobs[smobnum].mark (cell);
-
- mark_stack_ptr = scm_i_pthread_getspecific (current_mark_stack_pointer);
-
- if (SCM_HEAP_OBJECT_P (obj))
- /* Mark the returned object. */
- mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (obj),
- mark_stack_ptr,
- mark_stack_limit, NULL);
-
- scm_i_pthread_setspecific (current_mark_stack_pointer, NULL);
- scm_i_pthread_setspecific (current_mark_stack_limit, NULL);
- }
-
- return mark_stack_ptr;
-
-}
-
-/* Mark object O. We assume that this function is only called during the mark
- phase, i.e., from within `smob_mark' or one of its descendants. */
-void
-scm_gc_mark (SCM o)
-{
- if (SCM_HEAP_OBJECT_P (o))
- {
- void *mark_stack_ptr, *mark_stack_limit;
-
- mark_stack_ptr = scm_i_pthread_getspecific (current_mark_stack_pointer);
- mark_stack_limit = scm_i_pthread_getspecific (current_mark_stack_limit);
-
- if (mark_stack_ptr == NULL)
- /* The function was not called from a mark procedure. */
- abort ();
-
- mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (o),
- mark_stack_ptr, mark_stack_limit,
- NULL);
- scm_i_pthread_setspecific (current_mark_stack_pointer, mark_stack_ptr);
- }
-}
-
-
/* Finalize SMOB by calling its SMOB type's free function, if any. */
void
scm_i_finalize_smob (struct scm_thread *thread, SCM smob)
@@ -386,11 +246,7 @@ scm_i_finalize_smob (struct scm_thread *thread, SCM smob)
/* Frob the object's type in place, re-setting it to be the "finalized
smob" type. This will prevent other routines from accessing its
- internals in a way that assumes that the smob data is valid. This
- is notably the case for SMOB's own "mark" procedure, if any; as the
- finalizer is invoked by the mutator, it's possible for a GC to
- occur while it's running, in which case the object is alive and yet
- its data is invalid. */
+ internals in a way that assumes that the smob data is valid. */
scm_t_bits finalized_word = first_word & ~(scm_t_bits) 0xff00;
scm_atomic_set_bits (first_word_loc, finalized_word);
@@ -403,54 +259,28 @@ scm_i_finalize_smob (struct scm_thread *thread, SCM smob)
free_smob (smob);
}
-/* Return a SMOB with typecode TC. The SMOB type corresponding to TC may
- provide a custom mark procedure and it will be honored. */
+/* Return a SMOB with typecode TC. */
SCM
-scm_i_new_smob (scm_t_bits tc, scm_t_bits data)
+scm_new_smob (scm_t_bits tc, scm_t_bits data)
{
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
- SCM ret;
-
- /* Use the smob_gc_kind if needed to allow the mark procedure to
- run. Since the marker only deals with double cells, that case
- allocates a double cell. We leave words 2 and 3 to there initial
- values, which is 0. */
- if (scm_smobs [smobnum].mark)
- ret = SCM_PACK_POINTER (GC_generic_malloc (2 * sizeof (scm_t_cell),
smob_gc_kind));
- else
- ret = SCM_PACK_POINTER (GC_MALLOC (sizeof (scm_t_cell)));
-
- SCM_SET_CELL_WORD_1 (ret, data);
- SCM_SET_CELL_WORD_0 (ret, tc);
+ SCM ret = scm_cell (tc, data);
- if (scm_smobs[smobnum].free)
+ if (SCM_UNLIKELY (scm_smobs[smobnum].free))
scm_i_add_smob_finalizer (SCM_I_CURRENT_THREAD, ret);
return ret;
}
-/* Return a SMOB with typecode TC. The SMOB type corresponding to TC may
- provide a custom mark procedure and it will be honored. */
+/* Return a SMOB with typecode TC. */
SCM
-scm_i_new_double_smob (scm_t_bits tc, scm_t_bits data1,
- scm_t_bits data2, scm_t_bits data3)
+scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
+ scm_t_bits data2, scm_t_bits data3)
{
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
- SCM ret;
-
- /* Use the smob_gc_kind if needed to allow the mark procedure to
- run. */
- if (scm_smobs [smobnum].mark)
- ret = SCM_PACK_POINTER (GC_generic_malloc (2 * sizeof (scm_t_cell),
smob_gc_kind));
- else
- ret = SCM_PACK_POINTER (GC_MALLOC (2 * sizeof (scm_t_cell)));
-
- SCM_SET_CELL_WORD_3 (ret, data3);
- SCM_SET_CELL_WORD_2 (ret, data2);
- SCM_SET_CELL_WORD_1 (ret, data1);
- SCM_SET_CELL_WORD_0 (ret, tc);
+ SCM ret = scm_double_cell (tc, data1, data2, data3);
- if (scm_smobs[smobnum].free)
+ if (SCM_UNLIKELY (scm_smobs[smobnum].free))
scm_i_add_smob_finalizer (SCM_I_CURRENT_THREAD, ret);
return ret;
@@ -475,22 +305,11 @@ scm_smob_prehistory ()
long i;
scm_t_bits finalized_smob_tc16;
- scm_i_pthread_key_create (¤t_mark_stack_pointer, NULL);
- scm_i_pthread_key_create (¤t_mark_stack_limit, NULL);
-
- smob_gc_kind = GC_new_kind (GC_new_free_list (),
- GC_MAKE_PROC (GC_new_proc (smob_mark), 0),
- 0,
- /* Clear new objects. As of version 7.1, libgc
- doesn't seem to support passing 0 here. */
- 1);
-
scm_numsmob = 0;
for (i = 0; i < MAX_SMOB_COUNT; ++i)
{
scm_smobs[i].name = 0;
scm_smobs[i].size = 0;
- scm_smobs[i].mark = 0;
scm_smobs[i].free = 0;
scm_smobs[i].print = scm_smob_print;
scm_smobs[i].equalp = 0;
diff --git a/libguile/smob.h b/libguile/smob.h
index 990ac057b..22d925b8b 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -22,11 +22,10 @@
-#include <libguile/error.h>
-#include <libguile/gc.h>
-#include "libguile/inline.h"
+#include "libguile/error.h"
+#include "libguile/gc.h"
#include "libguile/print.h"
-#include <libguile/snarf.h>
+#include "libguile/snarf.h"
@@ -36,7 +35,6 @@ typedef struct scm_smob_descriptor
{
char const *name;
size_t size;
- SCM (*mark) (SCM);
size_t (*free) (SCM);
int (*print) (SCM exp, SCM port, scm_print_state *pstate);
SCM (*equalp) (SCM, SCM);
@@ -78,14 +76,6 @@ SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name),
(size));)
SCM_SNARF_HERE(scm_t_bits tag) \
SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
-#define SCM_SMOB_MARK(tag, c_name, arg) \
-SCM_SNARF_HERE(static SCM c_name(SCM arg)) \
-SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
-
-#define SCM_GLOBAL_SMOB_MARK(tag, c_name, arg) \
-SCM_SNARF_HERE(SCM c_name(SCM arg)) \
-SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
-
#define SCM_SMOB_FREE(tag, c_name, arg) \
SCM_SNARF_HERE(static size_t c_name(SCM arg)) \
SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
@@ -121,39 +111,9 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req),
(opt), (rest));)
-SCM_API SCM scm_i_new_smob (scm_t_bits tc, scm_t_bits);
-SCM_API SCM scm_i_new_double_smob (scm_t_bits tc, scm_t_bits,
- scm_t_bits, scm_t_bits);
-
-
-SCM_INLINE SCM scm_new_smob (scm_t_bits tc, scm_t_bits);
-SCM_INLINE SCM scm_new_double_smob (scm_t_bits tc, scm_t_bits,
- scm_t_bits, scm_t_bits);
-
-#if SCM_CAN_INLINE || defined SCM_INLINE_C_IMPLEMENTING_INLINES
-SCM_INLINE_IMPLEMENTATION SCM
-scm_new_smob (scm_t_bits tc, scm_t_bits data)
-{
- scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
-
- if (SCM_UNLIKELY (scm_smobs[smobnum].mark || scm_smobs[smobnum].free))
- return scm_i_new_smob (tc, data);
- else
- return scm_cell (tc, data);
-}
-
-SCM_INLINE_IMPLEMENTATION SCM
-scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
- scm_t_bits data2, scm_t_bits data3)
-{
- scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
-
- if (SCM_UNLIKELY (scm_smobs[smobnum].mark || scm_smobs[smobnum].free))
- return scm_i_new_double_smob (tc, data1, data2, data3);
- else
- return scm_double_cell (tc, data1, data2, data3);
-}
-#endif
+SCM_API SCM scm_new_smob (scm_t_bits tc, scm_t_bits);
+SCM_API SCM scm_new_double_smob (scm_t_bits tc, scm_t_bits,
+ scm_t_bits, scm_t_bits);
#define SCM_NEWSMOB(z, tc, data) \
z = scm_new_smob ((tc), (scm_t_bits)(data))
@@ -222,22 +182,18 @@ scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
-SCM_API SCM scm_mark0 (SCM ptr);
-SCM_API SCM scm_markcdr (SCM ptr);
-SCM_API size_t scm_free0 (SCM ptr);
SCM_API int scm_smob_print (SCM exp, SCM port, scm_print_state *pstate);
/* The following set of functions is the standard way to create new
* SMOB types.
*
* Create a type tag using `scm_make_smob_type', accept default values
- * for mark, free, print and/or equalp functions, or set your own
+ * for free, print and/or equalp functions, or set your own
* values using `scm_set_smob_xxx'.
*/
SCM_API scm_t_bits scm_make_smob_type (char const *name, size_t size);
-SCM_API void scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM));
SCM_API void scm_set_smob_free (scm_t_bits tc, size_t (*free) (SCM));
SCM_API void scm_set_smob_print (scm_t_bits tc,
int (*print) (SCM, SCM, scm_print_state*));
diff --git a/test-suite/standalone/Makefile.am
b/test-suite/standalone/Makefile.am
index 5c3b5569e..8cde6ecf2 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in.
##
-## Copyright 2003-2014, 2020-2024 Free Software Foundation, Inc.
+## Copyright 2003-2014, 2020-2025 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -292,18 +292,6 @@ EXTRA_DIST += test-with-guile-module.c
test-scm-with-guile.c
endif
-test_smob_mark_SOURCES = test-smob-mark.c
-test_smob_mark_CFLAGS = ${test_cflags}
-test_smob_mark_LDADD = $(LIBGUILE_LDADD) $(top_builddir)/lib/libgnu.la
-check_PROGRAMS += test-smob-mark
-TESTS += test-smob-mark
-
-test_smob_mark_race_SOURCES = test-smob-mark-race.c
-test_smob_mark_race_CFLAGS = ${test_cflags}
-test_smob_mark_race_LDADD = $(LIBGUILE_LDADD) $(top_builddir)/lib/libgnu.la
-check_PROGRAMS += test-smob-mark-race
-TESTS += test-smob-mark-race
-
check_SCRIPTS += test-stack-overflow
TESTS += test-stack-overflow
diff --git a/test-suite/standalone/test-smob-mark-race.c
b/test-suite/standalone/test-smob-mark-race.c
deleted file mode 100644
index 31aba8c30..000000000
--- a/test-suite/standalone/test-smob-mark-race.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/* Copyright 2016
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile is free software: you can redistribute it and/or modify it
- under the terms of the GNU Lesser General Public License as published
- by the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- Guile is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
- License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with Guile. If not, see
- <https://www.gnu.org/licenses/>. */
-
-#if HAVE_CONFIG_H
-#include <config.h>
-#endif
-
-#undef NDEBUG
-
-#include <libguile.h>
-#include <assert.h>
-
-static SCM
-mark_smob (SCM smob)
-{
- assert (SCM_SMOB_DATA (smob) == 1);
- return SCM_BOOL_F;
-}
-
-static size_t
-finalize_smob (SCM smob)
-{
- assert (SCM_SMOB_DATA (smob) == 1);
- SCM_SET_SMOB_DATA (smob, 0);
- /* Allocate a bit in the hopes of triggering a new GC, making the
- marker race with the finalizer. */
- scm_cons (SCM_BOOL_F, SCM_BOOL_F);
- return 0;
-}
-
-static void
-tests (void *data, int argc, char **argv)
-{
- scm_t_bits tc16;
- int i;
-
- tc16 = scm_make_smob_type ("smob with finalizer", 0);
- scm_set_smob_mark (tc16, mark_smob);
- scm_set_smob_free (tc16, finalize_smob);
-
- for (i = 0; i < 1000 * 1000; i++)
- scm_new_smob (tc16, 1);
-}
-
-int
-main (int argc, char *argv[])
-{
- scm_boot_guile (argc, argv, tests, NULL);
- return 0;
-}
diff --git a/test-suite/standalone/test-smob-mark.c
b/test-suite/standalone/test-smob-mark.c
deleted file mode 100644
index b04b70486..000000000
--- a/test-suite/standalone/test-smob-mark.c
+++ /dev/null
@@ -1,136 +0,0 @@
-/* Copyright 2013-2014,2018,2025
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile is free software: you can redistribute it and/or modify it
- under the terms of the GNU Lesser General Public License as published
- by the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- Guile is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
- License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with Guile. If not, see
- <https://www.gnu.org/licenses/>. */
-
-#if HAVE_CONFIG_H
-#include <config.h>
-#endif
-
-#undef NDEBUG
-
-#include <assert.h>
-#include <libguile.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-#define SMOBS_COUNT (10000)
-
-struct x_tag
-{
- SCM scm_value;
- int c_value;
-};
-
-typedef struct x_tag x_t;
-
-unsigned int mark_call_count = 0;
-
-static scm_t_bits x_tag;
-static SCM make_x (void);
-static SCM mark_x (SCM x);
-static int print_x (SCM x, SCM port, scm_print_state * pstate);
-static size_t free_x (SCM x);
-static void init_smob_type (void);
-static void test_scm_smob_mark (void);
-
-static SCM
-make_x ()
-{
- static int i = 0;
- SCM s_x;
- x_t *c_x;
-
- i++;
- c_x = (x_t *) scm_malloc (sizeof (x_t));
- c_x->scm_value = scm_from_int (i);
- c_x->c_value = i;
- SCM_NEWSMOB (s_x, x_tag, c_x);
- return s_x;
-}
-
-static SCM
-mark_x (SCM x)
-{
- x_t *c_x;
- c_x = (x_t *) SCM_SMOB_DATA (x);
- scm_gc_mark (c_x->scm_value);
- mark_call_count++;
- return SCM_BOOL_F;
-}
-
-static size_t
-free_x (SCM x)
-{
- x_t *c_x;
- c_x = (x_t *) SCM_SMOB_DATA (x);
- free (c_x);
- c_x = NULL;
- return 0;
-}
-
-static int
-print_x (SCM x, SCM port, scm_print_state * pstate SCM_UNUSED)
-{
- x_t *c_x = (x_t *) SCM_SMOB_DATA (x);
- scm_puts ("#<x ", port);
- if (c_x == (x_t *) NULL)
- scm_puts ("(freed)", port);
- else
- scm_write (c_x->scm_value, port);
- scm_puts (">", port);
-
- return 1;
-}
-
-static void
-test_scm_smob_mark ()
-{
- int i;
- mark_call_count = 0;
- for (i = 0; i < SMOBS_COUNT; i++)
- make_x ();
- scm_gc ();
- if (mark_call_count < SMOBS_COUNT)
- {
- fprintf (stderr, "FAIL: SMOB mark function called for each SMOB\n");
- exit (EXIT_FAILURE);
- }
-}
-
-static void
-init_smob_type ()
-{
- x_tag = scm_make_smob_type ("x", sizeof (x_t));
- scm_set_smob_free (x_tag, free_x);
- scm_set_smob_print (x_tag, print_x);
- scm_set_smob_mark (x_tag, mark_x);
-}
-
-static void
-tests (void *data, int argc, char **argv)
-{
- init_smob_type ();
- test_scm_smob_mark ();
-}
-
-int
-main (int argc, char *argv[])
-{
- scm_boot_guile (argc, argv, tests, NULL);
- return 0;
-}
