bug#13611: SEGV during SMOB GC

[Mike Gran <spk121@yahoo.com>]

[-- Attachment #1: Type: text/plain, Size: 1159 bytes --]

> From: Ludovic Courtès <ludo@gnu.org>

> Is there any chance that you’re using a GC 7.3 pre-release?

Using gc-7.2b-2.fc17.i686
on Linux 3.6.10-2.fc17.i686 #1 SMP 

> There was a similar report on IRC, and the fix appears to be:

It does fix my SEGV

> (Note that on 2.0 SMOB mark procedures are unnecessary.)

Cool.  Let's yank it from the manual.  Case closed.

Yet...

For what it is worth, I decided to get som statistics on how
often smob_mark is called from a thread with scm_i_current_thread
== NULL vs how often it is called from a thread where it is 
not null.

I wrote the attached patch, and then, using the same little
library as in my initial report, I ran

 (use-modules (smobbug))
 ;; Create a SMOB type
 (handlesmob-init)
 (for-each (lambda (x) (gc))
       (iota 1000))
 (gc-smob-mark-report)

This returned

 Count of GC SMOB marks from null thread: 176
 Count of GC SMOB marks from current thread: 825

Is that expected that GC is sometimes called from a 
thread where scm_i_current_thread is null and sometimes
called from a thread where scm_i_current_thread is
not null?

-Mike 

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: smob_gc_mark_report.patch --]
[-- Type: text/x-patch; name="smob_gc_mark_report.patch", Size: 3183 bytes --]

From 807b00d91fa3b7016987ecfd6992e7b7e943d1e3 Mon Sep 17 00:00:00 2001
From: Mike Gran <spk121@yahoo.com>
Date: Tue, 5 Feb 2013 08:18:07 -0800
Subject: [PATCH] Add function to debug smob gc

* libguile/gc.c (scm_gc_smob_mark_report): new report function
* libguile/gc.h: new declaration of scm_gc_smob_mark_report
* libguile/smob.c (smob_mark): gather statistics
---
 libguile/gc.c   | 22 ++++++++++++++++++++++
 libguile/gc.h   |  1 +
 libguile/smob.c |  8 +++++++-
 3 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/libguile/gc.c b/libguile/gc.c
index 06b5044..d06fa6c 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -77,6 +77,10 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
 int scm_debug_cell_accesses_p = 0;
 int scm_expensive_debug_cell_accesses_p = 0;
 
+
+extern long scm_mark_from_null;
+extern long scm_mark_from_current;
+
 /* Set this to 0 if no additional gc's shall be performed, otherwise set it to
  * the number of cell accesses after which a gc shall be called.
  */
@@ -383,6 +387,24 @@ SCM_DEFINE (scm_gc_enable, "gc-enable", 0, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_gc_smob_mark_report, "gc-smob-mark-report", 0, 0, 0,
+	    (),
+	    "Print statistics on gc marking of smobs.")
+#define FUNC_NAME s_scm_gc_smob_mark_report
+{
+  scm_puts ("Count of GC SMOB marks from null thread: ",
+	    scm_current_output_port ());
+  scm_display (scm_from_long (scm_mark_from_null), scm_current_output_port ());
+  scm_newline (scm_current_output_port ());
+  scm_puts ("Count of GC SMOB marks from current thread: ",
+	    scm_current_output_port ());
+  scm_display (scm_from_long (scm_mark_from_current),
+	       scm_current_output_port ());
+  scm_newline (scm_current_output_port ());
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 
 SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
            (),
diff --git a/libguile/gc.h b/libguile/gc.h
index 9f00e01..1120aa8 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -173,6 +173,7 @@ SCM_API SCM scm_set_debug_cell_accesses_x (SCM flag);
 
 SCM_API SCM scm_object_address (SCM obj);
 SCM_API SCM scm_gc_enable (void);
+SCM_API SCM scm_gc_smob_mark_report (void);
 SCM_API SCM scm_gc_disable (void);
 SCM_API SCM scm_gc_dump (void);
 SCM_API SCM scm_gc_stats (void);
diff --git a/libguile/smob.c b/libguile/smob.c
index c2e8f24..cc8b59a 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -52,6 +52,7 @@
 
 long scm_numsmob;
 scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT];
+long scm_mark_from_null = 0, scm_mark_from_current = 0;
 
 void
 scm_assert_smob_type (scm_t_bits tag, SCM val)
@@ -294,6 +295,11 @@ smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
   register SCM cell;
   register scm_t_bits tc, smobnum;
 
+  if (SCM_I_CURRENT_THREAD == NULL)
+    scm_mark_from_null ++;
+  else
+    scm_mark_from_current ++;
+
   cell = PTR2SCM (addr);
 
   if (SCM_TYP7 (cell) != scm_tc7_smob)
@@ -318,7 +324,7 @@ smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
 				     mark_stack_ptr,
 				     mark_stack_limit, NULL);
 
-  if (scm_smobs[smobnum].mark)
+  if (scm_smobs[smobnum].mark && SCM_I_CURRENT_THREAD != NULL)
     {
       SCM obj;
 
-- 
1.7.11.7