From 807b00d91fa3b7016987ecfd6992e7b7e943d1e3 Mon Sep 17 00:00:00 2001
From: Mike Gran <address@hidden>
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