procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

bytecomp.el: Inline lapcode containing `byte-switch' correctly.

Browse source 
* 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.
This commit is contained in:
Vibhav Pant 2017-02-05 19:23:53 +05:30
parent fea1ad36a0
commit cadb044fc2
1 changed files with 35 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

39
lisp/emacs-lisp/bytecomp.el
View file

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