summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorVibhav Pant <vibhavp@gmail.com>2017-02-05 19:23:53 +0530
committerVibhav Pant <vibhavp@gmail.com>2017-02-05 19:23:53 +0530
commitcadb044fc2e69266308cdcabe6181be0f624b484 (patch)
treee3ce7fbc83647391ea899ca29e72c5ef18d5654b /lisp/emacs-lisp
parentfea1ad36a0f7b1538984ab0f077095a53c570aa4 (diff)
downloademacs-cadb044fc2e69266308cdcabe6181be0f624b484.tar.gz
emacs-cadb044fc2e69266308cdcabe6181be0f624b484.tar.bz2
emacs-cadb044fc2e69266308cdcabe6181be0f624b484.zip
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.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/bytecomp.el39
1 files changed, 35 insertions, 4 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b7852c57ebf..6e6c48399e1 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)