[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 89f0641 3/3: * Some clean-up in comp.el
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 89f0641 3/3: * Some clean-up in comp.el |
|
Date: |
Tue, 29 Sep 2020 11:15:10 -0400 (EDT) |
branch: feature/native-comp
commit 89f064104c25f8b4362ef54d28fd4bce18f6af3b
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
* Some clean-up in comp.el
* lisp/emacs-lisp/comp.el (comp-emit-cond-jump, comp-emit-switch)
(comp-limplify-block, comp-compute-edges)
(comp-ssa-rename, comp-fwprop*, comp-effective-async-max-jobs)
(comp-run-async-workers): Respect max 80 columns.
(batch-byte-native-compile-for-bootstrap): Improve doc + remove
some now unnecessary error handling.
---
lisp/emacs-lisp/comp.el | 73 +++++++++++++++++++++++++++----------------------
1 file changed, 41 insertions(+), 32 deletions(-)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index e1438fb..dec5c8e 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -973,8 +973,9 @@ block.
If NEGATED non null negate the tested condition.
Return value is the fall through block name."
(cl-destructuring-bind (label-num . label-sp) lap-label
- (let* ((bb (comp-block-name (comp-bb-maybe-add (1+ (comp-limplify-pc
comp-pass))
- (comp-sp)))) ; Fall through
block.
+ (let* ((bb (comp-block-name (comp-bb-maybe-add
+ (1+ (comp-limplify-pc comp-pass))
+ (comp-sp)))) ; Fall through block.
(target-sp (+ target-offset (comp-sp)))
(target-addr (comp-label-to-addr label-num))
(target (comp-bb-maybe-add target-addr target-sp))
@@ -1065,8 +1066,9 @@ Return value is the fall through block name."
for n from 1
for last = (= n len)
for m-test = (make-comp-mvar :constant test)
- for target-name = (comp-block-name (comp-bb-maybe-add
(comp-label-to-addr target-label)
- (comp-sp)))
+ for target-name = (comp-block-name (comp-bb-maybe-add
+ (comp-label-to-addr target-label)
+ (comp-sp)))
for ff-bb = (if last
(comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
(comp-sp))
@@ -1562,7 +1564,9 @@ into the C code forwarding the compilation unit."
(let* ((stack-depth (if label-sp
(1- label-sp)
(comp-sp)))
- (next-bb (comp-block-name (comp-bb-maybe-add (comp-limplify-pc
comp-pass) stack-depth))))
+ (next-bb (comp-block-name (comp-bb-maybe-add
+ (comp-limplify-pc comp-pass)
+ stack-depth))))
(unless (comp-block-closed bb)
(comp-emit `(jump ,next-bb))))
(cl-return)))
@@ -1733,14 +1737,17 @@ into the C code forwarding the compilation unit."
(list "block does not end with a branch"
bb
(comp-func-name comp-func)))))
- finally (setf (comp-func-edges comp-func)
- (nreverse (comp-func-edges comp-func)))
- ;; Update edge refs into blocks.
- (cl-loop for edge in (comp-func-edges comp-func)
- do (push edge
- (comp-block-out-edges (comp-edge-src
edge)))
- (push edge
- (comp-block-in-edges (comp-edge-dst
edge))))
+ finally
+ (setf (comp-func-edges comp-func)
+ (nreverse (comp-func-edges comp-func)))
+ ;; Update edge refs into blocks.
+ (cl-loop
+ for edge in (comp-func-edges comp-func)
+ do
+ (push edge
+ (comp-block-out-edges (comp-edge-src edge)))
+ (push edge
+ (comp-block-in-edges (comp-edge-dst edge))))
(comp-log-edges comp-func))))
(defun comp-collect-rev-post-order (basic-block)
@@ -1932,10 +1939,11 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
(setf (comp-block-final-frame bb)
(copy-sequence in-frame))
(when-let ((out-edges (comp-block-out-edges bb)))
- (cl-loop for ed in out-edges
- for child = (comp-edge-dst ed)
- ;; Provide a copy of the same frame to all
childs.
- do (ssa-rename-rec child (copy-sequence
in-frame)))))))
+ (cl-loop
+ for ed in out-edges
+ for child = (comp-edge-dst ed)
+ ;; Provide a copy of the same frame to all children.
+ do (ssa-rename-rec child (copy-sequence in-frame)))))))
(ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func))
(comp-new-frame frame-size t)))))
@@ -2118,7 +2126,8 @@ Return t if something was changed."
(cl-loop with modified = nil
for b being each hash-value of (comp-func-blocks comp-func)
do (cl-loop for insn in (comp-block-insns b)
- for orig-insn = (unless modified ; Save consing after
1th change.
+ for orig-insn = (unless modified
+ ;; Save consing after 1th change.
(comp-copy-insn insn))
do (comp-fwprop-insn insn)
when (and (null modified) (not (equal insn orig-insn)))
@@ -2689,9 +2698,11 @@ processes from `comp-async-compilations'"
;; the number of processors, see get_native_system_info in
w32.c.
;; The result needs to be exported to Lisp.
(max 1 (/ (cond ((eq 'windows-nt system-type)
- (string-to-number (getenv
"NUMBER_OF_PROCESSORS")))
+ (string-to-number (getenv
+ "NUMBER_OF_PROCESSORS")))
((executable-find "nproc")
- (string-to-number (shell-command-to-string
"nproc")))
+ (string-to-number
+ (shell-command-to-string "nproc")))
(t 1))
2))))
comp-async-jobs-number))
@@ -2712,8 +2723,8 @@ display a message."
when (or comp-always-compile
load ; Always compile when the compilation is
; commanded for late load.
- (file-newer-than-file-p source-file
- (comp-el-to-eln-filename
source-file)))
+ (file-newer-than-file-p
+ source-file (comp-el-to-eln-filename source-file)))
do (let* ((expr `(progn
(require 'comp)
(setf comp-speed ,comp-speed
@@ -2841,21 +2852,18 @@ Ultra cheap impersonation of `batch-byte-compile'."
;;;###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."
+Generate .elc files in addition to the .eln one. If the
+environment variable 'NATIVE_DISABLED' is set byte compile only."
(comp-ensure-native-compiler)
(if (equal (getenv "NATIVE_DISABLED") "1")
(batch-byte-compile)
(cl-assert (= 1 (length command-line-args-left)))
(let ((byte-native-for-bootstrap t)
(byte-to-native-output-file nil))
- (unwind-protect
- (condition-case _
- (batch-native-compile)
- (native-compiler-error-dyn-func)
- (native-compiler-error-empty-byte))
- (pcase byte-to-native-output-file
- (`(,tempfile . ,target-file)
- (rename-file tempfile target-file t)))))))
+ (batch-native-compile)
+ (pcase byte-to-native-output-file
+ (`(,tempfile . ,target-file)
+ (rename-file tempfile target-file t))))))
;;;###autoload
(defun native-compile-async (paths &optional recursively load)
@@ -2874,7 +2882,8 @@ LOAD can be nil t or 'late."
(dolist (path paths)
(cond ((file-directory-p path)
(dolist (file (if recursively
- (directory-files-recursively path
comp-valid-source-re)
+ (directory-files-recursively
+ path comp-valid-source-re)
(directory-files path t comp-valid-source-re)))
(push file files)))
((file-exists-p path) (push path files))