Add new 'switch' byte-code.

'switch' takes two arguments from the stack: the variable to test, and
a jump table (implemented as a hash-table with the appropriate :test
function). By looking up the value of the variable in the hash table,
the interpreter can jump to the label pointed to by the value, if any.
This implementation can only be used for `cond' forms of the type
`(cond ((test x 'foo) 'bar) ...)`, such that the function `test` and
variable `x` is same for all clauses.

* lisp/emacs-lisp/bytecomp.el:

  * Add (byte-compile-cond-valid-obj2-p), (byte-compile-cond-vars),
    (byte-compile-cond-jump-table-info), (byte-compile-jump-table-add-tag),
    (byte-compile-cond-jump-table), byte-compile-jump-tables.

  * Add defcustom `byte-compile-cond-use-jump-table'.

  * (byte-compile-cond): Use them.

  * (byte-compile-lapcode): Patch tags present in jump tables, if any.

* lisp/emacs-lisp//byte-opt.el: (byte-optimize-lapcode): Add checks to
  some peephole optimizations to prevent them from messing up any code
  involving `byte-switch`.

* src/bytecode.c: (exec_byte_code): Add bytecode Bswitch.

1 files changed, 11 insertions, 3 deletions

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 13f885448ae..9412ce3b26d 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -185,6 +185,7 @@
 (require 'bytecomp)
 (eval-when-compile (require 'cl-lib))
 (require 'macroexp)
+(require 'subr-x)
 
 (defun byte-compile-log-lap-1 (format &rest args)
   ;; Newer byte codes for stack-ref make the slot 0 non-nil again.
@@ -1728,7 +1729,11 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	      ;; unused-TAG: --> <deleted>
 	      ;;
 	      ((and (eq 'TAG (car lap0))
-		    (not (rassq lap0 lap)))
+		    (not (rassq lap0 lap))
+                    (= (length (cl-loop for table in byte-compile-jump-tables
+                                        when (member lap0 (hash-table-values table))
+                                        collect t))
+                       0))
 	       (and (memq byte-optimize-log '(t byte))
 		    (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
 	       (setq lap (delq lap0 lap)
@@ -1736,9 +1741,12 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	      ;;
 	      ;; goto   ... --> goto   <delete until TAG or end>
 	      ;; return ... --> return <delete until TAG or end>
-	      ;;
+	      ;; (unless a jump-table is being used, where deleting may affect
+              ;; other valid case bodies)
+              ;;
 	      ((and (memq (car lap0) '(byte-goto byte-return))
-		    (not (memq (car lap1) '(TAG nil))))
+		    (not (memq (car lap1) '(TAG nil)))
+                    (not byte-compile-jump-tables))
 	       (setq tmp rest)
 	       (let ((i 0)
 		     (opt-p (memq byte-optimize-log '(t lap)))