summaryrefslogtreecommitdiff
path: root/libguile/smob.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/smob.c')
-rw-r--r--libguile/smob.c26
1 files changed, 16 insertions, 10 deletions
diff --git a/libguile/smob.c b/libguile/smob.c
index de64d7f31..901942c8e 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -499,11 +499,6 @@ free_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
static void **smob_freelist = NULL;
static int smob_gc_kind = 0;
-#define CURRENT_MARK_PTR \
- ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_ptr))
-#define CURRENT_MARK_LIMIT \
- ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
-
/* The generic SMOB mark procedure that gets called for SMOBs allocated with
`scm_i_new_smob_with_mark_proc ()'. */
@@ -512,18 +507,22 @@ 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;
- scm_t_bits tc, smobnum;
+ register scm_t_bits tc, smobnum;
+
+ cell = PTR2SCM (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;
- cell = SCM_PACK ((scm_t_bits)addr);
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 (addr, mark_stack_ptr,
- mark_stack_limit, NULL);
-
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_1 (cell)),
mark_stack_ptr,
mark_stack_limit, NULL);
@@ -567,6 +566,11 @@ smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
void
scm_gc_mark (SCM o)
{
+#define CURRENT_MARK_PTR \
+ ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_ptr))
+#define CURRENT_MARK_LIMIT \
+ ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
+
if (SCM_NIMP (o))
{
/* At this point, the `current_mark_*' fields of the current thread
@@ -582,6 +586,8 @@ scm_gc_mark (SCM o)
NULL);
SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
}
+#undef CURRENT_MARK_PTR
+#undef CURRENT_MARK_LIMIT
}
/* Return a SMOB with typecode TC. The SMOB type corresponding to TC may