procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/emacs-lisp/advice.el
View file

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

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.

62
lisp/emacs-lisp/comp.el
View file

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

4
lisp/emacs-lisp/nadvice.el
View file

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