Do not install a subr trampoline twice

* src/comp.c (syms_of_comp): Define and initialize
	'Vcomp_installed_trampolines_h'.
	(Fcomp__install_trampoline): Fill 'Vcomp_installed_trampolines_h'
	* lisp/emacs-lisp/comp.el (comp--subr-safe-advice): Make use of
	`comp-installed-trampolines-h' to guard against installing a
	trampoline twice.
This commit is contained in:
Andrea Corallo 2020-09-23 21:56:52 +02:00
parent b94a0a931e
commit 94736c413f
2 changed files with 7 additions and 1 deletions

View file

@ -2601,7 +2601,8 @@ Return the its filename if found or nil otherwise."
;;;###autoload
(defun comp--subr-safe-advice (subr-name)
"Make SUBR-NAME effectively advice-able when called from native code."
(unless (memq subr-name comp-never-optimize-functions)
(unless (or (memq subr-name comp-never-optimize-functions)
(gethash subr-name comp-installed-trampolines-h))
(let ((trampoline-sym (comp-trampoline-sym subr-name)))
(cl-assert (subr-primitive-p (symbol-function subr-name)))
(load (or (comp-search-trampoline subr-name)

View file

@ -4126,6 +4126,7 @@ DEFUN ("comp--install-trampoline", Fcomp__install_trampoline,
if (EQ (subr, orig_subr))
{
freloc.link_table[i] = XSUBR (trampoline)->function.a0;
Fputhash (subr_name, Qt, Vcomp_installed_trampolines_h);
return Qt;
}
i++;
@ -5257,6 +5258,10 @@ The last directory of this list is assumed to be the system one. */);
dump reload. */
Vcomp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
DEFVAR_LISP ("comp-installed-trampolines-h", Vcomp_installed_trampolines_h,
doc: /* Hash table subr-name -> bool. */);
Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table);
#endif /* #ifdef HAVE_NATIVE_COMP */
defsubr (&Snative_comp_available_p);