Fixed use of finalizers for guardians and SMOBs (undoes patches 23-24).

* libguile/gc.c (finalizer_trampoline): Removed.
  (scm_gc_register_finalizer): Removed (undoes patches 23 and 24).

* libguile/gc.h (scm_gc_register_finalizer): Removed.

* libguile/guardians.c (finalize_guarded): Undid patch 23.  Added support
  for "proxied finalizers".
  (scm_i_guard): Likewise.

* libguile/smob.c (scm_i_finalize_smob): Adapted to
  `GC_finalization_proc'.

* libguile/smob.h: Include <gc/gc.h>.
  (SCM_NEWSMOB): Use `GC_REGISTER_FINALIZER_NO_ORDER' instead of
  `scm_gc_register_finalizer ()'.
  (SCM_NEWSMOB3): Likewise.
  (scm_i_finalize_smob): Updated.

git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-29

libguile/gc.c

@@ -678,100 +678,8 @@ scm_gc_unregister_roots (SCM *b, unsigned long n)
 int scm_i_terminating;
 
 
-/* Finalizers.  */
-
-static void
-finalizer_trampoline (GC_PTR ptr, GC_PTR data)
-{
-  register SCM obj, finalizers;
-
-  obj = PTR2SCM (ptr);
-  for (finalizers = PTR2SCM (data);
-       scm_is_pair (finalizers);
-       finalizers = SCM_CDR (finalizers))
-    {
-      SCM (* finalize) (SCM, SCM);
-      SCM f = SCM_CAR (finalizers);
-
-      finalize = (SCM (*) (SCM, SCM)) SCM2PTR (SCM_CAR (f));
-      finalize (obj, SCM_CDR (f));
-    }
-}
 
 
-/* Register FINALIZER as a finalization procedure for OBJ.  FINALIZER will be
-   invoked when storage for OBJ is to be reclaimed and will be passed OBJ and
-   DATA.  If ORDERED is non-zero, finalization will be "ordered" (see the
-   Boehm-GC doc for details).  The function returns the data previously
-   registered for OBJ and FINALIZER, or `#f' if FINALIZER had not been
-   registered for OBJ before.
-
-   Note that finalizers in general are known to be problematic.  As such,
-   this function should only be used internally, and only to implement
-   functionalities that could not be implemented otherwise (e.g., guardians,
-   SMOB's free procedures).  */
-SCM
-scm_gc_register_finalizer (SCM obj, SCM (*finalizer) (SCM, SCM),
-			   SCM data, int ordered)
-{
-  SCM prev_data = SCM_BOOL_F;
-  SCM finalization_data, finalization_subr;
-  GC_finalization_proc old_finalizer;
-  GC_PTR old_finalization_data;
-
-  /* XXX: We don't use real `subrs' here because (i) it would add unnecessary
-     overhead and (ii) it creates a bootstrap problem (because SMOBs may rely
-     on this, and SMOBs are initialized before `gsubrs').  */
-  finalization_subr = PTR2SCM (finalizer);
-  finalization_data = scm_cons (scm_cons (finalization_subr, data),
-				SCM_EOL);
-  if (ordered)
-    GC_REGISTER_FINALIZER (SCM2PTR (obj), finalizer_trampoline,
-			   SCM2PTR (finalization_data),
-			   &old_finalizer, &old_finalization_data);
-  else
-    GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (obj), finalizer_trampoline,
-				    SCM2PTR (finalization_data),
-				    &old_finalizer, &old_finalization_data);
-
-  if ((old_finalizer != NULL) && (old_finalizer != finalizer_trampoline))
-    /* Inconsistent use of the mechanism.  */
-    abort ();
-
-  if (old_finalization_data != NULL)
-    {
-      SCM f, prev, old_finalizer_list = PTR2SCM (old_finalization_data);
-
-      if (!scm_is_pair (old_finalizer_list))
-	abort ();
-
-      /* Look for FINALIZER among the previously-installed finalizers.  */
-      for (f = old_finalizer_list, prev = SCM_BOOL_F;
-	   scm_is_pair (f);
-	   prev = f, f = SCM_CDR (f))
-	{
-	  if (SCM_SUBRF (SCM_CAR (f)) == finalizer)
-	    break;
-	}
-
-      if (scm_is_pair (f))
-	{
-	  prev_data = SCM_CDAR (f);
-	  if (prev != SCM_BOOL_F)
-	    SCM_SETCDR (prev, SCM_CDR (f));
-	  else
-	    old_finalizer_list = SCM_CDR (old_finalizer_list);
-	}
-
-      /* Concatenate the new finalizer list with the old one.  */
-      SCM_SETCDR (finalization_data, old_finalizer_list);
-    }
-
-  return prev_data;
-}
-
-
-
 /*
   MOVE THIS FUNCTION. IT DOES NOT HAVE ANYTHING TODO WITH GC.
  */

libguile/gc.h

@@ -235,8 +235,6 @@ SCM_API void *scm_gc_realloc (void *mem, size_t old_size,
 SCM_API void scm_gc_free (void *mem, size_t size, const char *what);
 SCM_API char *scm_gc_strdup (const char *str, const char *what);
 SCM_API char *scm_gc_strndup (const char *str, size_t n, const char *what);
-SCM_API SCM scm_gc_register_finalizer (SCM obj, SCM (*finalizer) (SCM, SCM),
-				       SCM data, int ordered);
 
 SCM_API void scm_remember_upto_here_1 (SCM obj);
 SCM_API void scm_remember_upto_here_2 (SCM obj1, SCM obj2);

libguile/guardians.c

@@ -96,15 +96,19 @@ guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
 
 /* Handle finalization of OBJ which is guarded by the guardians listed in
    GUARDIAN_LIST.  */
-static SCM
+static void
-finalize_guarded (SCM obj, SCM guardian_list)
+finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data)
 {
   SCM cell_pool;
+  SCM obj, guardian_list, proxied_finalizer;
+
+  obj = PTR2SCM (ptr);
+  guardian_list = SCM_CDR (PTR2SCM (finalizer_data));
+  proxied_finalizer = SCM_CAR (PTR2SCM (finalizer_data));
 
 #if 0
   printf ("finalizing guarded %p (%u guardians)\n",
-	  SCM2PTR (obj), scm_to_uint (scm_length (guardian_list)));
+	  ptr, scm_to_uint (scm_length (guardian_list)));
-  scm_write (guardian_list, scm_current_output_port ());
 #endif
 
   /* Preallocate a bunch of cells so that we can make sure that no garbage
@@ -130,7 +134,7 @@ finalize_guarded (SCM obj, SCM guardian_list)
       cell_pool = SCM_CDR (cell_pool);
 
       /* Compute and update G's zombie list.  */
-      SCM_SETCAR (zombies, obj);
+      SCM_SETCAR (zombies, SCM_PACK (obj));
       SCM_SETCDR (zombies, g->zombies);
       g->zombies = zombies;
 
@@ -138,11 +142,30 @@ finalize_guarded (SCM obj, SCM guardian_list)
       g->zombies = zombies;
     }
 
-#if 0
+  if (proxied_finalizer != SCM_BOOL_F)
-  printf ("end of finalize (%p)\n", SCM2PTR (obj));
+    {
-#endif
+      /* Re-register the finalizer that was in place before we installed this
+	 one.  */
+      GC_finalization_proc finalizer, prev_finalizer;
+      GC_PTR finalizer_data, prev_finalizer_data;
 
-  return SCM_UNSPECIFIED;
+      finalizer = (GC_finalization_proc) SCM2PTR (SCM_CAR (proxied_finalizer));
+      finalizer_data = SCM2PTR (SCM_CDR (proxied_finalizer));
+
+      if (finalizer == NULL)
+	abort ();
+
+      GC_REGISTER_FINALIZER_NO_ORDER (ptr, finalizer, finalizer_data,
+				      &prev_finalizer, &prev_finalizer_data);
+
+#if 0
+      printf ("  reinstalled proxied finalizer %p for %p\n", finalizer, ptr);
+#endif
+    }
+
+#if 0
+  printf ("end of finalize (%p)\n", ptr);
+#endif
 }
 
 /* Add OBJ as a guarded object of GUARDIAN.  */
@@ -151,22 +174,60 @@ scm_i_guard (SCM guardian, SCM obj)
 {
   t_guardian *g = GUARDIAN_DATA (guardian);
 
-  if (!SCM_IMP (obj))
+  if (SCM_NIMP (obj))
     {
-      /* Register a finalizer and pass a list of guardians interested in OBJ
+      /* Register a finalizer and pass a pair as the ``client data''
-	 as the ``client data'' argument.  */
+	 argument.  The pair contains in its car `#f' or a pair describing a
-      SCM guardians_for_obj, prev_guardians_for_obj;
+	 ``proxied'' finalizer (see below); its cdr contains a list of
+	 guardians interested in OBJ.
+
+	 A ``proxied'' finalizer is a finalizer that was registered for OBJ
+	 before OBJ became guarded (e.g., a SMOB `free' function).  We are
+	 assuming here that finalizers are only used internally, either at
+	 the very beginning of an object's lifetime (e.g., see `SCM_NEWSMOB')
+	 or by this function.  */
+      GC_finalization_proc prev_finalizer;
+      GC_PTR prev_data;
+      SCM guardians_for_obj, finalizer_data;
 
       g->live++;
       guardians_for_obj = scm_cons (guardian, SCM_EOL);
+      finalizer_data = scm_cons (SCM_BOOL_F, guardians_for_obj);
 
-      prev_guardians_for_obj =
+      GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (obj), finalize_guarded,
-	scm_gc_register_finalizer (obj, finalize_guarded,
+				      SCM2PTR (finalizer_data),
-				   guardians_for_obj, 0);
+				      &prev_finalizer, &prev_data);
 
-      if (scm_is_pair (prev_guardians_for_obj))
+      if (prev_finalizer == finalize_guarded)
-	/* Concatenate the previous list of guardians for OBJ.  */
+	{
-	SCM_SETCDR (guardians_for_obj, prev_guardians_for_obj);
+	  /* OBJ is already guarded by another guardian: add GUARDIAN to its
+	     list of guardians.  */
+	  SCM prev_guardian_list, prev_finalizer_data;
+
+	  if (prev_data == NULL)
+	    abort ();
+
+	  prev_finalizer_data = PTR2SCM (prev_data);
+	  if (!scm_is_pair (prev_finalizer_data))
+	    abort ();
+
+	  prev_guardian_list = SCM_CDR (prev_finalizer_data);
+	  SCM_SETCDR (guardians_for_obj, prev_guardian_list);
+
+	  /* Also copy information about proxied finalizers.  */
+	  SCM_SETCAR (finalizer_data, SCM_CAR (prev_finalizer_data));
+	}
+      else if (prev_finalizer != NULL)
+	{
+	  /* There was already a finalizer registered for OBJ so we will
+	     ``proxy'' it, i.e., record it so that we can re-register it once
+	     `finalize_guarded ()' has finished.  */
+	  SCM proxied_finalizer;
+
+	  proxied_finalizer = scm_cons (PTR2SCM (prev_finalizer),
+					PTR2SCM (prev_data));
+	  SCM_SETCAR (finalizer_data, proxied_finalizer);
+	}
     }
 }
 

libguile/smob.c

@@ -604,16 +604,21 @@ scm_i_new_smob_with_mark_proc (scm_t_bits tc, scm_t_bits data1,
 
 
 /* Finalize SMOB by calling its SMOB type's free function, if any.  */
-SCM
+void
-scm_i_finalize_smob (SCM smob, SCM data)
+scm_i_finalize_smob (GC_PTR ptr, GC_PTR data)
 {
+  SCM smob;
   size_t (* free_smob) (SCM);
 
+  smob = PTR2SCM (ptr);
+#if 0
+  printf ("finalizing SMOB %p (smobnum: %u)\n",
+	  ptr, SCM_SMOBNUM (smob));
+#endif
+
   free_smob = scm_smobs[SCM_SMOBNUM (smob)].free;
   if (free_smob)
     free_smob (smob);
-
-  return SCM_UNSPECIFIED;
 }
 
 

libguile/smob.h

@@ -25,6 +25,9 @@
 #include "libguile/__scm.h"
 #include "libguile/print.h"
 
+#include <gc/gc.h>
+
+
 
 /* This is the internal representation of a smob type */
 
@@ -60,8 +63,15 @@ do									\
 					  0, 0)				  \
 	 : scm_cell (tc, (scm_t_bits)(data)));				  \
     if (scm_smobs[_smobnum].free)					  \
-      scm_gc_register_finalizer ((z), scm_i_finalize_smob,		\
+      {									  \
-				 SCM_BOOL_F, 0);			\
+	GC_finalization_proc _prev_finalizer;				  \
+	GC_PTR _prev_finalizer_data;					  \
+									  \
+	GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (z), scm_i_finalize_smob, \
+					NULL,				  \
+					&_prev_finalizer,		  \
+					&_prev_finalizer_data);		  \
+      }									  \
   }									  \
 while (0)
 
@@ -92,8 +102,15 @@ do									\
 			    (scm_t_bits)(data2),			  \
 			    (scm_t_bits)(data3)));			  \
     if (scm_smobs[_smobnum].free)					  \
-      scm_gc_register_finalizer ((z), scm_i_finalize_smob,		\
+      {									  \
-				 SCM_BOOL_F, 0);			\
+	GC_finalization_proc _prev_finalizer;				  \
+	GC_PTR _prev_finalizer_data;					  \
+									  \
+	GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (z), scm_i_finalize_smob, \
+					NULL,				  \
+					&_prev_finalizer,		  \
+					&_prev_finalizer_data);		  \
+      }									  \
   }									  \
 while (0)
 
@@ -139,7 +156,7 @@ SCM_API long scm_numsmob;
 SCM_API scm_smob_descriptor scm_smobs[];
 
 SCM_API void scm_i_set_smob_flags (SCM x, scm_t_bits data);
-SCM_API SCM scm_i_finalize_smob (SCM smob, SCM data);
+SCM_API void scm_i_finalize_smob (GC_PTR obj, GC_PTR data);