mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-10 00:00:39 -08:00
Code Issues Projects Releases Wiki Activity

Don't load comp when installing an existing trampoline

Browse source 
* 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.
This commit is contained in:
Andrea Corallo 2023-11-07 11:28:32 +01:00
parent 93cc43a23c
commit b2416d2c02
4 changed files with 64 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

59
lisp/emacs-lisp/comp-run.el
View file

@ -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.