;; 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)