aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2023-04-05 18:17:58 +0200
committerAndrea Corallo2023-04-05 19:12:42 +0200
commitfa669c4b17c04eff852eb23a6179ccb8fab864db (patch)
tree54fb34cebd282f4254c4f8575211bd1353234e2e
parenta42f4a775bab61581d6b8dbd4fe2eeab55a6ea31 (diff)
downloademacs-fa669c4b17c04eff852eb23a6179ccb8fab864db.tar.gz
emacs-fa669c4b17c04eff852eb23a6179ccb8fab864db.zip
Comp: Fix limplification pass (bug#62537)
* test/src/comp-resources/comp-test-funcs.el (comp-test-62537-1-f) (comp-test-62537-2-f): New functions. * lisp/emacs-lisp/comp.el (comp-jump-table-optimizable): Make it stricter add a comment.
-rw-r--r--lisp/emacs-lisp/comp.el9
-rw-r--r--test/src/comp-resources/comp-test-funcs.el13
2 files changed, 21 insertions, 1 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 841b0ebf29d..025d21631bb 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1712,6 +1712,10 @@ Return value is the fall-through block name."
1712 1712
1713(defun comp-jump-table-optimizable (jmp-table) 1713(defun comp-jump-table-optimizable (jmp-table)
1714 "Return t if JMP-TABLE can be optimized out." 1714 "Return t if JMP-TABLE can be optimized out."
1715 ;; Identify LAP sequences like:
1716 ;; (byte-constant #s(hash-table size 3 test eq rehash-size 1.5 rehash-threshold 0.8125 purecopy t data (created 126 deleted 126 changed 126)) . 24)
1717 ;; (byte-switch)
1718 ;; (TAG 126 . 10)
1715 (cl-loop 1719 (cl-loop
1716 with labels = (cl-loop for target-label being each hash-value of jmp-table 1720 with labels = (cl-loop for target-label being each hash-value of jmp-table
1717 collect target-label) 1721 collect target-label)
@@ -1719,7 +1723,10 @@ Return value is the fall-through block name."
1719 for l in (cdr-safe labels) 1723 for l in (cdr-safe labels)
1720 unless (= l x) 1724 unless (= l x)
1721 return nil 1725 return nil
1722 finally return t)) 1726 finally return (pcase (nth (1+ (comp-limplify-pc comp-pass))
1727 (comp-func-lap comp-func))
1728 (`(TAG ,label . ,_label-sp)
1729 (= label l)))))
1723 1730
1724(defun comp-emit-switch (var last-insn) 1731(defun comp-emit-switch (var last-insn)
1725 "Emit a Limple for a lap jump table given VAR and LAST-INSN." 1732 "Emit a Limple for a lap jump table given VAR and LAST-INSN."
diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el
index fff881dd595..73da7182a54 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -518,6 +518,19 @@
518(defun comp-test-48029-nonascii-žžž-f (arg) 518(defun comp-test-48029-nonascii-žžž-f (arg)
519 (when arg t)) 519 (when arg t))
520 520
521(defun comp-test-62537-1-f ())
522
523(defun comp-test-62537-2-f ()
524 (when (let ((val (comp-test-62537-1-f)))
525 (cond
526 ((eq val 'x)
527 t)
528 ((eq val 'y)
529 'y)))
530 (comp-test-62537-1-f))
531 t)
532
533
521 534
522;;;;;;;;;;;;;;;;;;;; 535;;;;;;;;;;;;;;;;;;;;
523;; Tromey's tests ;; 536;; Tromey's tests ;;