-/* 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.
- * FIXME: This is currently not thread-safe.
+ * Rewritten for the Boehm-Demers-Weiser GC by Ludovic Courtès.
*/
+/* 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/ports.h"
#include "libguile/print.h"
#include "libguile/smob.h"
#include "libguile/eval.h"
#include "libguile/guardians.h"
-#include "libguile/boehm-gc.h"
+#include "libguile/bdw-gc.h"
typedef struct t_guardian
{
+ scm_i_pthread_mutex_t mutex;
unsigned long live;
SCM zombies;
struct t_guardian *next;
} 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 void
-finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data)
+finalize_guarded (void *ptr, void *finalizer_data)
{
SCM cell_pool;
SCM obj, guardian_list, proxied_finalizer;
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
/* 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;
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));
+
+ scm_i_pthread_mutex_lock (&g->mutex);
+
if (g->live == 0)
abort ();
cell_pool = SCM_CDR (cell_pool);
/* Compute and update G's zombie list. */
- SCM_SETCAR (zombies, SCM_PACK (obj));
+ SCM_SETCAR (zombies, obj);
SCM_SETCDR (zombies, g->zombies);
g->zombies = zombies;
g->live--;
- g->zombies = zombies;
+
+ scm_i_pthread_mutex_unlock (&g->mutex);
}
- if (proxied_finalizer != SCM_BOOL_F)
+ 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;
- GC_PTR finalizer_data, prev_finalizer_data;
+ void *finalizer_data, *prev_finalizer_data;
finalizer = (GC_finalization_proc) SCM2PTR (SCM_CAR (proxied_finalizer));
finalizer_data = SCM2PTR (SCM_CDR (proxied_finalizer));
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
}
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;
+ void *prev_data;
SCM guardians_for_obj, finalizer_data;
+ scm_i_pthread_mutex_lock (&g->mutex);
+
g->live++;
/* Note: GUARDIANS_FOR_OBJ is a weak list so that a guardian can be
PTR2SCM (prev_data));
SCM_SETCAR (finalizer_data, proxied_finalizer);
}
+
+ scm_i_pthread_mutex_unlock (&g->mutex);
}
}
t_guardian *g = GUARDIAN_DATA (guardian);
SCM res = SCM_BOOL_F;
- if (g->zombies != SCM_EOL)
+ scm_i_pthread_mutex_lock (&g->mutex);
+
+ if (!scm_is_null (g->zombies))
{
/* Note: We return zombies in reverse order. */
res = SCM_CAR (g->zombies);
g->zombies = SCM_CDR (g->zombies);
}
+ scm_i_pthread_mutex_unlock (&g->mutex);
+
return res;
}
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);
t_guardian *g = scm_gc_malloc (sizeof (t_guardian), "guardian");
SCM z;
+ scm_i_pthread_mutex_init (&g->mutex, NULL);
+
/* A tconc starts out with one tail pair. */
g->live = 0;
g->zombies = SCM_EOL;
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