From cadb044fc2e69266308cdcabe6181be0f624b484 Mon Sep 17 00:00:00 2001 From: Vibhav Pant Date: Sun, 5 Feb 2017 19:23:53 +0530 Subject: [PATCH] bytecomp.el: Inline lapcode containing `byte-switch' correctly. * lisp/emacs-lisp/bytecomp.el (byte-compile-inline-lapcode): Restore value of byte-compile-depth after emitting a jump to a tag in a jump table, or default/done tags. Set the depth of final tags for byte-switch to nil after emitting any jumps to them. --- lisp/emacs-lisp/bytecomp.el | 39 +++++++++++++++++++++++++++++++++---- 1 file changed, 35 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b7852c57ebf..6e6c48399e1 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3133,15 +3133,46 @@ for symbols generated by the byte compiler itself." ;; happens to be true for byte-code generated by bytecomp.el without ;; lexical-binding, but it's not true in general, and it's not true for ;; code output by bytecomp.el with lexical-binding. - (let ((endtag (byte-compile-make-tag))) + (let ((endtag (byte-compile-make-tag)) + last-jump-tag ;; last TAG we have jumped to + last-depth ;; last value of `byte-compile-depth' + last-constant ;; value of the last constant encountered + last-switch ;; whether the last op encountered was byte-switch + switch-tags ;; a list of tags that byte-switch could jump to + ;; a list of tags byte-switch will jump to, if the value doesn't + ;; match any entry in the hash table + switch-default-tags) (dolist (op lap) (cond - ((eq (car op) 'TAG) (byte-compile-out-tag op)) - ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op))) + ((eq (car op) 'TAG) + (when (or (member op switch-tags) (member op switch-default-tags)) + (when last-jump-tag + (setcdr (cdr last-jump-tag) nil)) + (setq byte-compile-depth last-depth + last-jump-tag nil)) + (byte-compile-out-tag op)) + ((memq (car op) byte-goto-ops) + (setq last-depth byte-compile-depth) + (when last-switch (push (cdr op) switch-default-tags)) + (byte-compile-goto (car op) (cdr op)) + (when last-switch + (setcdr (cdr (cdr op)) nil) + (setq byte-compile-depth last-depth + last-switch nil)) + (setq last-jump-tag (cdr op))) ((eq (car op) 'byte-return) (byte-compile-discard (- byte-compile-depth end-depth) t) (byte-compile-goto 'byte-goto endtag)) - (t (byte-compile-out (car op) (cdr op))))) + (t + (when (eq (car op) 'byte-switch) + (push last-constant byte-compile-jump-tables) + (setq last-switch t) + (maphash #'(lambda (_k tag) + (push tag switch-tags)) + last-constant)) + (setq last-constant (and (eq (car op) 'byte-constant) (cadr op))) + (setq last-depth byte-compile-depth) + (byte-compile-out (car op)) (cdr op)))) (byte-compile-out-tag endtag))) (defun byte-compile-unfold-bcf (form) -- 2.39.2