emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH]: Add new bytecode op `switch' for implementing branch tables.


From: Vibhav Pant
Subject: [PATCH]: Add new bytecode op `switch' for implementing branch tables.
Date: Mon, 6 Feb 2017 23:20:06 +0530

The following patch adds support for a new op `switch` to the Emacs bytecode VM
and compiler. As described in etc/TODO, switch takes 2 arguments from the stack:
a value to test, and a hash table from the constant pool. It then jumps to the
"address" the value in the hash-table maps to. This replaces the traditional
goto/goto-if-(not)-nil bytecode for cond forms, with a smaller and
more performant
bytecode. Currently, certain cond forms like:
(cond ((eq v 1) 'foo)
      ((eq v 'bar) 'baz)
      (t 'blah))
are compiled using byte- switch. The structure of switch bytecode for
the cond form
above is as follows:

varref v
constant #s(hash-table data (1 TAG1 bar TAG2))
switch
goto DEFAULT-TAG
TAG1:
constant 1
goto DONETAG
TAG2:
constant 'baz
goto DONETAG
DEFAULT-TAG:
constant 'blah ;; 'blah is 'nil' when there is no 't' clause.
DONETAG:
...

(This should also work with `pcase' forms, as it expands to a `cond')
The hash table used as the jump table for switch maps possible values to a cons
pair of two numbers. The jump address for the value is found by calculating
car(pair) + (cdr(pair) << 8), an inexpensive operation. The hash table is also
declared with :purecopy t, as it is always constant and can thus be copied
to pure storage.

However, since switch replaces all goto-if-nil code, I've used a few workarounds
to avoid breaking compiler invariants:

* byte-compile-cond-jump-table: After emitting an unconditional jump to DONETAG,
(cdr (cdr DONETAG)) is set to nil, and the value of byte-compile-depth is
restored (unconditional jumps set it to nil). This is to avoid depth conflicts
down the road, and is documented in `byte-compile-cond-jump-table'.

* byte-compile-inline-lapcode also replicates this behavior if any lapcode
containing byte-switch is being inlined.

Aside from this, the peephole optimizer in byte-opt.el has been
modified so as to
not screw up switch bytecode (and has been documented as well). disass.el has
also been changed to the show contents of the jump table with the correct tags.
Lastly, I've added a defcustom `byte-compile-cond-use-jump-table', which when
nil will use the original goto-if-(not)-nil bytecode while compiling cond. This
is a workaround for when `byte-compile-cond-jump-table' accidentally generates
wrong code (hasn't happened so far in my tests), and should be removed
once we're
sure there are no issues with it.

The code for this feature is in the branch 'feature/byte-switch',
feedback would be
appreciated.

-- 
Vibhav Pant
address@hidden

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 13f885448a..888a5f8500 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.
@@ -1356,7 +1357,7 @@ byte-decompile-bytecode
 (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))
@@ -1385,7 +1386,8 @@ byte-decompile-bytecode-1
     (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))
@@ -1394,7 +1396,34 @@ byte-decompile-bytecode-1
      ;; 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")
+             ;; We cannot use the original hash table referenced in the op,
+             ;; so we create a copy of it, and replace the addresses with
+             ;; TAGs.
+             (let ((orig-table last-constant))
+               (cl-loop for e across constvec
+                        when (eq e last-constant)
+                        do (setq last-constant (copy-hash-table e))
+                        and return nil)
+               ;; Replace all addresses with TAGs.
+               (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)
+               ;; Replace the hash table referenced in the lapcode with our
+               ;; modified one.
+               (cl-loop for el in-ref lap
+                        when (and (listp el) ;; make sure we're at
the correct op
+                                  (eq (nth 1 el) 'byte-constant)
+                                  (eq (nth 2 el) orig-table))
+                        do (setf (nth 2 el) last-constant) and return nil))))
       ;; lap = ( [ (pc . (op . arg)) ]* )
       (push (cons optr (cons bytedecomp-op (or offset 0)))
             lap)
@@ -1728,7 +1757,10 @@ byte-optimize-lapcode
       ;; unused-TAG: --> <deleted>
       ;;
       ((and (eq 'TAG (car lap0))
-    (not (rassq lap0 lap)))
+    (not (rassq lap0 lap))
+                    (cl-loop for table in byte-compile-jump-tables
+                             when (member lap0 (hash-table-values table))
+                             return nil finally return t))
        (and (memq byte-optimize-log '(t byte))
     (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
        (setq lap (delq lap0 lap)
@@ -1736,9 +1768,15 @@ byte-optimize-lapcode
       ;;
       ;; 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)))
+                    ;; FIXME: Instead of deferring simply when jump-tables are
+                    ;; being used, keep a list of tags used for switch tags and
+                    ;; use them instead (see `byte-compile-inline-lapcode').
+                    (not byte-compile-jump-tables))
        (setq tmp rest)
        (let ((i 0)
      (opt-p (memq byte-optimize-log '(t lap)))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 63be7e208b..d5a163e5fd 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -223,6 +223,11 @@ byte-compile-delete-errors
   :group 'bytecomp
   :type 'boolean)

+(defcustom byte-compile-cond-use-jump-table t
+  "Compile `cond' clauses to a jump table implementation (using a hash-table)."
+  :group 'bytecomp
+  :type 'boolean)
+
 (defvar byte-compile-dynamic nil
   "If non-nil, compile function bodies so they load lazily.
 They are hidden in comments in the compiled file,
@@ -412,6 +417,8 @@ byte-compile-call-tree-sort
  (const calls+callers) (const nil)))

 (defvar byte-compile-debug nil)
+(defvar byte-compile-jump-tables nil
+  "List of all jump tables used during compilation of this form.")
 (defvar byte-compile-constants nil
   "List of all constants encountered during compilation of this form.")
 (defvar byte-compile-variables nil
@@ -747,6 +754,10 @@ byte-extrude-byte-code-vectors
 ;; `byte-compile-lapcode').
 (defconst byte-discardN-preserve-tos byte-discardN)

+(byte-defop 183 -2 byte-switch
+ "to take a hash table and a value from the stack, and jump to the address
+the value maps to, if any.")
+
 ;; unused: 182-191

 (byte-defop 192  1 byte-constant "for reference to a constant")
@@ -823,7 +834,7 @@ byte-compile-lapcode
  op off ; Operation & offset
  opcode ; numeric value of OP
  (bytes '()) ; Put the output bytes here
- (patchlist nil)) ; List of gotos to patch
+ (patchlist nil))        ; List of gotos to patch
     (dolist (lap-entry lap)
       (setq op (car lap-entry)
     off (cdr lap-entry))
@@ -905,6 +916,11 @@ byte-compile-lapcode
       ;; FIXME: Replace this by some workaround.
       (if (> (car bytes-tail) 255) (error "Bytecode overflow")))

+    (dolist (hash-table byte-compile-jump-tables)
+      (cl-loop for k being the hash-keys of hash-table do
+               (let ((tag (cdr (gethash k hash-table))))
+                 (setq pc (car tag))
+                 (puthash k (cons (logand pc 255) (lsh pc -8)) hash-table))))
     (apply 'unibyte-string (nreverse bytes))))


@@ -1954,7 +1970,8 @@ byte-compile-from-buffer
 ;; (edebug-all-defs nil)
 ;; (edebug-all-forms nil)
  ;; Simulate entry to byte-compile-top-level
- (byte-compile-constants nil)
+        (byte-compile-jump-tables nil)
+        (byte-compile-constants nil)
  (byte-compile-variables nil)
  (byte-compile-tag-number 0)
  (byte-compile-depth 0)
@@ -2250,7 +2267,8 @@ byte-compile-flush-pending
       byte-compile-variables nil
       byte-compile-depth 0
       byte-compile-maxdepth 0
-      byte-compile-output nil))))
+      byte-compile-output nil
+              byte-compile-jump-tables nil))))

 (defvar byte-compile-force-lexical-warnings nil)

@@ -2862,7 +2880,8 @@ byte-compile-top-level
  (byte-compile-maxdepth 0)
         (byte-compile--lexical-environment lexenv)
         (byte-compile-reserved-constants (or reserved-csts 0))
- (byte-compile-output nil))
+ (byte-compile-output nil)
+        (byte-compile-jump-tables nil))
     (if (memq byte-optimize '(t source))
  (setq form (byte-optimize-form form byte-compile--for-effect)))
     (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
@@ -3114,15 +3133,49 @@ byte-compile-inline-lapcode
   ;; 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)))
+  ;; We also restore the value of `byte-compile-depth' and remove TAG depths
+  ;; accordingly when inlining byte-switch lap code, as documented in
+  ;; `byte-compile-cond-jump-table'.
+  (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
+              last-jump-tag (cdr op))
+        (byte-compile-goto (car op) (cdr op))
+        (when last-switch
+          (push (cdr op) switch-default-tags)
+          (setcdr (cdr (cdr op)) nil)
+          (setq byte-compile-depth last-depth
+                last-switch nil)))
        ((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)
@@ -3951,37 +4004,162 @@ byte-compile-if
  (byte-compile-out-tag donetag))))
   (setq byte-compile--for-effect nil))

+(defun byte-compile-cond-vars (obj1 obj2)
+  ;; We make sure that of OBJ1 and OBJ2, one of them is a symbol,
+  ;; and the other is a constant expression whose value can be
+  ;; compared with `eq' (with `macroexp-const-p').
+  (or
+   (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2))
+   (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1))))
+
+(defun byte-compile-cond-jump-table-info (clauses)
+  "If CLAUSES is a `cond' form where:
+The condition for each clause is of the form (TEST VAR VALUE).
+VAR is a variable.
+TEST and VAR are the same throughout all conditions.
+VALUE is either a constant or a quoted form.
+
+Return a list of the form ((TEST . VAR)  ((VALUE BODY) ...))"
+  (let ((cases '())
+        (ok t)
+        prev-var prev-test)
+    (and (catch 'break
+           (dolist (clause (cdr clauses) ok)
+             (let* ((condition (car clause))
+                    (test (car-safe condition))
+                    (vars (when (consp condition)
+                            (byte-compile-cond-vars (cadr condition)
(cl-caddr condition))))
+                    (obj1 (car-safe vars))
+                    (obj2 (cdr-safe vars))
+                    (body (cdr-safe clause)))
+               (unless prev-var
+                 (setq prev-var obj1))
+               (unless prev-test
+                 (setq prev-test test))
+               (if (and obj1 (memq test '(eq eql equal))
+                        (consp condition)
+                        (eq test prev-test)
+                        (eq obj1 prev-var)
+                        ;; discard duplicate clauses
+                        (not (assq obj2 cases)))
+                   (push (list (if (consp obj2) (eval obj2) obj2) body) cases)
+                 (if (eq condition t)
+                     (progn (push (list 'default body) cases)
+                            (throw 'break t))
+                   (setq ok nil)
+                   (throw 'break nil))))))
+         (list (cons prev-test prev-var) (nreverse cases)))))
+
+(defun byte-compile-cond-jump-table (clauses)
+  (let* ((table-info (byte-compile-cond-jump-table-info clauses))
+         (test (caar table-info))
+         (var (cdar table-info))
+         (cases (cadr table-info))
+         jump-table test-obj body tag donetag default-tag default-case)
+    (when (and cases (not (= (length cases) 1)))
+      ;; TODO: Once :linear-search is implemented for `make-hash-table'
+      ;; set it to `t' for cond forms with a small number of cases.
+      (setq jump-table (make-hash-table :test test
+                                        :purecopy t
+                                        :size (if (assq 'default cases)
+                                                  (1- (length cases))
+                                                (length cases)))
+            default-tag (byte-compile-make-tag)
+            donetag (byte-compile-make-tag))
+      ;; The structure of byte-switch code:
+      ;;
+      ;; varref var
+      ;; constant #s(hash-table purecopy t data (val1 (TAG1) val2 (TAG2)))
+      ;; switch
+      ;; goto DEFAUT-TAG
+      ;; TAG1
+      ;; <clause body>
+      ;; goto DONETAG
+      ;; TAG2
+      ;; <clause body>
+      ;; goto DONETAG
+      ;; DEFAULT-TAG
+      ;; <body for `t' clause, if any (else `constant nil')>
+      ;; DONETAG
+
+      (byte-compile-variable-ref var)
+      (byte-compile-push-constant jump-table)
+      (byte-compile-out 'byte-switch)
+
+      ;; When the opcode argument is `byte-goto', `byte-compile-goto' sets
+      ;; `byte-compile-depth' to `nil'. However, we need `byte-compile-depth'
+      ;; to be non-nil for generating tags for all cases. Since
+      ;; `byte-compile-depth' will increase by atmost 1 after compiling
+      ;; all of the clause (which is further enforced by cl-assert below)
+      ;; it should be safe to preserve it's value.
+      (let ((byte-compile-depth byte-compile-depth))
+        (byte-compile-goto 'byte-goto default-tag))
+
+      (when (assq 'default cases)
+        (setq default-case (cadr (assq 'default cases))
+              cases (butlast cases 1)))
+
+      (dolist (case cases)
+        (setq tag (byte-compile-make-tag)
+              test-obj (nth 0 case)
+              body (nth 1 case))
+        (byte-compile-out-tag tag)
+        (puthash test-obj tag jump-table)
+
+        (let ((byte-compile-depth byte-compile-depth)
+              (init-depth byte-compile-depth))
+          ;; Since `byte-compile-body' might increase `byte-compile-depth'
+          ;; by 1, not preserving it's value will cause it to potentially
+          ;; increase by one for every clause body compiled, causing
+          ;; depth/tag conflicts or violating asserts down the road.
+          ;; To make sure `byte-compile-body' itself doesn't violate this,
+          ;; we use `cl-assert'.
+          (byte-compile-body body byte-compile--for-effect)
+          (cl-assert (or (= byte-compile-depth init-depth)
+                         (= byte-compile-depth (1+ init-depth))))
+          (byte-compile-goto 'byte-goto donetag)
+          (setcdr (cdr donetag) nil)))
+
+      (byte-compile-out-tag default-tag)
+      (if default-case
+          (byte-compile-body-do-effect default-case)
+        (byte-compile-constant nil))
+      (byte-compile-out-tag donetag)
+      (push jump-table byte-compile-jump-tables))))
+
 (defun byte-compile-cond (clauses)
-  (let ((donetag (byte-compile-make-tag))
- nexttag clause)
-    (while (setq clauses (cdr clauses))
-      (setq clause (car clauses))
-      (cond ((or (eq (car clause) t)
- (and (eq (car-safe (car clause)) 'quote)
-      (car-safe (cdr-safe (car clause)))))
-     ;; Unconditional clause
-     (setq clause (cons t clause)
-   clauses nil))
-    ((cdr clauses)
-     (byte-compile-form (car clause))
-     (if (null (cdr clause))
- ;; First clause is a singleton.
- (byte-compile-goto-if t byte-compile--for-effect donetag)
-       (setq nexttag (byte-compile-make-tag))
-       (byte-compile-goto 'byte-goto-if-nil nexttag)
-       (byte-compile-maybe-guarded (car clause)
- (byte-compile-body (cdr clause) byte-compile--for-effect))
-       (byte-compile-goto 'byte-goto donetag)
-       (byte-compile-out-tag nexttag)))))
-    ;; Last clause
-    (let ((guard (car clause)))
-      (and (cdr clause) (not (eq guard t))
-   (progn (byte-compile-form guard)
-  (byte-compile-goto-if nil byte-compile--for-effect donetag)
-  (setq clause (cdr clause))))
-      (byte-compile-maybe-guarded guard
- (byte-compile-body-do-effect clause)))
-    (byte-compile-out-tag donetag)))
+  (or (and byte-compile-cond-use-jump-table
+           (byte-compile-cond-jump-table clauses))
+    (let ((donetag (byte-compile-make-tag))
+          nexttag clause)
+      (while (setq clauses (cdr clauses))
+        (setq clause (car clauses))
+        (cond ((or (eq (car clause) t)
+                   (and (eq (car-safe (car clause)) 'quote)
+                        (car-safe (cdr-safe (car clause)))))
+               ;; Unconditional clause
+               (setq clause (cons t clause)
+                     clauses nil))
+              ((cdr clauses)
+               (byte-compile-form (car clause))
+               (if (null (cdr clause))
+                   ;; First clause is a singleton.
+                   (byte-compile-goto-if t byte-compile--for-effect donetag)
+                 (setq nexttag (byte-compile-make-tag))
+                 (byte-compile-goto 'byte-goto-if-nil nexttag)
+                 (byte-compile-maybe-guarded (car clause)
+                   (byte-compile-body (cdr clause) byte-compile--for-effect))
+                 (byte-compile-goto 'byte-goto donetag)
+                 (byte-compile-out-tag nexttag)))))
+      ;; Last clause
+      (let ((guard (car clause)))
+        (and (cdr clause) (not (eq guard t))
+             (progn (byte-compile-form guard)
+                    (byte-compile-goto-if nil byte-compile--for-effect donetag)
+                    (setq clause (cdr clause))))
+        (byte-compile-maybe-guarded guard
+          (byte-compile-body-do-effect clause)))
+      (byte-compile-out-tag donetag))))

 (defun byte-compile-and (form)
   (let ((failtag (byte-compile-make-tag))
@@ -4528,7 +4706,7 @@ byte-compile-out-tag
  (and byte-compile-depth
              (not (= (cdr (cdr tag)) byte-compile-depth))
              (error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
- (setq byte-compile-depth (cdr (cdr tag))))
+         (setq byte-compile-depth (cdr (cdr tag))))
     (setcdr (cdr tag) byte-compile-depth)))

 (defun byte-compile-goto (opcode tag)
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 97e45e070d..66673b4d26 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -221,9 +221,21 @@ disassemble-1
  ((memq op '(byte-constant byte-constant2))
  ;; it's a constant
  (setq arg (car arg))
- ;; but if the value of the constant is compiled code, then
- ;; recursively disassemble it.
- (cond ((or (byte-code-function-p arg)
+                 ;; if the succeeding op is byte-switch, display the jump table
+                 ;; used
+ (cond ((eq (car-safe (car-safe (cdr lap))) 'byte-switch)
+                         (insert (format "<jump-table-%s ("
(hash-table-test arg)))
+                         (let ((first-time t))
+                           (maphash #'(lambda (value tag)
+                                        (if first-time
+                                            (setq first-time nil)
+                                          (insert " "))
+                                        (insert (format "%s %s" value
(cadr tag))))
+                                    arg))
+                         (insert ")>"))
+                  ;; if the value of the constant is compiled code, then
+                  ;; recursively disassemble it.
+                  ((or (byte-code-function-p arg)
     (and (consp arg) (functionp arg)
  (assq 'byte-code arg))
     (and (eq (car-safe arg) 'macro)
diff --git a/src/bytecode.c b/src/bytecode.c
index 0f7420c19e..f9531761b3 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -267,6 +267,8 @@ DEFINE (Bstack_set,  0262) \
 DEFINE (Bstack_set2, 0263) \
 DEFINE (BdiscardN,   0266) \
  \
+DEFINE (Bswitch, 0267)                                                  \
+                                                                        \
 DEFINE (Bconstant, 0300)

 enum byte_code_op
@@ -1411,6 +1413,25 @@ exec_byte_code (Lisp_Object bytestr,
Lisp_Object vector, Lisp_Object maxdepth,
   DISCARD (op);
   NEXT;

+        CASE (Bswitch):
+          {
+            Lisp_Object jmp_table = POP;
+            Lisp_Object v1 = POP;
+#ifdef BYTE_CODE_SAFE
+            CHECK_TYPE (HASH_TABLE_P (jmp_table), Qhash_table_p, jmp_table);
+#endif
+            struct Lisp_Hash_Table *h = XHASH_TABLE(jmp_table);
+            ptrdiff_t i = hash_lookup(h, v1, NULL);
+            if (i >= 0) {
+              Lisp_Object dest = HASH_VALUE(h, i);
+              int car = XINT(XCAR(dest));
+              int cdr = XINT(XCDR(dest));
+              op = car + (cdr << 8); /* Simulate FETCH2 */
+              goto op_branch;
+            }
+          }
+          NEXT;
+
  CASE_DEFAULT
  CASE (Bconstant):
   if (BYTE_CODE_SAFE

Attachment: switch.diff
Description: Text document


reply via email to

[Prev in Thread] Current Thread [Next in Thread]