]> git.eshelyaron.com Git - emacs.git/commitdiff
* Fix missing `comp-files-queue' update (bug#63415).
authorAndrea Corallo <akrl@sdf.org>
Wed, 17 May 2023 13:28:46 +0000 (15:28 +0200)
committerEshel Yaron <me@eshelyaron.com>
Sun, 24 Mar 2024 14:16:12 +0000 (15:16 +0100)
* lisp/emacs-lisp/comp.el (native--compile-async): Update
`comp-files-queue' for real.

(cherry picked from commit 51848e4731f3e32e5d152990bf570b08ca544a92)

lisp/emacs-lisp/comp.el

index 1df1e3b3ddb95bfdd22004a6100b45eddf343fbe..18e63354524b3d3f912b93e2ce5b619416c7da95 100644 (file)
@@ -3507,6 +3507,101 @@ the deferred compilation mechanism."
                    (ignore-errors (delete-file (comp-ctxt-output comp-ctxt))))
                   (t (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.
+
+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)))
+       ((stringp selector) (not (string-match-p selector file)))
+       (t (error "SELECTOR must be a function a regexp or nil")))
+      ;; Also exclude files from deferred compilation if
+      ;; any of the regexps in
+      ;; `native-comp-jit-compilation-deny-list' matches.
+      (and (eq load 'late)
+           (cl-some (lambda (re)
+                      (string-match-p re file))
+                    native-comp-jit-compilation-deny-list))))
+
+(defun native--compile-async (files &optional recursively load selector)
+  ;; BEWARE, this function is also called directly from C.
+  "Compile FILES asynchronously.
+FILES is one filename or a list of filenames or directories.
+
+If optional argument RECURSIVELY is non-nil, recurse into
+subdirectories of given directories.
+
+If optional argument LOAD is non-nil, request to load the file
+after compiling.
+
+The optional argument SELECTOR has the following valid values:
+
+nil -- Select all files.
+a string -- A regular expression selecting files with matching names.
+a function -- A function selecting files with matching names.
+
+The variable `native-comp-async-jobs-number' specifies the number
+of (commands) to run simultaneously.
+
+LOAD can also be the symbol `late'.  This is used internally if
+the byte code has already been loaded when this function is
+called.  It means that we request the special kind of load
+necessary in that situation, called \"late\" loading.
+
+During a \"late\" load, instead of executing all top-level forms
+of the original files, only function definitions are
+loaded (paying attention to have these effective only if the
+bytecode definition was not changed in the meantime)."
+  (comp-ensure-native-compiler)
+  (unless (member load '(nil t late))
+    (error "LOAD must be nil, t or 'late"))
+  (unless (listp files)
+    (setf files (list files)))
+  (let ((added-something nil)
+        file-list)
+    (dolist (file-or-dir files)
+      (cond ((file-directory-p file-or-dir)
+             (dolist (file (if recursively
+                               (directory-files-recursively
+                                file-or-dir comp-valid-source-re)
+                             (directory-files file-or-dir
+                                              t comp-valid-source-re)))
+               (push file file-list)))
+            ((file-exists-p file-or-dir) (push file-or-dir file-list))
+            (t (signal 'native-compiler-error
+                       (list "Not a file nor directory" file-or-dir)))))
+    (dolist (file file-list)
+      (if-let ((entry (cl-find file comp-files-queue :key #'car :test #'string=)))
+          ;; Most likely the byte-compiler has requested a deferred
+          ;; compilation, so update `comp-files-queue' to reflect that.
+          (unless (or (null load)
+                      (eq load (cdr entry)))
+            (setf comp-files-queue
+                  (cl-substitute (cons file load) (car entry) comp-files-queue
+                                 :key #'car :test #'string=)))
+
+        (unless (native-compile-async-skip-p file load selector)
+          (let* ((out-filename (comp-el-to-eln-filename file))
+                 (out-dir (file-name-directory out-filename)))
+            (unless (file-exists-p out-dir)
+              (make-directory out-dir t))
+            (if (file-writable-p out-filename)
+                (setf comp-files-queue
+                      (append comp-files-queue `((,file . ,load)))
+                      added-something t)
+              (display-warning 'comp
+                               (format "No write access for %s skipping."
+                                       out-filename)))))))
+    ;; 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))))
+
 \f
 ;;; Compiler entry points.