From: Andrea Corallo Date: Tue, 7 Nov 2023 10:28:32 +0000 (+0100) Subject: Don't load comp when installing an existing trampoline X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6c67a8bacfdf63b2e45e8a683345e543a5f6a578;p=emacs.git 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. --- 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 25473cc6d63..d08fbc6cee4 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." @@ -3690,19 +3653,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)) @@ -3718,16 +3668,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 @@ -3753,6 +3693,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))))