master b2416d2c029 4/6: Don't load comp when installing an existing trampoline

[Andrea Corallo]

branch: master
commit b2416d2c029eeda5fa9e663dbe3f0264adc57a50
Author: Andrea Corallo <acorallo@gnu.org>
Commit: Andrea Corallo <acorallo@gnu.org>

    Don't load comp when installing an existing trampoline
    
            * lisp/emacs-lisp/nadvice.el (advice--add-function): Update.
            (comp-subr-trampoline-install): Update src file.
            * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Autoload.
            * lisp/emacs-lisp/comp-run.el (comp-log-buffer-name)
            (native--compile-async, comp-warn-primitives)
            (comp-trampoline-filename, comp-eln-load-path-eff)
            (comp-trampoline-search, comp-trampoline-compile): Move here.
            * lisp/emacs-lisp/advice.el (comp-subr-trampoline-install): Update
            src file.
---
 lisp/emacs-lisp/advice.el   |  2 +-
 lisp/emacs-lisp/comp-run.el | 59 ++++++++++++++++++++++++++++++++++++++++++
 lisp/emacs-lisp/comp.el     | 62 ++-------------------------------------------
 lisp/emacs-lisp/nadvice.el  |  4 +--
 4 files changed, 64 insertions(+), 63 deletions(-)

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 7fbdd963e0e..2a668f6ce0e 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2042,7 +2042,7 @@ in that CLASS."
                 function class name)))
     (error "ad-remove-advice: `%s' is not advised" function)))
 
-(declare-function comp-subr-trampoline-install "comp")
+(declare-function comp-subr-trampoline-install "comp-run")
 
 ;;;###autoload
 (defun ad-add-advice (function advice class position)
diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el
index b65c0997a3e..512cadf4cab 100644
--- a/lisp/emacs-lisp/comp-run.el
+++ b/lisp/emacs-lisp/comp-run.el
@@ -123,6 +123,19 @@ This is intended for debugging the compiler itself.
   :risky t
   :version "28.1")
 
+(defcustom native-comp-never-optimize-functions
+  '(;; The following two are mandatory for Emacs to be working
+    ;; correctly (see comment in `advice--add-function'). DO NOT
+    ;; REMOVE.
+    macroexpand rename-buffer)
+  "Primitive functions to exclude from trampoline optimization.
+
+Primitive functions included in this list will not be called
+directly by the natively-compiled code, which makes trampolines for
+those primitives unnecessary in case of function redefinition/advice."
+  :type '(repeat symbol)
+  :version "28.1")
+
 (defconst comp-log-buffer-name "*Native-compile-Log*"
   "Name of the native-compiler log buffer.")
 
@@ -385,6 +398,52 @@ display a message."
     ;; Reset it anyway.
     (clrhash comp-deferred-pending-h)))
 
+(defconst comp-warn-primitives
+  '(null memq gethash and subrp not subr-native-elisp-p
+         comp--install-trampoline concat if symbolp symbol-name make-string
+         length aset aref length> mapcar expand-file-name
+         file-name-as-directory file-exists-p native-elisp-load)
+  "List of primitives we want to warn about in case of redefinition.
+This are essential for the trampoline machinery to work properly.")
+
+(defun 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"))
+
+(defun comp-eln-load-path-eff ()
+  "Return a list of effective eln load directories.
+Account for `native-comp-eln-load-path' and `comp-native-version-dir'."
+  (mapcar (lambda (dir)
+            (expand-file-name comp-native-version-dir
+                              (file-name-as-directory
+                               (expand-file-name dir invocation-directory))))
+          native-comp-eln-load-path))
+
+(defun comp-trampoline-search (subr-name)
+  "Search a trampoline file for SUBR-NAME.
+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-eff)
+   for filename = (expand-file-name rel-filename dir)
+   when (file-exists-p filename)
+     do (cl-return (native-elisp-load filename))))
+
+(declare-function comp-trampoline-compile "comp")
+;;;###autoload
+(defun comp-subr-trampoline-install (subr-name)
+  "Make SUBR-NAME effectively advice-able when called from native code."
+  (when (memq subr-name comp-warn-primitives)
+    (warn "Redefining `%s' might break native compilation of trampolines."
+          subr-name))
+  (unless (or (null native-comp-enable-subr-trampolines)
+              (memq subr-name native-comp-never-optimize-functions)
+              (gethash subr-name comp-installed-trampolines-h))
+    (cl-assert (subr-primitive-p (symbol-function subr-name)))
+    (when-let ((trampoline (or (comp-trampoline-search subr-name)
+                               (comp-trampoline-compile subr-name))))
+      (comp--install-trampoline subr-name trampoline))))
+
 ;;;###autoload
 (defun native--compile-async (files &optional recursively load selector)
   ;; BEWARE, this function is also called directly from C.
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 15662041a57..457960b2198 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -92,19 +92,6 @@ during bootstrap."
   :type '(repeat regexp)
   :version "28.1")
 
-(defcustom native-comp-never-optimize-functions
-  '(;; The following two are mandatory for Emacs to be working
-    ;; correctly (see comment in `advice--add-function'). DO NOT
-    ;; REMOVE.
-    macroexpand rename-buffer)
-  "Primitive functions to exclude from trampoline optimization.
-
-Primitive functions included in this list will not be called
-directly by the natively-compiled code, which makes trampolines for
-those primitives unnecessary in case of function redefinition/advice."
-  :type '(repeat symbol)
-  :version "28.1")
-
 (defcustom native-comp-compiler-options nil
   "Command line options passed verbatim to GCC compiler.
 Note that not all options are meaningful and some options might even
@@ -644,30 +631,6 @@ Useful to hook into pass checkers.")
 (defvar comp-no-spawn nil
   "Non-nil don't spawn native compilation processes.")
 
-(defconst comp-warn-primitives
-  '(null memq gethash and subrp not subr-native-elisp-p
-         comp--install-trampoline concat if symbolp symbol-name make-string
-         length aset aref length> mapcar expand-file-name
-         file-name-as-directory file-exists-p native-elisp-load)
-  "List of primitives we want to warn about in case of redefinition.
-This are essential for the trampoline machinery to work properly.")
-
-;; Moved early to avoid circularity when comp.el is loaded and
-;; `macroexpand' needs to be advised (bug#47049).
-;;;###autoload
-(defun comp-subr-trampoline-install (subr-name)
-  "Make SUBR-NAME effectively advice-able when called from native code."
-  (when (memq subr-name comp-warn-primitives)
-    (warn "Redefining `%s' might break native compilation of trampolines."
-          subr-name))
-  (unless (or (null native-comp-enable-subr-trampolines)
-              (memq subr-name native-comp-never-optimize-functions)
-              (gethash subr-name comp-installed-trampolines-h))
-    (cl-assert (subr-primitive-p (symbol-function subr-name)))
-    (when-let ((trampoline (or (comp-trampoline-search subr-name)
-                               (comp-trampoline-compile subr-name))))
-        (comp--install-trampoline subr-name trampoline))))
-
 
 (cl-defstruct (comp-vec (:copier nil))
   "A re-sizable vector like object."
@@ -3635,19 +3598,6 @@ Prepare every function for final compilation and drive 
the C back-end."
 
 ;; Primitive function advice machinery
 
-(defun comp-eln-load-path-eff ()
-  "Return a list of effective eln load directories.
-Account for `native-comp-eln-load-path' and `comp-native-version-dir'."
-  (mapcar (lambda (dir)
-            (expand-file-name comp-native-version-dir
-                              (file-name-as-directory
-                               (expand-file-name dir invocation-directory))))
-          native-comp-eln-load-path))
-
-(defun 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"))
-
 (defun comp-make-lambda-list-from-subr (subr)
   "Given SUBR return the equivalent lambda-list."
   (pcase-let ((`(,min . ,max) (subr-arity subr))
@@ -3663,16 +3613,6 @@ Account for `native-comp-eln-load-path' and 
`comp-native-version-dir'."
       (push (gensym "arg") lambda-list))
     (reverse lambda-list)))
 
-(defun comp-trampoline-search (subr-name)
-  "Search a trampoline file for SUBR-NAME.
-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-eff)
-   for filename = (expand-file-name rel-filename dir)
-   when (file-exists-p filename)
-     do (cl-return (native-elisp-load filename))))
-
 (defun comp--trampoline-abs-filename (subr-name)
   "Return the absolute filename for a trampoline for SUBR-NAME."
   (cl-loop
@@ -3698,6 +3638,8 @@ Return the trampoline if found or nil otherwise."
             (make-temp-file (file-name-sans-extension rel-filename) nil ".eln"
                             nil))))
 
+;; Called from comp-run.el
+;;;###autoload
 (defun comp-trampoline-compile (subr-name)
   "Synthesize compile and return a trampoline for SUBR-NAME."
   (let* ((lambda-list (comp-make-lambda-list-from-subr
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index ce5467f3c5c..98efb4c9c28 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -389,7 +389,7 @@ is also interactive.  There are 3 cases:
   `(advice--add-function ,how (gv-ref ,(advice--normalize-place place))
                          ,function ,props))
 
-(declare-function comp-subr-trampoline-install "comp")
+(declare-function comp-subr-trampoline-install "comp-run")
 
 ;;;###autoload
 (defun advice--add-function (how ref function props)
@@ -407,7 +407,7 @@ is also interactive.  There are 3 cases:
       (unless (memq subr-name '(macroexpand rename-buffer))
         ;; Must require explicitly as during bootstrap we have no
         ;; autoloads.
-        (require 'comp)
+        (require 'comp-run)
         (comp-subr-trampoline-install subr-name))))
   (let* ((name (cdr (assq 'name props)))
          (a (advice--member-p (or name function) (if name t) (gv-deref ref))))