mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

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

Browse source 
* 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
This commit is contained in:
Ludovic Courtes 2006-05-26 13:50:21 +00:00 • committed by Ludovic Courtès
parent a4a141f679
commit 10fb3386dd
5 changed files with 134 additions and 145 deletions
Download patch file Download diff file Expand all files Collapse all files

92
libguile/gc.c
View file

@ -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.
*/

2
libguile/gc.h
View file

@ -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);

99
libguile/guardians.c
View file

@ -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
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
@ -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
printf ("end of finalize (%p)\n", SCM2PTR (obj));
#endif
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;
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
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);
finalizer_data = scm_cons (SCM_BOOL_F, guardians_for_obj);
prev_guardians_for_obj =
scm_gc_register_finalizer (obj, finalize_guarded,
guardians_for_obj, 0);
GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (obj), finalize_guarded,
SCM2PTR (finalizer_data),
&prev_finalizer, &prev_data);
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);
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);
}
}
}

13
libguile/smob.c
View file

@ -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
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;
}

73
libguile/smob.h
View file

@ -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 */
@ -51,18 +54,25 @@ SCM_API SCM scm_i_new_smob_with_mark_proc (scm_t_bits tc,
#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) \
@ -80,21 +90,28 @@ while (0)
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) \
@ -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);