Merge remote-tracking branch 'origin/master' into feature/package+vc

1 files changed, 98 insertions, 88 deletions

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 889bffa3f5c..2c9b79334ba 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -687,6 +687,9 @@ Useful to hook into pass checkers.")
   'native-compiler-error)
 
 
+(defvar comp-no-spawn nil
+  "Non-nil don't spawn native compilation processes.")
+
 ;; Moved early to avoid circularity when comp.el is loaded and
 ;; `macroexpand' needs to be advised (bug#47049).
 ;;;###autoload
@@ -696,12 +699,9 @@ Useful to hook into pass checkers.")
               (memq subr-name native-comp-never-optimize-functions)
               (gethash subr-name comp-installed-trampolines-h))
     (cl-assert (subr-primitive-p (symbol-function subr-name)))
-    (comp--install-trampoline
-     subr-name
-     (or (comp-trampoline-search subr-name)
-         (comp-trampoline-compile subr-name)
-         ;; Should never happen.
-         (cl-assert nil)))))
+    (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))
@@ -3689,7 +3689,8 @@ Prepare every function for final compilation and drive the C back-end."
              (print-circle t)
              (print-escape-multibyte t)
              (expr `((require 'comp)
-                     (setf native-comp-verbose ,native-comp-verbose
+                     (setf comp-no-spawn t
+                           native-comp-verbose ,native-comp-verbose
                            comp-libgccjit-reproducer ,comp-libgccjit-reproducer
                            comp-ctxt ,comp-ctxt
                            native-comp-eln-load-path ',native-comp-eln-load-path
@@ -3945,8 +3946,9 @@ display a message."
                     (file-newer-than-file-p
                      source-file (comp-el-to-eln-filename source-file))))
          do (let* ((expr `((require 'comp)
-                           (setq comp-async-compilation t)
-                           (setq warning-fill-column most-positive-fixnum)
+                           (setq comp-async-compilation t
+                                 comp-no-spawn t
+                                 warning-fill-column most-positive-fixnum)
                            ,(let ((set (list 'setq)))
                               (dolist (var '(comp-file-preloaded-p
                                              native-compile-target-directory
@@ -4046,72 +4048,73 @@ the deferred compilation mechanism."
               (stringp function-or-file))
     (signal 'native-compiler-error
             (list "Not a function symbol or file" function-or-file)))
-  (catch 'no-native-compile
-    (let* ((print-symbols-bare t)
-           (data function-or-file)
-           (comp-native-compiling t)
-           (byte-native-qualities nil)
-           (symbols-with-pos-enabled t)
-           ;; Have byte compiler signal an error when compilation fails.
-           (byte-compile-debug t)
-           (comp-ctxt (make-comp-ctxt :output output
-                                      :with-late-load with-late-load)))
-      (comp-log "\n\n" 1)
-      (unwind-protect
-          (progn
-            (condition-case err
-                (cl-loop
-                 with report = nil
-                 for t0 = (current-time)
-                 for pass in comp-passes
-                 unless (memq pass comp-disabled-passes)
-                 do
-                 (comp-log (format "(%s) Running pass %s:\n"
-                                   function-or-file pass)
-                           2)
-                 (setf data (funcall pass data))
-                 (push (cons pass (float-time (time-since t0))) report)
-                 (cl-loop for f in (alist-get pass comp-post-pass-hooks)
-                          do (funcall f data))
-                 finally
-                 (when comp-log-time-report
-                   (comp-log (format "Done compiling %s" data) 0)
-                   (cl-loop for (pass . time) in (reverse report)
-                            do (comp-log (format "Pass %s took: %fs."
-                                                 pass time) 0))))
-              (native-compiler-skip)
-              (t
-               (let ((err-val (cdr err)))
-                 ;; If we are doing an async native compilation print the
-                 ;; error in the correct format so is parsable and abort.
-                 (if (and comp-async-compilation
-                          (not (eq (car err) 'native-compiler-error)))
-                     (progn
-                       (message (if err-val
-                                    "%s: Error: %s %s"
-                                  "%s: Error %s")
-                                function-or-file
-                                (get (car err) 'error-message)
-                                (car-safe err-val))
-                       (kill-emacs -1))
-                   ;; Otherwise re-signal it adding the compilation input.
-	           (signal (car err) (if (consp err-val)
-			                 (cons function-or-file err-val)
-			               (list function-or-file err-val)))))))
-            (if (stringp function-or-file)
-                data
-              ;; So we return the compiled function.
-              (native-elisp-load data)))
-        ;; We may have created a temporary file when we're being
-        ;; called with something other than a file as the argument.
-        ;; Delete it.
-        (when (and (not (stringp function-or-file))
-                   (not output)
-                   comp-ctxt
-                   (comp-ctxt-output comp-ctxt)
-                   (file-exists-p (comp-ctxt-output comp-ctxt)))
-          (message "Deleting %s" (comp-ctxt-output comp-ctxt))
-          (delete-file (comp-ctxt-output comp-ctxt)))))))
+  (unless comp-no-spawn
+    (catch 'no-native-compile
+      (let* ((print-symbols-bare t)
+             (data function-or-file)
+             (comp-native-compiling t)
+             (byte-native-qualities nil)
+             (symbols-with-pos-enabled t)
+             ;; Have byte compiler signal an error when compilation fails.
+             (byte-compile-debug t)
+             (comp-ctxt (make-comp-ctxt :output output
+                                        :with-late-load with-late-load)))
+        (comp-log "\n\n" 1)
+        (unwind-protect
+            (progn
+              (condition-case err
+                  (cl-loop
+                   with report = nil
+                   for t0 = (current-time)
+                   for pass in comp-passes
+                   unless (memq pass comp-disabled-passes)
+                   do
+                   (comp-log (format "(%s) Running pass %s:\n"
+                                     function-or-file pass)
+                             2)
+                   (setf data (funcall pass data))
+                   (push (cons pass (float-time (time-since t0))) report)
+                   (cl-loop for f in (alist-get pass comp-post-pass-hooks)
+                            do (funcall f data))
+                   finally
+                   (when comp-log-time-report
+                     (comp-log (format "Done compiling %s" data) 0)
+                     (cl-loop for (pass . time) in (reverse report)
+                              do (comp-log (format "Pass %s took: %fs."
+                                                   pass time) 0))))
+                (native-compiler-skip)
+                (t
+                 (let ((err-val (cdr err)))
+                   ;; If we are doing an async native compilation print the
+                   ;; error in the correct format so is parsable and abort.
+                   (if (and comp-async-compilation
+                            (not (eq (car err) 'native-compiler-error)))
+                       (progn
+                         (message (if err-val
+                                      "%s: Error: %s %s"
+                                    "%s: Error %s")
+                                  function-or-file
+                                  (get (car err) 'error-message)
+                                  (car-safe err-val))
+                         (kill-emacs -1))
+                     ;; Otherwise re-signal it adding the compilation input.
+	             (signal (car err) (if (consp err-val)
+			                   (cons function-or-file err-val)
+			                 (list function-or-file err-val)))))))
+              (if (stringp function-or-file)
+                  data
+                ;; So we return the compiled function.
+                (native-elisp-load data)))
+          ;; We may have created a temporary file when we're being
+          ;; called with something other than a file as the argument.
+          ;; Delete it.
+          (when (and (not (stringp function-or-file))
+                     (not output)
+                     comp-ctxt
+                     (comp-ctxt-output comp-ctxt)
+                     (file-exists-p (comp-ctxt-output comp-ctxt)))
+            (message "Deleting %s" (comp-ctxt-output comp-ctxt))
+            (delete-file (comp-ctxt-output comp-ctxt))))))))
 
 (defun native-compile-async-skip-p (file load selector)
   "Return non-nil if FILE's compilation should be skipped.
@@ -4119,6 +4122,7 @@ the deferred compilation mechanism."
 LOAD and SELECTOR work as described in `native--compile-async'."
   ;; Make sure we are not already compiling `file' (bug#40838).
   (or (gethash file comp-async-compilations)
+      (gethash (file-name-with-extension file "elc") comp--no-native-compile)
       (cond
        ((null selector) nil)
        ((functionp selector) (not (funcall selector file)))
@@ -4166,7 +4170,8 @@ bytecode definition was not changed in the meantime)."
     (error "LOAD must be nil, t or 'late"))
   (unless (listp files)
     (setf files (list files)))
-  (let (file-list)
+  (let ((added-something nil)
+        file-list)
     (dolist (file-or-dir files)
       (cond ((file-directory-p file-or-dir)
              (dolist (file (if recursively
@@ -4194,11 +4199,15 @@ bytecode definition was not changed in the meantime)."
               (make-directory out-dir t))
             (if (file-writable-p out-filename)
                 (setf comp-files-queue
-                      (append comp-files-queue `((,file . ,load))))
+                      (append comp-files-queue `((,file . ,load)))
+                      added-something t)
               (display-warning 'comp
                                (format "No write access for %s skipping."
                                        out-filename)))))))
-    (when (zerop (comp-async-runnings))
+    ;; Perhaps nothing passed `native-compile-async-skip-p'?
+    (when (and added-something
+               ;; Don't start if there's one already running.
+               (zerop (comp-async-runnings)))
       (comp-run-async-workers))))
 
 
@@ -4234,14 +4243,13 @@ Search happens in `native-comp-eln-load-path'."
 (defun native-compile (function-or-file &optional output)
   "Compile FUNCTION-OR-FILE into native code.
 This is the synchronous entry-point for the Emacs Lisp native
-compiler.
-FUNCTION-OR-FILE is a function symbol, a form, or the filename of
-an Emacs Lisp source file.
-If OUTPUT is non-nil, use it as the filename for the compiled
-object.
-If FUNCTION-OR-FILE is a filename, return the filename of the
-compiled object.  If FUNCTION-OR-FILE is a function symbol or a
-form, return the compiled function."
+compiler.  FUNCTION-OR-FILE is a function symbol, a form, or the
+filename of an Emacs Lisp source file.  If OUTPUT is non-nil, use
+it as the filename for the compiled object.  If FUNCTION-OR-FILE
+is a filename, if the compilation was successful return the
+filename of the compiled object.  If FUNCTION-OR-FILE is a
+function symbol or a form, if the compilation was successful
+return the compiled function."
   (comp--native-compile function-or-file nil output))
 
 ;;;###autoload
@@ -4328,13 +4336,15 @@ of (commands) to run simultaneously."
     ;; `invocation-directory'.
     (setq dir (expand-file-name dir invocation-directory))
     (when (file-exists-p dir)
-      (dolist (subdir (directory-files dir t))
+      (dolist (subdir (seq-filter
+                       (lambda (f) (not (string-match (rx "/." (? ".") eos) f)))
+                       (directory-files dir t)))
         (when (and (file-directory-p subdir)
                    (file-writable-p subdir)
                    (not (equal (file-name-nondirectory
                                 (directory-file-name subdir))
                                comp-native-version-dir)))
-          (message "Deleting %s..." subdir)
+          (message "Deleting `%s'..." subdir)
           ;; We're being overly cautious here -- there shouldn't be
           ;; anything but .eln files in these directories.
           (dolist (eln (directory-files subdir t "\\.eln\\(\\.tmp\\)?\\'"))