mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-08 07:20:28 -08:00
Code Issues Projects Releases Wiki Activity

add batch-byte-native-compile-for-bootstrap

Browse source
This commit is contained in:
Andrea Corallo 2019-12-29 15:56:49 +01:00
parent e666bf781f
commit 037b9897a4
2 changed files with 29 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

7
lisp/emacs-lisp/bytecomp.el
View file

@ -570,7 +570,9 @@ Each element is (INDEX . VALUE)")
"All other top level forms." "All other top level forms."
form) form)
(defvar byte-native-compiling nil (defvar byte-native-compiling nil
"t while native compiling.") "Non nil while native compiling.")
(defvar byte-native-always-write-elc nil
"Always write the elc file also while native compiling.")
(defvar byte-to-native-lap nil (defvar byte-to-native-lap nil
"A-list to accumulate LAP. "A-list to accumulate LAP.
Each pair is (NAME . LAP)") Each pair is (NAME . LAP)")
@ -2032,7 +2034,8 @@ The value is non-nil if there were no errors, nil if errors."
;; emacs-lisp files in the build tree are ;; emacs-lisp files in the build tree are
;; recompiled). Previously this was accomplished by ;; recompiled). Previously this was accomplished by
;; deleting target-file before writing it. ;; deleting target-file before writing it.
(if byte-native-compiling (if (and byte-native-compiling
(not byte-native-always-write-elc))
(delete-file tempfile) (delete-file tempfile)
(rename-file tempfile target-file t))) (rename-file tempfile target-file t)))
(or noninteractive (message "Wrote %s" target-file))) (or noninteractive (message "Wrote %s" target-file)))

31
lisp/emacs-lisp/comp.el
View file

@ -140,6 +140,13 @@ Can be used by code that wants to expand differently in this case.")
direct-callref) direct-callref)
"Limple operators use to call subrs.") "Limple operators use to call subrs.")
(define-error 'native-compiler-error-dyn-func
"can't native compile a non lexical scoped function"
'native-compiler-error)
(define-error 'native-compiler-error-empty-byte
"empty byte compiler output"
'native-compiler-error)
(eval-when-compile (eval-when-compile
(defconst comp-op-stack-info (defconst comp-op-stack-info
(cl-loop with h = (make-hash-table) (cl-loop with h = (make-hash-table)
@ -390,11 +397,10 @@ Put PREFIX in front of it."
(rx (not (any "0-9a-z_"))) "" human-readable))) (rx (not (any "0-9a-z_"))) "" human-readable)))
(concat prefix crypted "_" human-readable))) (concat prefix crypted "_" human-readable)))
(defun comp-decrypt-arg-list (x) (defun comp-decrypt-arg-list (x function-name)
"Decript argument list X." "Decript argument list X for FUNCTION-NAME."
(unless (fixnump x) (unless (fixnump x)
(signal 'native-compiler-error (signal 'native-compiler-error-dyn-func function-name))
"can't native compile a non lexical scoped function"))
(let ((rest (not (= (logand x 128) 0))) (let ((rest (not (= (logand x 128) 0)))
(mandatory (logand x 127)) (mandatory (logand x 127))
(nonrest (ash x -8))) (nonrest (ash x -8)))
@ -430,7 +436,7 @@ Put PREFIX in front of it."
(comp-log lap 2) (comp-log lap 2)
(let ((arg-list (aref (comp-func-byte-func func) 0))) (let ((arg-list (aref (comp-func-byte-func func) 0)))
(setf (comp-func-args func) (setf (comp-func-args func)
(comp-decrypt-arg-list arg-list) (comp-decrypt-arg-list arg-list function-name)
(comp-func-lap func) (comp-func-lap func)
lap lap
(comp-func-frame-size func) (comp-func-frame-size func)
@ -443,7 +449,7 @@ Put PREFIX in front of it."
"Byte compile FILENAME spilling data from the byte compiler." "Byte compile FILENAME spilling data from the byte compiler."
(byte-compile-file filename) (byte-compile-file filename)
(unless byte-to-native-top-level-forms (unless byte-to-native-top-level-forms
(signal 'native-compiler-error "empty byte compiler output")) (signal 'native-compiler-error-empty-byte filename))
(setf (comp-ctxt-top-level-forms comp-ctxt) (reverse byte-to-native-top-level-forms)) (setf (comp-ctxt-top-level-forms comp-ctxt) (reverse byte-to-native-top-level-forms))
(cl-loop (cl-loop
for f in (cl-loop for x in byte-to-native-top-level-forms ; All non anonymous. for f in (cl-loop for x in byte-to-native-top-level-forms ; All non anonymous.
@ -458,7 +464,7 @@ Put PREFIX in front of it."
:doc (documentation data) :doc (documentation data)
:int-spec (interactive-form data) :int-spec (interactive-form data)
:c-name (comp-c-func-name name "F") :c-name (comp-c-func-name name "F")
:args (comp-decrypt-arg-list (aref data 0)) :args (comp-decrypt-arg-list (aref data 0) name)
:lap (alist-get name byte-to-native-lap) :lap (alist-get name byte-to-native-lap)
:frame-size (comp-byte-frame-size data)) :frame-size (comp-byte-frame-size data))
do (comp-log (format "Function %s:\n" name) 1) do (comp-log (format "Function %s:\n" name) 1)
@ -1911,6 +1917,17 @@ Return the compilation unit file name."
"Ultra cheap impersonation of `batch-byte-compile'." "Ultra cheap impersonation of `batch-byte-compile'."
(mapc #'native-compile command-line-args-left)) (mapc #'native-compile command-line-args-left))
;;;###autoload
(defun batch-byte-native-compile-for-bootstrap ()
"As `batch-byte-compile' but used for booststrap.
Always generate elc files too and handle native compiler expected errors."
;; FIXME remove when dynamic scope support is implemented.
(let ((byte-native-always-write-elc t))
(condition-case _
(batch-native-compile)
(native-compiler-error-dyn-func)
(native-compiler-error-empty-byte))))
;;;###autoload ;;;###autoload
(defun native-compile-async (input &optional jobs recursively) (defun native-compile-async (input &optional jobs recursively)
"Compile INPUT asynchronously. "Compile INPUT asynchronously.