diff options
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 60 |
1 files changed, 54 insertions, 6 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4f01918bdb9..fe5616be668 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -562,6 +562,29 @@ Each element is (INDEX . VALUE)") (defvar byte-compile-depth 0 "Current depth of execution stack.") (defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.") +;; These are use by comp.el to spill data out of here +(cl-defstruct byte-to-native-function + "Named or anonymous function defined a top level." + name data) +(cl-defstruct byte-to-native-top-level + "All other top level forms." + form) +(defvar byte-native-compiling nil + "Non nil while native compiling.") +(defvar byte-native-for-bootstrap nil + "Non nil while compiling for bootstrap." + ;; During boostrap we produce both the .eln and the .elc together. + ;; Because the make target is the later this has to be produced as + ;; last to be resilient against build interruptions. +) +(defvar byte-to-native-lap nil + "A-list to accumulate LAP. +Each pair is (NAME . LAP)") +(defvar byte-to-native-top-level-forms nil + "List of top level forms.") +(defvar byte-to-native-output-file nil + "Temporary file containing the byte-compilation output.") + ;;; The byte codes; this information is duplicated in bytecomp.c @@ -2018,8 +2041,16 @@ The value is non-nil if there were no errors, nil if errors." ;; emacs-lisp files in the build tree are ;; recompiled). Previously this was accomplished by ;; deleting target-file before writing it. - (rename-file tempfile target-file t)) - (or noninteractive (message "Wrote %s" target-file))) + (if byte-native-compiling + (if byte-native-for-bootstrap + ;; Defer elc final renaming. + (setf byte-to-native-output-file + (cons tempfile target-file)) + (delete-file tempfile)) + (rename-file tempfile target-file t))) + (or noninteractive + byte-native-compiling + (message "Wrote %s" target-file))) ;; This is just to give a better error message than write-region (let ((exists (file-exists-p target-file))) (signal (if exists 'file-error 'file-missing) @@ -2193,6 +2224,10 @@ Call from the source buffer." ;; defalias calls are output directly by byte-compile-file-form-defmumble; ;; it does not pay to first build the defalias in defmumble and then parse ;; it here. + (when byte-native-compiling + ;; Spill output for the native compiler here + (push (make-byte-to-native-top-level :form form) + byte-to-native-top-level-forms)) (let ((print-escape-newlines t) (print-length nil) (print-level nil) @@ -2326,7 +2361,8 @@ list that represents a doc string reference. (defun byte-compile-flush-pending () (if byte-compile-output - (let ((form (byte-compile-out-toplevel t 'file))) + (let* ((byte-compile-current-form nil) + (form (byte-compile-out-toplevel t 'file))) (cond ((eq (car-safe form) 'progn) (mapc 'byte-compile-output-file-form (cdr form))) (form @@ -2646,6 +2682,13 @@ not to take responsibility for the actual compilation of the code." ;; If there's no doc string, provide -1 as the "doc string ;; index" so that no element will be treated as a doc string. (if (not (stringp (documentation code t))) -1 4))) + (when byte-native-compiling + ;; Spill output for the native compiler here. + (push (if macro + (make-byte-to-native-top-level + :form `(defalias ',name '(macro . ,code) nil)) + (make-byte-to-native-function :name name :data code)) + byte-to-native-top-level-forms)) ;; Output the form by hand, that's much simpler than having ;; b-c-output-file-form analyze the defalias. (byte-compile-output-docform @@ -3070,9 +3113,14 @@ for symbols generated by the byte compiler itself." (not (delq nil (mapcar 'consp (cdr (car body)))))))) (setq rest (cdr rest))) rest)) - (let ((byte-compile-vector (byte-compile-constants-vector))) - (list 'byte-code (byte-compile-lapcode byte-compile-output) - byte-compile-vector byte-compile-maxdepth))) + (let* ((byte-compile-vector (byte-compile-constants-vector)) + (out (list 'byte-code (byte-compile-lapcode byte-compile-output) + byte-compile-vector byte-compile-maxdepth))) + (when byte-native-compiling + ;; Spill LAP for the native compiler here + (push (cons byte-compile-current-form byte-compile-output) + byte-to-native-lap)) + out)) ;; it's a trivial function ((cdr body) (cons 'progn (nreverse body))) ((car body))))) |