Support `comp-enable-subr-trampolines' as string value

* src/comp.c (syms_of_comp): Update `comp-enable-subr-trampolines'.

* lisp/emacs-lisp/comp.el (native-comp-never-optimize-functions)
(comp--trampoline-abs-filename): Support
`comp-enable-subr-trampolines' string value.

* src/data.c (Ffset): Use Vcomp_enable_subr_trampolines now.
This commit is contained in:
Andrea Corallo 2023-02-13 11:09:46 +01:00
parent b6e2799aa1
commit 1795839bab
3 changed files with 28 additions and 18 deletions

View file

@ -3782,6 +3782,28 @@ Return the trampoline if found or nil otherwise."
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
with dirs = (if (stringp comp-enable-subr-trampolines)
(list comp-enable-subr-trampolines)
(if native-compile-target-directory
(list (expand-file-name comp-native-version-dir
native-compile-target-directory))
(comp-eln-load-path-eff)))
for dir in dirs
for f = (expand-file-name
(comp-trampoline-filename subr-name)
dir)
unless (file-exists-p dir)
do (ignore-errors
(make-directory dir t)
(cl-return f))
when (file-writable-p f)
do (cl-return f)
finally (error "Cannot find suitable directory for output in \
`native-comp-eln-load-path'")))
(defun comp-trampoline-compile (subr-name)
"Synthesize compile and return a trampoline for SUBR-NAME."
(let* ((lambda-list (comp-make-lambda-list-from-subr
@ -3803,22 +3825,7 @@ Return the trampoline if found or nil otherwise."
(lexical-binding t))
(comp--native-compile
form nil
(cl-loop
for dir in (if native-compile-target-directory
(list (expand-file-name comp-native-version-dir
native-compile-target-directory))
(comp-eln-load-path-eff))
for f = (expand-file-name
(comp-trampoline-filename subr-name)
dir)
unless (file-exists-p dir)
do (ignore-errors
(make-directory dir t)
(cl-return f))
when (file-writable-p f)
do (cl-return f)
finally (error "Cannot find suitable directory for output in \
`native-comp-eln-load-path'")))))
(comp--trampoline-abs-filename subr-name))))
;; Some entry point support code.

View file

@ -5858,12 +5858,15 @@ The last directory of this list is assumed to be the system one. */);
dump reload. */
Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines,
DEFVAR_LISP ("comp-enable-subr-trampolines", Vcomp_enable_subr_trampolines,
doc: /* If non-nil, enable primitive trampoline synthesis.
This makes Emacs respect redefinition or advises of primitive functions
when they are called from Lisp code natively-compiled at `native-comp-speed'
of 2.
If `comp-enable-subr-trampolines' is a string it specifies a directory
in which to deposit the trampoline.
By default, this is enabled, and when Emacs sees a redefined or advised
primitive called from natively-compiled Lisp, it generates a trampoline
for it on-the-fly.

View file

@ -855,7 +855,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
#ifdef HAVE_NATIVE_COMP
register Lisp_Object function = XSYMBOL (symbol)->u.s.function;
if (comp_enable_subr_trampolines
if (!NILP (Vcomp_enable_subr_trampolines)
&& SUBRP (function)
&& !SUBR_NATIVE_COMPILEDP (function))
CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol);