Implementation for the R6RS (rnrs sorting) library.

[bpt/guile.git] / libguile / guardians.c

diff --git a/libguile/guardians.c b/libguile/guardians.c
index 879462a..a341fbf 100644 (file)
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 \f
@@ -37,10 +38,16 @@
  * Scheme guardians should be simple and friendly, not like the greedy
  * monsters we had...
  *
- * Rewritten for the Boehm-Wiser GC by Ludovic Courtès.
+ * Rewritten for the Boehm-Demers-Weiser GC by Ludovic Courtès.
  * FIXME: This is currently not thread-safe.
  */
 
+/* Uncomment the following line to debug guardian finalization.  */
+/* #define DEBUG_GUARDIANS 1 */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
 
 #include "libguile/_scm.h"
 #include "libguile/async.h"
@@ -55,7 +62,7 @@
 #include "libguile/eval.h"
 
 #include "libguile/guardians.h"
-#include "libguile/boehm-gc.h"
+#include "libguile/bdw-gc.h"
 
 
 
@@ -70,7 +77,7 @@ typedef struct t_guardian
 } t_guardian;
 
 #define GUARDIAN_P(x)    SCM_SMOB_PREDICATE(tc16_guardian, x)
-#define GUARDIAN_DATA(x) ((t_guardian *) SCM_CELL_WORD_1 (x))
+#define GUARDIAN_DATA(x) ((t_guardian *) SCM_SMOB_DATA_1 (x))
 
 
 
@@ -106,7 +113,7 @@ finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data)
   guardian_list = SCM_CDR (PTR2SCM (finalizer_data));
   proxied_finalizer = SCM_CAR (PTR2SCM (finalizer_data));
 
-#if 0
+#ifdef DEBUG_GUARDIANS
   printf ("finalizing guarded %p (%u guardians)\n",
          ptr, scm_to_uint (scm_length (guardian_list)));
 #endif
@@ -127,8 +134,13 @@ finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data)
       t_guardian *g;
 
       if (SCM_WEAK_PAIR_CAR_DELETED_P (guardian_list))
-       /* The guardian itself vanished in the meantime.  */
-       continue;
+       {
+         /* The guardian itself vanished in the meantime.  */
+#ifdef DEBUG_GUARDIANS
+         printf ("  guardian for %p vanished\n", ptr);
+#endif
+         continue;
+       }
 
       g = GUARDIAN_DATA (SCM_CAR (guardian_list));
       if (g->live == 0)
@@ -163,12 +175,12 @@ finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data)
       GC_REGISTER_FINALIZER_NO_ORDER (ptr, finalizer, finalizer_data,
                                      &prev_finalizer, &prev_finalizer_data);
 
-#if 0
+#ifdef DEBUG_GUARDIANS
       printf ("  reinstalled proxied finalizer %p for %p\n", finalizer, ptr);
 #endif
     }
 
-#if 0
+#ifdef DEBUG_GUARDIANS
   printf ("end of finalize (%p)\n", ptr);
 #endif
 }
@@ -267,13 +279,6 @@ scm_i_get_one_zombie (SCM guardian)
 static SCM
 guardian_apply (SCM guardian, SCM obj, SCM throw_p)
 {
-#if ENABLE_DEPRECATED
-  if (!SCM_UNBNDP (throw_p))
-    scm_c_issue_deprecation_warning
-      ("Using the 'throw?' argument of a guardian is deprecated "
-       "and ineffective.");
-#endif
-
   if (!SCM_UNBNDP (obj))
     {
       scm_i_guard (guardian, obj);
@@ -350,11 +355,7 @@ scm_init_guardians ()
   tc16_guardian = scm_make_smob_type ("guardian", 0);
 
   scm_set_smob_print (tc16_guardian, guardian_print);
-#if ENABLE_DEPRECATED
-  scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 2, 0);
-#else
   scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 1, 0);
-#endif
 
 #include "libguile/guardians.x"
 }