diff options
author | Andy Wingo <wingo@pobox.com> | 2025-05-15 10:31:12 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2025-05-15 10:46:01 +0200 |
commit | 0e8c6b6727be063bee73752ad8afe60b29a28929 (patch) | |
tree | aa3654ab0b686094accd20b7dbef424775bf0084 | |
parent | 2bfc66554e9c5fe6616048e5f5d87a8c2306ef1c (diff) | |
download | guile-0e8c6b6727be063bee73752ad8afe60b29a28929.tar.gz |
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.
-rw-r--r-- | libguile/deprecated.h | 8 | ||||
-rw-r--r-- | libguile/smob.c | 201 | ||||
-rw-r--r-- | libguile/smob.h | 58 | ||||
-rw-r--r-- | test-suite/standalone/Makefile.am | 14 | ||||
-rw-r--r-- | test-suite/standalone/test-smob-mark-race.c | 66 | ||||
-rw-r--r-- | 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} */ @@ -231,12 +192,6 @@ scm_make_smob_type (char const *name, size_t size) 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)) { scm_smobs[SCM_TC2SMOBNUM (tc)].free = free; @@ -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; -} |