From d9cd55a4f1c3f391b996dfbe77ed24306b37ac9f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 12 Mar 2021 10:24:29 +0100 Subject: [PATCH] Implement `no-native-compile' (bug#46983) * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Capture `no-native-compile'. * lisp/emacs-lisp/comp.el (no-native-compile): Define new variable. (comp-spill-lap-function): Throw when `no-native-compile' was captured non-nil. (comp--native-compile): Catch `no-native-compile' if necessary and return nil in case. --- lisp/emacs-lisp/bytecomp.el | 3 ++ lisp/emacs-lisp/comp.el | 97 +++++++++++++++++++++---------------- 2 files changed, 57 insertions(+), 43 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 94424fc38af..8ca4adc6a96 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2275,6 +2275,9 @@ With argument ARG, insert value in current buffer after the form." (push `(comp-debug . ,comp-debug) byte-native-qualities) (defvar comp-native-driver-options) (push `(comp-native-driver-options . ,comp-native-driver-options) + byte-native-qualities) + (defvar no-native-compile) + (push `(no-native-compile . ,no-native-compile) byte-native-qualities)) ;; Compile the forms from the input buffer. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 98f4dd6e1f6..a62efc7e025 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -180,6 +180,13 @@ the .eln output directory." :type 'boolean :version "28.1") +(defvar no-native-compile nil + "Non-nil to prevent native-compiling of Emacs Lisp code. +This is normally set in local file variables at the end of the elisp file: + +\;; Local Variables:\n;; no-native-compile: t\n;; End: ") +;;;###autoload(put 'no-native-compile 'safe-local-variable 'booleanp) + (defvar comp-log-time-report nil "If non-nil, log a time report for each pass.") @@ -1289,6 +1296,8 @@ clashes." (cl-defmethod comp-spill-lap-function ((filename string)) "Byte-compile FILENAME, spilling data from the byte compiler." (byte-compile-file filename) + (when (alist-get 'no-native-compile byte-native-qualities) + (throw 'no-native-compile nil)) (unless byte-to-native-top-level-forms (signal 'native-compiler-error-empty-byte filename)) (unless (comp-ctxt-output comp-ctxt) @@ -3943,55 +3952,57 @@ load once it finishes compiling." (stringp function-or-file)) (signal 'native-compiler-error (list "Not a function symbol or file" function-or-file))) - (let* ((data function-or-file) - (comp-native-compiling t) - (byte-native-qualities nil) - ;; 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) - (condition-case err - (cl-loop - with report = nil - for t0 = (current-time) - for pass in comp-passes - unless (memq pass comp-disabled-passes) + (catch 'no-native-compile + (let* ((data function-or-file) + (comp-native-compiling t) + (byte-native-qualities nil) + ;; 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) + (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) + 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)))) - (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)))) + 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))))) (defun native-compile-async-skip-p (file load selector) "Return non-nil if FILE's compilation should be skipped. -- 2.39.5