Re: nesting scm_protect/unprotect_object

[Charbel Jacquin <cjacquin@www.mds-design.fr>]

Jim Blandy wrote:
> 
> > Thus I propose to somehow put a reimplementation of this mechanism on a
> > TODO list, maybe with lowest priority.
> 
> If you submit a patch, it could be in 1.3.1!  :)  Use the
> scm_hashq... functions, I think.
> 
> (The problem with a prioritized TODO list, I have discovered, is that
> new items of high priority are always being created, so stuff at the
> bottom starves.  I need some kind of aging process, where as items
> begin to stink, they become higher priority --- like my fridge.)

Maybe this can help cleanup your TODO list.
I use protected objects as keys and refcount as values. Objects 
are first inserted with a refcount of 1. Hash handles are removed
when refcount reach zero.
I have no clue about what the best hashtable size is. Maybe this
should be configurable.

BTW: We don't need to protect immediates.

BEWARE: this code is mostly untested :)

It would be nice if we could remove an handle by "value",
(ie. without having to search the key again with 
scm_hash?_remove_x).

Hope this helps.
Charbel.

here is the patch:

--- gc.c.orig	Mon Oct 12 14:21:06 1998
+++ gc.c	Fri Oct  9 23:03:16 1998
@@ -49,7 +49,7 @@
 #include "smob.h"
 #include "unif.h"
 #include "async.h"
-
+#include "hashtab.h"
 #include "gc.h"
 
 #ifdef HAVE_MALLOC_H
@@ -1809,8 +1816,15 @@
 scm_protect_object (obj)
      SCM obj;
 {
-  scm_protects = scm_cons (obj, scm_protects);
-
+  if (!SCM_IMP(obj)) 
+    {
+      SCM handle = scm_hashq_get_handle(scm_protects, obj);
+      if (handle == SCM_BOOL_F) {
+        scm_hashq_create_handle_x(scm_protects, obj, SCM_MAKINUM(1));
+      } else {
+ 	 SCM_SETCDR(handle,SCM_MAKINUM(1+SCM_INUM(SCM_CDR(handle))));
+      }
+    }
   return obj;
 }
 
@@ -1823,17 +1837,22 @@
 scm_unprotect_object (obj)
      SCM obj;
 {
-  SCM *tail_ptr = &scm_protects;
-
-  while (SCM_NIMP (*tail_ptr) && SCM_CONSP (*tail_ptr))
-    if (SCM_CAR (*tail_ptr) == obj)
-      {
-	*tail_ptr = SCM_CDR (*tail_ptr);
-	break;
-      }
-    else
-      tail_ptr = SCM_CDRLOC (*tail_ptr);
-
+  SCM handle;
+  if (SCM_IMP(obj))
+    return obj;
+  handle = scm_hashq_get_handle(scm_protects, obj);
+  if (handle != SCM_BOOL_F) 
+    {
+      int refcount = SCM_INUM(SCM_CDR(handle)) - 1;
+      if (refcount <= 0)
+	{
+	  scm_hashq_remove_x(scm_protects,obj);
+	}
+      else
+	{
+	  SCM_SETCDR(handle, SCM_MAKINUM(refcount));
+	}
+    }
   return obj;
 }
 
@@ -1890,7 +1909,9 @@
   scm_symhash_vars = scm_make_vector ((SCM) SCM_MAKINUM
(scm_symhash_dim), SCM_EOL);
   scm_stand_in_procs = SCM_EOL;
   scm_permobjs = SCM_EOL;
-  scm_protects = SCM_EOL;
+  scm_protects = scm_make_vector(SCM_MAKINUM(127), /* random size */
+				 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));