From 1795839babcf8572a79aaee3c76ca5b357937a59 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Mon, 13 Feb 2023 11:09:46 +0100
Subject: [PATCH] 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.
---
 lisp/emacs-lisp/comp.el | 39 +++++++++++++++++++++++----------------
 src/comp.c              |  5 ++++-
 src/data.c              |  2 +-
 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);
-- 
2.39.2