summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrea Corallo <akrl@sdf.org>2023-02-13 11:09:46 +0100
committerAndrea Corallo <akrl@sdf.org>2023-02-13 12:48:09 +0100
commit1795839babcf8572a79aaee3c76ca5b357937a59 (patch)
treee4f572276a12cc11cec8cac6e29864ce89ad3b0c
parentb6e2799aa1c3887c2995e115e6ff2f69d59f0e44 (diff)
downloademacs-1795839babcf8572a79aaee3c76ca5b357937a59.tar.gz
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.
-rw-r--r--lisp/emacs-lisp/comp.el39
-rw-r--r--src/comp.c5
-rw-r--r--src/data.c2
3 files changed, 28 insertions, 18 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 8a41989237e..eeee66b3d1b 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -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.
diff --git a/src/comp.c b/src/comp.c
index 7d67995fa87..82224845bff 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -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.
diff --git a/src/data.c b/src/data.c
index bb4d1347d72..a43fa8991fe 100644
--- a/src/data.c
+++ b/src/data.c
@@ -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);