aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorVibhav Pant2017-02-14 21:47:59 +0530
committerVibhav Pant2017-02-14 21:53:26 +0530
commit71b90192dab8de9825904faaabbaf9548d3db2ab (patch)
tree1e527cbf4c782f63a32d4712d1daabd0e693d2f1
parentc1eb871e92176092a46b74b68655c3c167ccece9 (diff)
downloademacs-71b90192dab8de9825904faaabbaf9548d3db2ab.tar.gz
emacs-71b90192dab8de9825904faaabbaf9548d3db2ab.zip
byte-opt: Replace merged tags in jump tables too. (bug#25716)
* lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): While merging adjacent tags, make sure that the old tag is replaced in all jump tables, if any. This fixes the bytecode VM jumping to the wrong address in compiled cond forms where the body of a clause was a loop of any sort.
-rw-r--r--lisp/emacs-lisp/byte-opt.el12
1 files changed, 11 insertions, 1 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 38f5dcc993b..f3cc3d5992e 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1752,12 +1752,22 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
1752 (setcdr tmp2 lap1) 1752 (setcdr tmp2 lap1)
1753 (setq tmp3 (cdr (memq tmp2 tmp3)))) 1753 (setq tmp3 (cdr (memq tmp2 tmp3))))
1754 (setq lap (delq lap0 lap) 1754 (setq lap (delq lap0 lap)
1755 keep-going t)) 1755 keep-going t)
1756 ;; replace references to tag in jump tables, if any
1757 (dolist (table byte-compile-jump-tables)
1758 (catch 'break
1759 (maphash #'(lambda (value tag)
1760 (when (equal tag lap0)
1761 ;; each tag occurs only once in the jump table
1762 (puthash value lap1 table)
1763 (throw 'break nil)))
1764 table))))
1756 ;; 1765 ;;
1757 ;; unused-TAG: --> <deleted> 1766 ;; unused-TAG: --> <deleted>
1758 ;; 1767 ;;
1759 ((and (eq 'TAG (car lap0)) 1768 ((and (eq 'TAG (car lap0))
1760 (not (rassq lap0 lap)) 1769 (not (rassq lap0 lap))
1770 ;; make sure this tag isn't used in a jump-table
1761 (cl-loop for table in byte-compile-jump-tables 1771 (cl-loop for table in byte-compile-jump-tables
1762 when (member lap0 (hash-table-values table)) 1772 when (member lap0 (hash-table-values table))
1763 return nil finally return t)) 1773 return nil finally return t))