feature suggestion: user blockable gc

[Christian Lynbech <chl@tbit.dk>]

Here is a small feature I have been playing with. It is by no means
important or even usefull in any obvious way, but here it is for your
considerations.

It is the ability to block the GC from running, from the scheme
level. It adds the function `gc-block', `gc-unblock' and `gc-blocked?'
with the obvious functionality.

The patch is relative to an older snapshot, but should transfer to
newer ones as well. Otherwise, let me know and I will attempt to
regenerate it.

Index: tools/guile/guile-core/libguile/gc.c
diff -u tools/guile/guile-core/libguile/gc.c:1.1.1.2 tools/guile/guile-core/libguile/gc.c:1.1.1.2.10.1
--- tools/guile/guile-core/libguile/gc.c:1.1.1.2	Sun Jan  4 01:09:54 1998
+++ tools/guile/guile-core/libguile/gc.c	Fri Jul 10 12:19:57 1998
@@ -160,6 +160,7 @@
  */
 
 int scm_block_gc = 1;
+int scm_user_block_gc = 0;	/* allow users to block for gc */
 
 /* If fewer than MIN_GC_YIELD cells are recovered during a garbage
  * collection (GC) more space is allocated for the heap.
@@ -444,7 +445,7 @@
   // fprintf (stderr, "gc: %s\n", what);
 
   scm_gc_start (what);
-  if (!scm_stack_base || scm_block_gc)
+  if (!scm_stack_base || scm_block_gc || scm_user_block_gc)
     {
       scm_gc_end ();
       return;
@@ -1818,6 +1819,30 @@
   scm_protects = scm_delq_x (obj, scm_protects);
 
   return obj;
+}
+
+/* Allow users to block GC */
+SCM_PROC (s_scm_gc_block, "gc-block", 0, 0, 0, scm_gc_block);
+SCM 
+scm_gc_block() 
+{
+  scm_user_block_gc = 1;
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC (s_scm_gc_unblock, "gc-unblock", 0, 0, 0, scm_gc_unblock);
+SCM 
+scm_gc_unblock() 
+{
+  scm_user_block_gc = 0;
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC (s_scm_gc_blocked_p, "gc-blocked?", 0, 0, 0, scm_gc_blocked_p);
+SCM 
+scm_gc_blocked_p() 
+{
+  return (scm_user_block_gc == 0 ? SCM_BOOL_F : SCM_BOOL_T);
 }
 
 
Index: tools/guile/guile-core/libguile/gc.h
diff -u tools/guile/guile-core/libguile/gc.h:1.1.1.2 tools/guile/guile-core/libguile/gc.h:1.1.1.2.10.1
--- tools/guile/guile-core/libguile/gc.h:1.1.1.2	Thu Oct  2 16:42:58 1997
+++ tools/guile/guile-core/libguile/gc.h	Fri Jul 10 12:19:58 1998
@@ -54,6 +54,7 @@
 extern int scm_n_heap_segs;
 extern int scm_take_stdin;
 extern int scm_block_gc;
+extern int scm_user_block_gc;
 extern int scm_gc_heap_lock;
 
 

---------------------------+--------------------------------------------------
Christian Lynbech          | Telebit Communications A/S                       
Fax:   +45 8628 8186       | Fabrik 11, DK-8260 Viby J
Phone: +45 8628 8177 + 28  | email: chl@tbit.dk --- URL: http://www.telebit.dk
---------------------------+--------------------------------------------------
Hit the philistines three times over the head with the Elisp reference manual.
                                        - petonic@hal.com (Michael A. Petonic)