[Emacs-diffs] feature/byte-switch cadb044: bytecomp.el: Inline lapcode containing `byte-switch' correctly.

[Vibhav Pant]

branch: feature/byte-switch
commit cadb044fc2e69266308cdcabe6181be0f624b484
Author: Vibhav Pant <address@hidden>
Commit: Vibhav Pant <address@hidden>

    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 b7852c5..6e6c483 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)