Use form native compilation in `comp-trampoline-compile'

* lisp/emacs-lisp/comp.el (comp-trampoline-sym): Remove function.
	(comp-trampoline-filename): As we are introducing an ABI change in
	the eln trampoline format change the trampoline filename to
	disambiguate.
	(comp-trampoline-search): Rename from `comp-search-trampoline'
	and return directly the trampoline.
	(comp-trampoline-compile): Rework to use native form compilation
	in place of un-evaluating a function and return directly the
	trampoline.
	(comp-subr-trampoline-install): Update for
	`comp-trampoline-search' and `comp-trampoline-compile' new
	interfaces.
	* src/comp.c (Fcomp__install_trampoline): Store the trampoline
	itself as value in `comp-installed-trampolines-h'.
	(syms_of_comp): Doc update `comp-installed-trampolines-h'.

lisp/emacs-lisp/comp.el

@@ -2598,13 +2598,9 @@ Prepare every function for final compilation and drive the C back-end."
 
 ;; Primitive funciton advice machinery
 
-(defsubst comp-trampoline-sym (subr-name)
-  "Given SUBR-NAME return the trampoline function name."
-  (intern (concat "--subr-trampoline-" (symbol-name subr-name))))
-
 (defsubst comp-trampoline-filename (subr-name)
   "Given SUBR-NAME return the filename containing the trampoline."
-  (concat (comp-c-func-name subr-name "subr-trampoline-" t) ".eln"))
+  (concat (comp-c-func-name subr-name "subr--trampoline-" t) ".eln"))
 
 (defun comp-make-lambda-list-from-subr (subr)
   "Given SUBR return the equivalent lambda-list."
@@ -2621,39 +2617,38 @@ Prepare every function for final compilation and drive the C back-end."
       (push (gensym "arg") lambda-list))
     (reverse lambda-list)))
 
-(defun comp-search-trampoline (subr-name)
+(defun comp-trampoline-search (subr-name)
   "Search a trampoline file for SUBR-NAME.
-Return the its filename if found or nil otherwise."
+Return the trampoline if found or nil otherwise."
   (cl-loop
    with rel-filename = (comp-trampoline-filename subr-name)
    for dir in comp-eln-load-path
    for filename = (expand-file-name rel-filename
                                     (concat dir comp-native-version-dir))
    when (file-exists-p filename)
-     do (cl-return filename)))
+     do (cl-return (native-elisp-load filename))))
 
 (defun comp-trampoline-compile (subr-name)
-  "Synthesize and compile a trampoline for SUBR-NAME and return its filename."
+  "Synthesize compile and return a trampoline for SUBR-NAME."
-  (let ((trampoline-sym (comp-trampoline-sym subr-name))
+  (let* ((lambda-list (comp-make-lambda-list-from-subr
-        (lambda-list (comp-make-lambda-list-from-subr
+                       (symbol-function subr-name)))
-                      (symbol-function subr-name)))
+         ;; The synthesized trampoline must expose the exact same ABI of
-        ;; Use speed 0 to maximize compilation speed and not to
+         ;; the primitive we are replacing in the function reloc table.
-        ;; optimize away funcall calls!
+         (form `(lambda ,lambda-list
-        (byte-optimize nil)
+                  (let ((f #',subr-name))
-        (comp-speed 0))
+                    (,(if (memq '&rest lambda-list) #'apply 'funcall)
-    ;; The synthesized trampoline must expose the exact same ABI of
+                     f
-    ;; the primitive we are replacing in the function reloc table.
+                     ,@(cl-loop
-    (defalias trampoline-sym
+                        for arg in lambda-list
-      `(closure nil ,lambda-list
+                        unless (memq arg '(&optional &rest))
-                (let ((f #',subr-name))
+                        collect arg)))))
-                  (,(if (memq '&rest lambda-list) #'apply 'funcall)
+         ;; Use speed 0 to maximize compilation speed and not to
-                   f
+         ;; optimize away funcall calls!
-                   ,@(cl-loop
+         (byte-optimize nil)
-                      for arg in lambda-list
+         (comp-speed 0)
-                      unless (memq arg '(&optional &rest))
+         (lexical-binding t))
-                      collect arg)))))
     (native-compile
-     trampoline-sym nil
+     form nil
      (cl-loop
       for load-dir in comp-eln-load-path
       for dir = (concat load-dir comp-native-version-dir)
@@ -2674,14 +2669,13 @@ Return the its filename if found or nil otherwise."
   "Make SUBR-NAME effectively advice-able when called from native code."
   (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)))
-      (cl-assert (subr-primitive-p (symbol-function subr-name)))
+    (comp--install-trampoline
-      (load (or (comp-search-trampoline subr-name)
+     subr-name
-                (comp-trampoline-compile subr-name))
+     (or (comp-trampoline-search subr-name)
-            nil t)
+         (comp-trampoline-compile subr-name)
-      (cl-assert
+         ;; Should never happen.
-       (subr-native-elisp-p (symbol-function trampoline-sym)))
+         (cl-assert nil)))))
-      (comp--install-trampoline subr-name (symbol-function trampoline-sym)))))
 
 
 ;; Some entry point support code.

src/comp.c

@@ -4158,7 +4158,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);
+	  Fputhash (subr_name, trampoline, Vcomp_installed_trampolines_h);
 	  return Qt;
 	}
       i++;
@@ -5296,7 +5296,9 @@ The last directory of this list is assumed to be the system one.  */);
 		       redefinable effectivelly.  */);
 
   DEFVAR_LISP ("comp-installed-trampolines-h", Vcomp_installed_trampolines_h,
-	       doc: /* Hash table subr-name -> bool.  */);
+	       doc: /* Hash table subr-name -> installed trampoline.
+This is used to prevent double trampoline instantiation but also to
+protect the trampolines against GC.  */);
   Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table);
 
   Fprovide (intern_c_string ("nativecomp"), Qnil);