diff options
| author | Vibhav Pant | 2017-02-05 19:23:53 +0530 |
|---|---|---|
| committer | Vibhav Pant | 2017-02-05 19:23:53 +0530 |
| commit | cadb044fc2e69266308cdcabe6181be0f624b484 (patch) | |
| tree | e3ce7fbc83647391ea899ca29e72c5ef18d5654b | |
| parent | fea1ad36a0f7b1538984ab0f077095a53c570aa4 (diff) | |
| download | emacs-cadb044fc2e69266308cdcabe6181be0f624b484.tar.gz 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.
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 39 |
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." | |||
| 3133 | ;; happens to be true for byte-code generated by bytecomp.el without | 3133 | ;; happens to be true for byte-code generated by bytecomp.el without |
| 3134 | ;; lexical-binding, but it's not true in general, and it's not true for | 3134 | ;; lexical-binding, but it's not true in general, and it's not true for |
| 3135 | ;; code output by bytecomp.el with lexical-binding. | 3135 | ;; code output by bytecomp.el with lexical-binding. |
| 3136 | (let ((endtag (byte-compile-make-tag))) | 3136 | (let ((endtag (byte-compile-make-tag)) |
| 3137 | last-jump-tag ;; last TAG we have jumped to | ||
| 3138 | last-depth ;; last value of `byte-compile-depth' | ||
| 3139 | last-constant ;; value of the last constant encountered | ||
| 3140 | last-switch ;; whether the last op encountered was byte-switch | ||
| 3141 | switch-tags ;; a list of tags that byte-switch could jump to | ||
| 3142 | ;; a list of tags byte-switch will jump to, if the value doesn't | ||
| 3143 | ;; match any entry in the hash table | ||
| 3144 | switch-default-tags) | ||
| 3137 | (dolist (op lap) | 3145 | (dolist (op lap) |
| 3138 | (cond | 3146 | (cond |
| 3139 | ((eq (car op) 'TAG) (byte-compile-out-tag op)) | 3147 | ((eq (car op) 'TAG) |
| 3140 | ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op))) | 3148 | (when (or (member op switch-tags) (member op switch-default-tags)) |
| 3149 | (when last-jump-tag | ||
| 3150 | (setcdr (cdr last-jump-tag) nil)) | ||
| 3151 | (setq byte-compile-depth last-depth | ||
| 3152 | last-jump-tag nil)) | ||
| 3153 | (byte-compile-out-tag op)) | ||
| 3154 | ((memq (car op) byte-goto-ops) | ||
| 3155 | (setq last-depth byte-compile-depth) | ||
| 3156 | (when last-switch (push (cdr op) switch-default-tags)) | ||
| 3157 | (byte-compile-goto (car op) (cdr op)) | ||
| 3158 | (when last-switch | ||
| 3159 | (setcdr (cdr (cdr op)) nil) | ||
| 3160 | (setq byte-compile-depth last-depth | ||
| 3161 | last-switch nil)) | ||
| 3162 | (setq last-jump-tag (cdr op))) | ||
| 3141 | ((eq (car op) 'byte-return) | 3163 | ((eq (car op) 'byte-return) |
| 3142 | (byte-compile-discard (- byte-compile-depth end-depth) t) | 3164 | (byte-compile-discard (- byte-compile-depth end-depth) t) |
| 3143 | (byte-compile-goto 'byte-goto endtag)) | 3165 | (byte-compile-goto 'byte-goto endtag)) |
| 3144 | (t (byte-compile-out (car op) (cdr op))))) | 3166 | (t |
| 3167 | (when (eq (car op) 'byte-switch) | ||
| 3168 | (push last-constant byte-compile-jump-tables) | ||
| 3169 | (setq last-switch t) | ||
| 3170 | (maphash #'(lambda (_k tag) | ||
| 3171 | (push tag switch-tags)) | ||
| 3172 | last-constant)) | ||
| 3173 | (setq last-constant (and (eq (car op) 'byte-constant) (cadr op))) | ||
| 3174 | (setq last-depth byte-compile-depth) | ||
| 3175 | (byte-compile-out (car op)) (cdr op)))) | ||
| 3145 | (byte-compile-out-tag endtag))) | 3176 | (byte-compile-out-tag endtag))) |
| 3146 | 3177 | ||
| 3147 | (defun byte-compile-unfold-bcf (form) | 3178 | (defun byte-compile-unfold-bcf (form) |