diff options
| author | Andrea Corallo | 2023-04-05 18:17:58 +0200 |
|---|---|---|
| committer | Andrea Corallo | 2023-04-05 19:12:42 +0200 |
| commit | fa669c4b17c04eff852eb23a6179ccb8fab864db (patch) | |
| tree | 54fb34cebd282f4254c4f8575211bd1353234e2e | |
| parent | a42f4a775bab61581d6b8dbd4fe2eeab55a6ea31 (diff) | |
| download | emacs-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.el | 9 | ||||
| -rw-r--r-- | test/src/comp-resources/comp-test-funcs.el | 13 |
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 ;; |