From 8ecca2f09f6bc387412f258c4fc4e3ddf807b2b3 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 23 Jul 2020 13:48:43 +0200 Subject: [PATCH] Backport: Fix memory leak for global module objects (Bug#42482). Instead of storing the global values in a global 'emacs_value_storage' object, store them as hash values alongside the reference counts. That way the garbage collector takes care of cleaning them up. * src/emacs-module.c (global_storage): Remove. (struct module_global_reference): New pseudovector type. (XMODULE_GLOBAL_REFERENCE): New helper function. (module_make_global_ref, module_free_global_ref): Use 'module_global_reference' struct for global reference values. (value_to_lisp, module_handle_nonlocal_exit): Adapt to deletion of 'global_storage'. (cherry picked from commit 5c5eb9790898e4ab10bcbbdb6871947ed3018569) --- src/emacs-module.c | 82 ++++++++++++++++++++++++++++++---------------- 1 file changed, 54 insertions(+), 28 deletions(-) diff --git a/src/emacs-module.c b/src/emacs-module.c index 911b82b8a1a..4269b0ba2ac 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -159,11 +159,11 @@ struct emacs_value_frame /* A structure that holds an initial frame (so that the first local values require no dynamic allocation) and keeps track of the current frame. */ -static struct emacs_value_storage +struct emacs_value_storage { struct emacs_value_frame initial; struct emacs_value_frame *current; -} global_storage; +}; /* Private runtime and environment members. */ @@ -351,10 +351,35 @@ module_get_environment (struct emacs_runtime *ert) } /* To make global refs (GC-protected global values) keep a hash that - maps global Lisp objects to reference counts. */ + maps global Lisp objects to 'struct module_global_reference' + objects. We store the 'emacs_value' in the hash table so that it + is automatically garbage-collected (Bug#42482). */ static Lisp_Object Vmodule_refs_hash; +/* Pseudovector type for global references. The pseudovector tag is + PVEC_OTHER since these values are never printed and don't need to + be special-cased for garbage collection. */ + +struct module_global_reference { + /* Pseudovector header, must come first. */ + union vectorlike_header header; + + /* Holds the emacs_value for the object. The Lisp_Object stored + therein must be the same as the hash key. */ + struct emacs_value_tag value; + + /* Reference count, always positive. */ + ptrdiff_t refcount; +}; + +static struct module_global_reference * +XMODULE_GLOBAL_REFERENCE (Lisp_Object o) +{ + eassert (PSEUDOVECTORP (o, PVEC_OTHER)); + return XUNTAG (o, Lisp_Vectorlike, struct module_global_reference); +} + static emacs_value module_make_global_ref (emacs_env *env, emacs_value ref) { @@ -363,21 +388,30 @@ module_make_global_ref (emacs_env *env, emacs_value ref) Lisp_Object new_obj = value_to_lisp (ref), hashcode; ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); + /* Note: This approach requires the garbage collector to never move + objects. */ + if (i >= 0) { Lisp_Object value = HASH_VALUE (h, i); - EMACS_INT refcount = XFIXNAT (value) + 1; - if (MOST_POSITIVE_FIXNUM < refcount) + struct module_global_reference *ref = XMODULE_GLOBAL_REFERENCE (value); + bool overflow = INT_ADD_WRAPV (ref->refcount, 1, &ref->refcount); + if (overflow) overflow_error (); - value = make_fixed_natnum (refcount); - set_hash_value_slot (h, i, value); + return &ref->value; } else { - hash_put (h, new_obj, make_fixed_natnum (1), hashcode); + struct module_global_reference *ref + = ALLOCATE_PLAIN_PSEUDOVECTOR (struct module_global_reference, + PVEC_OTHER); + ref->value.v = new_obj; + ref->refcount = 1; + Lisp_Object value; + XSETPSEUDOVECTOR (value, ref, PVEC_OTHER); + hash_put (h, new_obj, value, hashcode); + return &ref->value; } - - return allocate_emacs_value (env, &global_storage, new_obj); } static void @@ -393,23 +427,16 @@ module_free_global_ref (emacs_env *env, emacs_value ref) if (i >= 0) { - EMACS_INT refcount = XFIXNAT (HASH_VALUE (h, i)) - 1; - if (refcount > 0) - set_hash_value_slot (h, i, make_fixed_natnum (refcount)); - else - { - eassert (refcount == 0); - hash_remove_from_table (h, obj); - } + Lisp_Object value = HASH_VALUE (h, i); + struct module_global_reference *ref = XMODULE_GLOBAL_REFERENCE (value); + eassert (0 < ref->refcount); + if (--ref->refcount == 0) + hash_remove_from_table (h, obj); } - - if (module_assertions) + else if (module_assertions) { - ptrdiff_t count = 0; - if (value_storage_contains_p (&global_storage, ref, &count)) - return; module_abort ("Global value was not found in list of %"pD"d globals", - count); + h->count); } } @@ -1190,8 +1217,10 @@ value_to_lisp (emacs_value v) ++num_environments; } /* Also check global values. */ - if (value_storage_contains_p (&global_storage, v, &num_values)) + struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); + if (hash_lookup (h, v->v, NULL) != -1) goto ok; + INT_ADD_WRAPV (num_values, h->count, &num_values); module_abort (("Emacs value not found in %"pD"d values " "of %"pD"d environments"), num_values, num_environments); @@ -1404,10 +1433,7 @@ module_handle_nonlocal_exit (emacs_env *env, enum nonlocal_exit type, void init_module_assertions (bool enable) { - /* If enabling module assertions, use a hidden environment for - storing the globals. This environment is never freed. */ module_assertions = enable; - initialize_storage (&global_storage); } /* Return whether STORAGE contains VALUE. Used to check module -- 2.39.2