mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-04 19:20:27 +02:00
Code Activity

Remove SMOB mark functions

Browse source 
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.
This commit is contained in:
Andy Wingo 2025-05-15 10:31:12 +02:00
parent 2bfc66554e
commit 0e8c6b6727
6 changed files with 26 additions and 457 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/deprecated.h
View file

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

201
libguile/smob.c
View file

@ -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))
{
@ -280,101 +235,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
@ -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;
SCM ret = scm_cell (tc, data);
/* 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);
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;
SCM ret = scm_double_cell (tc, data1, data2, data3);
/* 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);
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 (&current_mark_stack_pointer, NULL);
scm_i_pthread_key_create (&current_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;

58
libguile/smob.h
View file

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