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.

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 397b0fd70b530b0086b0dd8716f9d0de4d86409c..c84c254e585cdbeaed244ea731bb6a4b07ecc794 100644 (file)
--- 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 bcf9fcb0fd157fe7ef1f9962092abb1ed3f2c726..207b6455f7328cbafd70ec346483f8f36f5b6ec9 100644 (file)
--- 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)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index d377b089932afe3d3fd1413a94d90493e7a34df6..bf3f57a85e332c50c037fd850177efd496433915 100644 (file)
--- 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))))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;