[Emacs-diffs] feature/byte-switch 0d3c57d 1/5: * lisp/emacs-lisp/byte-opt.el: Add support for decompiling switch

[Vibhav Pant]

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

    * lisp/emacs-lisp/byte-opt.el: Add support for decompiling switch
    
    * lisp/emacs-lisp/byte-opt.el: (byte-decompile-bytecode-1) When the
      constant encountered precedes a byte-switch op, replace all the
      addresses in the jump table with tags.
---
 lisp/emacs-lisp/byte-opt.el |   27 ++++++++++++++++++++++++---
 1 file changed, 24 insertions(+), 3 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index c774d26..b775976 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1357,7 +1357,7 @@
 (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
   (let ((length (length bytes))
         (bytedecomp-ptr 0) optr tags bytedecomp-op offset
-       lap tmp)
+       lap tmp last-constant)
     (while (not (= bytedecomp-ptr length))
       (or make-spliceable
          (push bytedecomp-ptr lap))
@@ -1386,7 +1386,8 @@
                            (or (assq tmp byte-compile-variables)
                                 (let ((new (list tmp)))
                                   (push new byte-compile-variables)
-                                  new)))))
+                                  new)))
+                   last-constant tmp))
            ((eq bytedecomp-op 'byte-stack-set2)
             (setq bytedecomp-op 'byte-stack-set))
            ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80))
@@ -1395,7 +1396,27 @@
             ;; lapcode, we represent this by using a different opcode
             ;; (with the flag removed from the operand).
             (setq bytedecomp-op 'byte-discardN-preserve-tos)
-            (setq offset (- offset #x80))))
+            (setq offset (- offset #x80)))
+            ((eq bytedecomp-op 'byte-switch)
+             (cl-assert (hash-table-p last-constant) nil
+                        "byte-switch used without preceeding hash table")
+             ;; make a copy of constvec to avoid making changes to the
+             ;; original jump table for the compiled function.
+             (setq constvec (cl-map 'vector
+                                    #'(lambda (e)
+                                        (if (eq last-constant e)
+                                            (setq last-constant 
(copy-hash-table e))
+                                          e))
+                                    constvec))
+             (maphash #'(lambda (value tag)
+                          (let (newtag)
+                            (cl-assert (consp tag)
+                                       nil "Invalid address for byte-switch")
+                            (setq newtag (byte-compile-make-tag))
+                            (push (cons (+ (car tag) (lsh (cdr tag) 8)) 
newtag) tags)
+                          (puthash value newtag last-constant)))
+                      last-constant)
+             (setf (nth 2 (cadr lap)) last-constant)))
       ;; lap = ( [ (pc . (op . arg)) ]* )
       (push (cons optr (cons bytedecomp-op (or offset 0)))
             lap)