[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 898f929: Fix nativecomp cond-rw pass
From: |
Andrea Corallo |
Subject: |
feature/native-comp 898f929: Fix nativecomp cond-rw pass |
Date: |
Mon, 16 Nov 2020 09:33:14 -0500 (EST) |
branch: feature/native-comp
commit 898f929215cf644c651abf789b564fcbc50ffbdd
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Fix nativecomp cond-rw pass
* lisp/emacs-lisp/comp.el (comp-mvar-symbol-p): Improve it.
(comp-cond-rw-func): Fix logic for multiple predecessor on target
block.
* test/src/comp-tests.el (comp-test-cond-rw-1): New test.
* test/src/comp-test-funcs.el (comp-test-cond-rw-1-1-f)
(comp-test-cond-rw-1-2-f): New functions.
---
lisp/emacs-lisp/comp.el | 25 +++++++++++++++++--------
test/src/comp-test-funcs.el | 10 ++++++++++
test/src/comp-tests.el | 4 ++++
3 files changed, 31 insertions(+), 8 deletions(-)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 397b0fd..c84c254 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -571,9 +571,10 @@ Integer values are handled in the `range' slot.")
(> high most-positive-fixnum))
t))))
-(defsubst comp-mvar-symbol-p (mvar)
+(defun comp-mvar-symbol-p (mvar)
"Return t if MVAR is certainly a symbol."
- (equal (comp-mvar-typeset mvar) '(symbol)))
+ (or (equal (comp-mvar-typeset mvar) '(symbol))
+ (cl-every #'symbolp (comp-mvar-valset mvar))))
(defsubst comp-mvar-cons-p (mvar)
"Return t if MVAR is certainly a cons."
@@ -1999,12 +2000,20 @@ Return the corresponding rhs slot number."
,(and (or 'eq 'eql '= 'equal) test-fn) ,op1 ,op2))
(comment ,_comment-str)
(cond-jump ,cond ,(pred comp-mvar-p) ,bb-1 ,_bb-2))
- (when-let ((target-slot1 (comp-cond-rw-target-slot
- (comp-mvar-slot op1) (car insns-seq) b)))
- (comp-emit-assume target-slot1 op2 bb-1 test-fn))
- (when-let ((target-slot2 (comp-cond-rw-target-slot
- (comp-mvar-slot op2) (car insns-seq) b)))
- (comp-emit-assume target-slot2 op1 bb-1 test-fn))
+ ;; FIXME We guard the target block against having more
+ ;; then one predecessor. The right fix will be to add a
+ ;; new dedicated basic block for the assumptions so we
+ ;; can proceed always.
+ (when (= (length (comp-block-in-edges
+ (gethash bb-1
+ (comp-func-blocks comp-func))))
+ 1)
+ (when-let ((target-slot1 (comp-cond-rw-target-slot
+ (comp-mvar-slot op1) (car insns-seq)
b)))
+ (comp-emit-assume target-slot1 op2 bb-1 test-fn))
+ (when-let ((target-slot2 (comp-cond-rw-target-slot
+ (comp-mvar-slot op2) (car insns-seq)
b)))
+ (comp-emit-assume target-slot2 op1 bb-1 test-fn)))
(cl-return-from in-the-basic-block))))))
(defun comp-cond-rw (_)
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index bcf9fcb..207b645 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -370,6 +370,16 @@
(copy-comp-mvar insn)
insn)))
+(defun comp-test-cond-rw-1-1-f ())
+
+(defun comp-test-cond-rw-1-2-f ()
+ (let ((it (comp-test-cond-rw-1-1-f))
+ (key 't))
+ (if (or (equal it key)
+ (eq key t))
+ it
+ nil)))
+
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index d377b08..bf3f57a 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -449,6 +449,10 @@
https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
'(1 2 3 (4 5 6))))
(should (null (comp-test-copy-insn-f nil))))
+(comp-deftest comp-test-cond-rw-1 ()
+ "Check cond-rw does not break target blocks with multiple predecessor."
+ (should (null (comp-test-cond-rw-1-2-f))))
+
;;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests. ;;
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- feature/native-comp 898f929: Fix nativecomp cond-rw pass,
Andrea Corallo <=