Commit 0aa627e3 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

Merge branch 'finalizer-cycles' into 'develop'

gc: call finalizer for builtin object only when the object is truly unreachable

See merge request embeddable-common-lisp/ecl!252
parents 76f700a8 06389326
......@@ -1135,6 +1135,7 @@ standard_finalizer(cl_object o)
case t_symbol: {
ecl_atomic_push(&cl_core.reused_indices,
ecl_make_fixnum(o->symbol.binding));
o->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
}
#endif /* ECL_THREADS */
default:;
......@@ -1144,13 +1145,63 @@ standard_finalizer(cl_object o)
static void
wrapped_finalizer(cl_object o, cl_object finalizer);
static void
register_finalizer(cl_object o, void *finalized_object,
GC_finalization_proc fn, void *cd,
GC_finalization_proc *ofn, void **ocd)
{
/* Finalizers for some builtin objects are only run when the object is not
* reachable by any means, including through other finalizers which might
* make the object reachable again. The objects must not contain any cyclic
* references for which finalizers are registered.
*
* We don't use this type of finalizer for user-defined finalizers, because
* those might contain cyclic references which would prevent the objects
* from being garbage collected. It is instead the duty of the user to write
* the finalizers in a consistent way.
*
* case t_symbol: is not finalized with the "unreachable" finalizer because
* it might contain cyclic references; Also running the finalizer too early
* doesn't lead to any problems, we will simply choose a new binding index
* the next time a binding is established. */
switch (o->d.t) {
#ifdef ENABLE_DLOPEN
case t_codeblock:
#endif
case t_stream:
#if defined(ECL_THREADS) && defined(ECL_RWLOCK)
case t_rwlock:
#endif
/* Don't delete the standard finalizer. */
if (fn == NULL) {
fn = (GC_finalization_proc)wrapped_finalizer;
cd = ECL_T;
}
GC_REGISTER_FINALIZER_UNREACHABLE(finalized_object, fn, cd, ofn, ocd);
break;
case t_weak_pointer:
#if defined(ECL_THREADS)
case t_symbol:
#endif
/* Don't delete the standard finalizer. */
if (fn == NULL) {
fn = (GC_finalization_proc)wrapped_finalizer;
cd = ECL_T;
}
/* fallthrough */
default:
GC_REGISTER_FINALIZER_NO_ORDER(finalized_object, fn, cd, ofn, ocd);
break;
}
}
static void
deferred_finalizer(cl_object* x)
{
wrapped_finalizer(x[0], x[1]);
}
void
static void
wrapped_finalizer(cl_object o, cl_object finalizer)
{
if (finalizer != ECL_NIL && finalizer != NULL) {
......@@ -1178,9 +1229,10 @@ wrapped_finalizer(cl_object o, cl_object finalizer)
cl_object* wrapper = GC_MALLOC(2*sizeof(cl_object));
wrapper[0] = o;
wrapper[1] = finalizer;
GC_REGISTER_FINALIZER_NO_ORDER(wrapper,
(GC_finalization_proc)deferred_finalizer, 0,
&ofn, &odata);
register_finalizer(o, wrapper,
(GC_finalization_proc)deferred_finalizer, 0,
&ofn, &odata);
return;
}
#endif /* ECL_THREADS */
......@@ -1201,7 +1253,7 @@ si_get_finalizer(cl_object o)
GC_finalization_proc ofn;
void *odata;
ecl_disable_interrupts_env(the_env);
GC_REGISTER_FINALIZER_NO_ORDER(o, (GC_finalization_proc)0, 0, &ofn, &odata);
register_finalizer(o, o, (GC_finalization_proc)0, 0, &ofn, &odata);
if (ofn == 0) {
output = ECL_NIL;
} else if (ofn == (GC_finalization_proc)wrapped_finalizer) {
......@@ -1209,7 +1261,7 @@ si_get_finalizer(cl_object o)
} else {
output = ECL_NIL;
}
GC_REGISTER_FINALIZER_NO_ORDER(o, ofn, odata, &ofn, &odata);
register_finalizer(o, o, ofn, odata, &ofn, &odata);
ecl_enable_interrupts_env(the_env);
@(return output);
}
......@@ -1220,13 +1272,11 @@ ecl_set_finalizer_unprotected(cl_object o, cl_object finalizer)
GC_finalization_proc ofn;
void *odata;
if (finalizer == ECL_NIL) {
GC_REGISTER_FINALIZER_NO_ORDER(o, (GC_finalization_proc)0,
0, &ofn, &odata);
register_finalizer(o, o, (GC_finalization_proc)0, 0, &ofn, &odata);
} else {
GC_finalization_proc newfn;
newfn = (GC_finalization_proc)wrapped_finalizer;
GC_REGISTER_FINALIZER_NO_ORDER(o, newfn, finalizer,
&ofn, &odata);
register_finalizer(o, o, newfn, finalizer, &ofn, &odata);
}
}
......
......@@ -2069,7 +2069,6 @@ cl_symbols[] = {
#endif
{SYS_ "RUN-PROGRAM-INNER" ECL_FUN("si_run_program_inner", si_run_program_inner, 4) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "SPAWN-SUBPROCESS" ECL_FUN("si_spawn_subprocess", si_spawn_subprocess, 6) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "CLOSE-WINDOWS-HANDLE" ECL_FUN("si_close_windows_handle", IF_WINDOWS(si_close_windows_handle), 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
/* ~ */
{EXT_ "*INVOKE-DEBUGGER-HOOK*" ECL_FUN(NULL, NULL, -1) ECL_VAR(EXT_SPECIAL, ECL_NIL)},
......
......@@ -214,15 +214,6 @@ si_killpid(cl_object pid, cl_object signal) {
#endif
#if defined(ECL_MS_WINDOWS_HOST)
cl_object
si_close_windows_handle(cl_object h)
{
if (ecl_t_of(h) == t_foreign) {
HANDLE *ph = (HANDLE*)h->foreign.data;
if (ph) CloseHandle(*ph);
}
}
static cl_object
make_windows_handle(HANDLE h)
{
......@@ -230,7 +221,6 @@ make_windows_handle(HANDLE h)
sizeof(HANDLE*));
HANDLE *ph = (HANDLE*)foreign->foreign.data;
*ph = h;
si_set_finalizer(foreign, @'si::close-windows-handle');
return foreign;
}
#endif
......
......@@ -1954,7 +1954,6 @@ extern ECL_API void ecl_check_pending_interrupts(cl_env_ptr env);
extern ECL_API cl_object si_system(cl_object cmd);
extern ECL_API cl_object si_make_pipe();
extern ECL_API cl_object si_run_program _ECL_ARGS((cl_narg narg, cl_object command, cl_object args, ...));
extern ECL_API cl_object si_close_windows_handle(cl_object h);
extern ECL_API cl_object si_terminate_process _ECL_ARGS((cl_narg narg, cl_object process, ...));
extern ECL_API cl_object si_waitpid(cl_object pid, cl_object wait);
extern ECL_API cl_object si_killpid(cl_object pid, cl_object signal);
......
......@@ -98,6 +98,9 @@
;;; We don't handle `sigchld' because we don't want races with
;;; `external-process-wait'. Take care of forgotten processes.
(defun finalize-external-process (process)
;; INV: this finalizer also closes the process handle on windows
;; since external-process-wait calls si:waitpid which closes the
;; handle once the process has exited.
(unless (member (ext:external-process-wait process nil)
'(:exited :signaled :abort :error))
(ext:set-finalizer process #'finalize-external-process)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment