diff options
Diffstat (limited to 'lisp/emacs-lisp/comp.el')
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 186 |
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\\)?\\'")) |