* 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
int scm_i_terminating;
\f
-/* 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;
-}
-
-
-\f
/*
MOVE THIS FUNCTION. IT DOES NOT HAVE ANYTHING TODO WITH GC.
*/
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);
/* 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 (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)));
- 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
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;
g->zombies = zombies;
}
+ if (proxied_finalizer != SCM_BOOL_F)
+ {
+ /* 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;
+
+ 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 ("end of finalize (%p)\n", SCM2PTR (obj));
+ printf (" reinstalled proxied finalizer %p for %p\n", finalizer, ptr);
#endif
+ }
- return SCM_UNSPECIFIED;
+#if 0
+ 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;
+ GC_PTR 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);
+ 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);
+ }
}
}
\f
/* Finalize SMOB by calling its SMOB type's free function, if any. */
-SCM
-scm_i_finalize_smob (SCM smob, SCM data)
+void
+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;
}
\f
#include "libguile/__scm.h"
#include "libguile/print.h"
+#include <gc/gc.h>
+
+
\f
/* This is the internal representation of a smob type */
-#define SCM_NEWSMOB(z, tc, data) \
-do \
- { \
- register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc); \
- z = (scm_smobs[_smobnum].mark \
- ? scm_i_new_smob_with_mark_proc ((tc), (scm_t_bits)(data), \
- 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); \
- } \
+#define SCM_NEWSMOB(z, tc, data) \
+do \
+ { \
+ register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc); \
+ z = (scm_smobs[_smobnum].mark \
+ ? scm_i_new_smob_with_mark_proc ((tc), (scm_t_bits)(data), \
+ 0, 0) \
+ : scm_cell (tc, (scm_t_bits)(data))); \
+ if (scm_smobs[_smobnum].free) \
+ { \
+ 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)
#define SCM_RETURN_NEWSMOB(tc, data) \
return __SCM_smob_answer; \
} while (0)
-#define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
-do \
- { \
- register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc); \
- z = (scm_smobs[_smobnum].mark \
- ? scm_i_new_smob_with_mark_proc (tc, (scm_t_bits)(data1), \
- (scm_t_bits)(data2), \
- (scm_t_bits)(data3)) \
- : scm_double_cell ((tc), (scm_t_bits)(data1), \
- (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); \
- } \
+#define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
+do \
+ { \
+ register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc); \
+ z = (scm_smobs[_smobnum].mark \
+ ? scm_i_new_smob_with_mark_proc (tc, (scm_t_bits)(data1), \
+ (scm_t_bits)(data2), \
+ (scm_t_bits)(data3)) \
+ : scm_double_cell ((tc), (scm_t_bits)(data1), \
+ (scm_t_bits)(data2), \
+ (scm_t_bits)(data3))); \
+ if (scm_smobs[_smobnum].free) \
+ { \
+ 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)
#define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \
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);
\f
HCoop / bpt / guile.git / commitdiff