feature/native-comp 94736c4 09/11: Do not install a subr trampoline twice

[Andrea Corallo]

branch: feature/native-comp
commit 94736c413ff728833f260acf125ff3a572e270d6
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    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.
---
 lisp/emacs-lisp/comp.el | 3 ++-
 src/comp.c              | 5 +++++
 2 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index e33d58c..8b8b111 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -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)
diff --git a/src/comp.c b/src/comp.c
index db6aee9..15782cc 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -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);