-/* Copyright (C) 1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1998,1999,2000,2001, 2006, 2008, 2009, 2011,
+ * 2012, 2013 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
* 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"
#include "libguile/eval.h"
#include "libguile/guardians.h"
-#include <gc/gc.h>
+#include "libguile/bdw-gc.h"
} 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))
/* Handle finalization of OBJ which is guarded by the guardians listed in
GUARDIAN_LIST. */
-static SCM
-finalize_guarded (SCM obj, SCM guardian_list)
+static void
+finalize_guarded (void *ptr, void *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
+#ifdef DEBUG_GUARDIANS
printf ("finalizing guarded %p (%u guardians)\n",
- SCM2PTR (obj), scm_to_uint (scm_length (guardian_list)));
- scm_write (guardian_list, scm_current_output_port ());
+ ptr, scm_to_uint (scm_length (guardian_list)));
#endif
/* Preallocate a bunch of cells so that we can make sure that no garbage
/* Tell each guardian interested in OBJ that OBJ is no longer
reachable. */
for (;
- guardian_list != SCM_EOL;
+ !scm_is_null (guardian_list);
guardian_list = SCM_CDR (guardian_list))
{
SCM zombies;
- t_guardian *g = GUARDIAN_DATA (SCM_CAR (guardian_list));
+ t_guardian *g;
+ if (SCM_WEAK_PAIR_CAR_DELETED_P (guardian_list))
+ {
+ /* 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)
abort ();
g->zombies = zombies;
}
-#if 0
- printf ("end of finalize (%p)\n", SCM2PTR (obj));
+ if (scm_is_true (proxied_finalizer))
+ {
+ /* Re-register the finalizer that was in place before we installed this
+ one. */
+ GC_finalization_proc finalizer, prev_finalizer;
+ void *finalizer_data, *prev_finalizer_data;
+
+ 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);
+
+#ifdef DEBUG_GUARDIANS
+ printf (" reinstalled proxied finalizer %p for %p\n", finalizer, ptr);
#endif
+ }
- return SCM_UNSPECIFIED;
+#ifdef DEBUG_GUARDIANS
+ printf ("end of finalize (%p)\n", ptr);
+#endif
}
/* Add OBJ as a guarded object of GUARDIAN. */
{
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
- as the ``client data'' argument. */
- SCM guardians_for_obj, prev_guardians_for_obj;
+ /* Register a finalizer and pass a pair as the ``client data''
+ argument. The pair contains in its car `#f' or a pair describing a
+ ``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;
+ void *prev_data;
+ SCM guardians_for_obj, finalizer_data;
g->live++;
- guardians_for_obj = scm_cons (guardian, SCM_EOL);
-
- prev_guardians_for_obj =
- scm_gc_register_finalizer (obj, finalize_guarded,
- guardians_for_obj, 0);
- if (scm_is_pair (prev_guardians_for_obj))
- /* Concatenate the previous list of guardians for OBJ. */
- SCM_SETCDR (guardians_for_obj, prev_guardians_for_obj);
+ /* Note: GUARDIANS_FOR_OBJ is a weak list so that a guardian can be
+ collected before the objects it guards (see `guardians.test'). */
+ guardians_for_obj = scm_weak_car_pair (guardian, SCM_EOL);
+ finalizer_data = scm_cons (SCM_BOOL_F, guardians_for_obj);
+
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (obj), finalize_guarded,
+ SCM2PTR (finalizer_data),
+ &prev_finalizer, &prev_data);
+
+ if (prev_finalizer == finalize_guarded)
+ {
+ /* 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);
+ }
}
}
t_guardian *g = GUARDIAN_DATA (guardian);
SCM res = SCM_BOOL_F;
- if (g->zombies != SCM_EOL)
+ if (!scm_is_null (g->zombies))
{
/* Note: We return zombies in reverse order. */
res = SCM_CAR (g->zombies);
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);
scm_init_guardians ()
{
/* We use unordered finalization `a la Java. */
+#ifdef HAVE_GC_SET_JAVA_FINALIZATION
+ /* This function was added in 7.2alpha2 (June 2009). */
+ GC_set_java_finalization (1);
+#else
+ /* This symbol is deprecated as of 7.3. */
GC_java_finalization = 1;
+#endif
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"
}
HCoop / bpt / guile.git / blobdiff