mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

Generalized BGC's finalizer mechanism. Use it in `guardians.c'.

Browse source 
* libguile/gc.c (finalizer_trampoline): New.
  (scm_gc_register_finalizer): New.

* libguile/gc.h (scm_gc_register_finalizer): New declaration.

* libguile/guardians.c (finalize_guarded): Updated to the new prototype.
  (scm_i_guard): Use `scm_gc_register_finalizer ()' instead of
  `GC_REGISTER_FINALIZER_NO_ORDER ()'.

git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-23
This commit is contained in:
Ludovic Courtes 2006-05-23 21:59:00 +00:00 • committed by Ludovic Courtès
parent 378f262561
commit febd2677c9
3 changed files with 104 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

88
libguile/gc.c
View file

@ -678,8 +678,96 @@ 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 f = SCM_CAR (finalizers);
scm_call_2 (SCM_CAR (f), 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;
finalization_subr = scm_c_make_gsubr ("%%finalizer", 2, 0, 0,
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,6 +235,8 @@ 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);

36
libguile/guardians.c
View file

@ -96,14 +96,14 @@ 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 void
finalize_guarded (GC_PTR obj, GC_PTR guardian_list)
static SCM
finalize_guarded (SCM obj, SCM guardian_list)
{
SCM cell_pool;
#if 0
printf ("finalizing guarded %p (%u guardians)\n",
obj, scm_to_uint (scm_length (guardian_list)));
SCM2PTR (obj), scm_to_uint (scm_length (guardian_list)));
scm_write (guardian_list, scm_current_output_port ());
#endif
@ -130,7 +130,7 @@ finalize_guarded (GC_PTR obj, GC_PTR guardian_list)
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;
@ -139,8 +139,10 @@ finalize_guarded (GC_PTR obj, GC_PTR guardian_list)
}
#if 0
printf ("end of finalize (%p)\n", obj);
printf ("end of finalize (%p)\n", SCM2PTR (obj));
#endif
return SCM_UNSPECIFIED;
}
/* Add OBJ as a guarded object of GUARDIAN. */
@ -153,28 +155,18 @@ scm_i_guard (SCM guardian, SCM obj)
{
/* Register a finalizer and pass a list of guardians interested in OBJ
as the ``client data'' argument. */
GC_finalization_proc prev_finalizer;
GC_PTR prev_data;
SCM guardians_for_obj;
SCM guardians_for_obj, prev_guardians_for_obj;
g->live++;
guardians_for_obj = scm_cons (guardian, SCM_EOL);
GC_REGISTER_FINALIZER_NO_ORDER ((GC_PTR)obj, finalize_guarded,
(GC_PTR)guardians_for_obj,
&prev_finalizer, &prev_data);
prev_guardians_for_obj =
scm_gc_register_finalizer (obj, finalize_guarded,
guardians_for_obj, 0);
if ((prev_finalizer == finalize_guarded) && (prev_data != NULL))
{
/* OBJ is already guarded by another guardian: add GUARDIAN to its
list of guardians. */
SCM prev_guardian_list = SCM_PACK (prev_data);
if (!scm_is_pair (prev_guardian_list))
abort ();
SCM_SETCDR (guardians_for_obj, prev_guardian_list);
}
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);
}
}