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:
parent
b6e2799aa1
commit
1795839bab
3 changed files with 28 additions and 18 deletions
|
@ -3782,6 +3782,28 @@ Return the trampoline if found or nil otherwise."
|
||||||
when (file-exists-p filename)
|
when (file-exists-p filename)
|
||||||
do (cl-return (native-elisp-load 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)
|
(defun comp-trampoline-compile (subr-name)
|
||||||
"Synthesize compile and return a trampoline for SUBR-NAME."
|
"Synthesize compile and return a trampoline for SUBR-NAME."
|
||||||
(let* ((lambda-list (comp-make-lambda-list-from-subr
|
(let* ((lambda-list (comp-make-lambda-list-from-subr
|
||||||
|
@ -3803,22 +3825,7 @@ Return the trampoline if found or nil otherwise."
|
||||||
(lexical-binding t))
|
(lexical-binding t))
|
||||||
(comp--native-compile
|
(comp--native-compile
|
||||||
form nil
|
form nil
|
||||||
(cl-loop
|
(comp--trampoline-abs-filename subr-name))))
|
||||||
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'")))))
|
|
||||||
|
|
||||||
|
|
||||||
;; Some entry point support code.
|
;; Some entry point support code.
|
||||||
|
|
|
@ -5858,12 +5858,15 @@ The last directory of this list is assumed to be the system one. */);
|
||||||
dump reload. */
|
dump reload. */
|
||||||
Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
|
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.
|
doc: /* If non-nil, enable primitive trampoline synthesis.
|
||||||
This makes Emacs respect redefinition or advises of primitive functions
|
This makes Emacs respect redefinition or advises of primitive functions
|
||||||
when they are called from Lisp code natively-compiled at `native-comp-speed'
|
when they are called from Lisp code natively-compiled at `native-comp-speed'
|
||||||
of 2.
|
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
|
By default, this is enabled, and when Emacs sees a redefined or advised
|
||||||
primitive called from natively-compiled Lisp, it generates a trampoline
|
primitive called from natively-compiled Lisp, it generates a trampoline
|
||||||
for it on-the-fly.
|
for it on-the-fly.
|
||||||
|
|
|
@ -855,7 +855,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
|
||||||
#ifdef HAVE_NATIVE_COMP
|
#ifdef HAVE_NATIVE_COMP
|
||||||
register Lisp_Object function = XSYMBOL (symbol)->u.s.function;
|
register Lisp_Object function = XSYMBOL (symbol)->u.s.function;
|
||||||
|
|
||||||
if (comp_enable_subr_trampolines
|
if (!NILP (Vcomp_enable_subr_trampolines)
|
||||||
&& SUBRP (function)
|
&& SUBRP (function)
|
||||||
&& !SUBR_NATIVE_COMPILEDP (function))
|
&& !SUBR_NATIVE_COMPILEDP (function))
|
||||||
CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol);
|
CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol);
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue