+/* Debugging functions. */
+
+#ifdef DEBUG_FREELIST
+
+/* Return the number of the heap segment containing CELL. */
+static int
+which_seg (SCM cell)
+{
+ int i;
+
+ for (i = 0; i < scm_n_heap_segs; i++)
+ if (SCM_PTR_LE (scm_heap_table[i].bounds[0], (SCM_CELLPTR) cell)
+ && SCM_PTR_GT (scm_heap_table[i].bounds[1], (SCM_CELLPTR) cell))
+ return i;
+ fprintf (stderr, "which_seg: can't find segment containing cell %lx\n",
+ cell);
+ abort ();
+}
+
+
+SCM_PROC (s_map_free_list, "map-free-list", 0, 0, 0, scm_map_free_list);
+SCM
+scm_map_free_list ()
+{
+ int last_seg = -1, count = 0;
+ SCM f;
+
+ fprintf (stderr, "%d segments total\n", scm_n_heap_segs);
+ for (f = scm_freelist; SCM_NIMP (f); f = SCM_CDR (f))
+ {
+ int this_seg = which_seg (f);
+
+ if (this_seg != last_seg)
+ {
+ if (last_seg != -1)
+ fprintf (stderr, " %5d cells in segment %d\n", count, last_seg);
+ last_seg = this_seg;
+ count = 0;
+ }
+ count++;
+ }
+ if (last_seg != -1)
+ fprintf (stderr, " %5d cells in segment %d\n", count, last_seg);
+
+ fflush (stderr);
+
+ return SCM_UNSPECIFIED;
+}
+
+
+/* Number of calls to SCM_NEWCELL since startup. */
+static unsigned long scm_newcell_count;
+
+/* Search freelist for anything that isn't marked as a free cell.
+ Abort if we find something. */
+static void
+scm_check_freelist ()
+{
+ SCM f;
+ int i = 0;
+
+ for (f = scm_freelist; SCM_NIMP (f); f = SCM_CDR (f), i++)
+ if (SCM_CAR (f) != (SCM) scm_tc_free_cell)
+ {
+ fprintf (stderr, "Bad cell in freelist on newcell %lu: %d'th elt\n",
+ scm_newcell_count, i);
+ fflush (stderr);
+ abort ();
+ }
+}
+
+static int scm_debug_check_freelist = 0;
+void
+scm_debug_newcell (SCM *into)
+{
+ scm_newcell_count++;
+ if (scm_debug_check_freelist)
+ scm_check_freelist ();
+
+ /* The rest of this is supposed to be identical to the SCM_NEWCELL
+ macro. */
+ if (SCM_IMP (scm_freelist))
+ *into = scm_gc_for_newcell ();
+ else
+ {
+ *into = scm_freelist;
+ scm_freelist = SCM_CDR (scm_freelist);
+ ++scm_cells_allocated;
+ }
+}
+
+#endif /* DEBUG_FREELIST */
+
+\f