* * gc.c (scm_protect_object, scm_unprotect_object): New functions.

	Their prototypes were already present in gc.h, but they weren't
	implemented.
	(scm_init_storage): Initialize scm_protects.
	* root.c (scm_protects): New element of scm_sys_protects.

2 files changed, 44 insertions, 3 deletions

diff --git a/libguile/gc.c b/libguile/gc.c
index cd4a249d7..9d434f33e 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1755,6 +1755,45 @@ scm_permanent_object (obj)
 }
 
 
+/* Protect OBJ from the garbage collector.  OBJ will not be freed,
+   even if all other references are dropped, until someone applies
+   scm_unprotect_object to it.  This function returns OBJ.
+
+   Note that calls to scm_protect_object do not nest.  You can call
+   scm_protect_object any number of times on a given object, and the
+   next call to scm_unprotect_object will unprotect it completely.
+
+   Basically, scm_protect_object and scm_unprotect_object just
+   maintain a list of references to things.  Since the GC knows about
+   this list, all objects it mentions stay alive.  scm_protect_object
+   adds its argument to the list; scm_unprotect_object remove its
+   argument from the list.  */
+SCM
+scm_protect_object (obj)
+     SCM obj;
+{
+  /* This function really should use address hashing tables, but I
+     don't know how to use them yet.  For now we just use a list.  */
+  scm_protects = scm_cons (obj, scm_protects);
+
+  return obj;
+}
+
+
+/* Remove any protection for OBJ established by a prior call to
+   scm_protect_obj.  This function returns OBJ.
+
+   See scm_protect_obj for more information.  */
+SCM
+scm_unprotect_object (obj)
+     SCM obj;
+{
+  scm_protects = scm_delq_x (obj, scm_protects);
+
+  return obj;
+}
+
+
 
 int
 scm_init_storage (init_heap_size)
@@ -1808,6 +1847,7 @@ scm_init_storage (init_heap_size)
   scm_symhash_vars = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL, SCM_UNDEFINED);
   scm_stand_in_procs = SCM_EOL;
   scm_permobjs = SCM_EOL;
+  scm_protects = SCM_EOL;
   scm_asyncs = SCM_EOL;
   scm_sysintern ("most-positive-fixnum", (SCM) SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM));
   scm_sysintern ("most-negative-fixnum", (SCM) SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM));
diff --git a/libguile/root.h b/libguile/root.h
index 37857d47d..6d6ab2b25 100644
--- a/libguile/root.h
+++ b/libguile/root.h
@@ -67,11 +67,12 @@
 #define scm_object_whash scm_sys_protects[12]
 #define scm_permobjs scm_sys_protects[13]
 #define scm_asyncs scm_sys_protects[14]
+#define scm_protects scm_sys_protects[15]
 #ifdef DEBUG_EXTENSIONS
-#define scm_source_whash scm_sys_protects[15]
-#define SCM_NUM_PROTECTS 16
+#define scm_source_whash scm_sys_protects[16]
+#define SCM_NUM_PROTECTS 17
 #else
-#define SCM_NUM_PROTECTS 15
+#define SCM_NUM_PROTECTS 16
 #endif
 
 extern SCM scm_sys_protects[];