diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7cbef8e434..da0a24c614 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3140,7 +3140,7 @@ byte-compile-inline-lapcode ;; lexical-binding, but it's not true in general, and it's not true for ;; code output by bytecomp.el with lexical-binding. ;; We also restore the value of `byte-compile-depth' and remove TAG depths - ;; accordingly when inlining lapcode containing lap-code, exactly as + ;; accordingly when inlining lapcode which uses `byte-switch', exactly as ;; documented in `byte-compile-cond-jump-table'. (let ((endtag (byte-compile-make-tag)) last-jump-tag ;; last TAG we have jumped to @@ -3148,22 +3148,27 @@ byte-compile-inline-lapcode 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 + last-tag ;; last TAG that we have output + restore-depth ;; if non-nil, `byte-compile-depth' is set to `last-depth' ;; 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) - (when (or (member op switch-tags) (member op switch-default-tags)) + (when (or restore-depth + (member op switch-tags) + (member op switch-default-tags)) ;; This TAG is used in a jump table, this means the last goto ;; was to a done/default TAG, and thus it's cddr should be set to nil. (when last-jump-tag (setcdr (cdr last-jump-tag) nil)) ;; Also, restore the value of `byte-compile-depth' to what it was - ;; before the last goto. + ;; before the last goto/return. (setq byte-compile-depth last-depth - last-jump-tag nil)) - (byte-compile-out-tag op)) + last-jump-tag nil + restore-depth nil)) + (byte-compile-out-tag (setq last-tag op))) ((memq (car op) byte-goto-ops) (setq last-depth byte-compile-depth last-jump-tag (cdr op)) @@ -3176,7 +3181,15 @@ byte-compile-inline-lapcode (setq byte-compile-depth last-depth last-switch nil))) ((eq (car op) 'byte-return) - (byte-compile-discard (- byte-compile-depth end-depth) t) + ;; the byte optimizer replaces some goto's with returns, + ;; we check whether the goto replaced was a jump to a + ;; switch DONETAG, and set `restore-depth' and + ;; `last-depth' accordingly + (if (member last-tag switch-tags) + (progn (setq last-depth byte-compile-depth + restore-depth t) + (byte-compile-discard 1 t)) + (byte-compile-discard (- byte-compile-depth end-depth) t)) (byte-compile-goto 'byte-goto endtag)) (t (when (eq (car op) 'byte-switch) @@ -4031,6 +4044,7 @@ byte-compile-cond-jump-table-info 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. +TEST is either eq, eql or equal. VALUE satisfies `macroexp-const-p'. Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" @@ -4082,7 +4096,7 @@ byte-compile-cond-jump-table donetag (byte-compile-make-tag)) ;; The structure of byte-switch code: ;; - ;; varref var + ;; varref var/stack-ref ;; constant #s(hash-table purecopy t data (val1 (TAG1) val2 (TAG2))) ;; switch ;; goto DEFAULT-TAG @@ -4092,9 +4106,9 @@ byte-compile-cond-jump-table ;; TAG2 ;; ;; goto DONETAG - ;; DEFAULT-TAG + ;; DEFAULT-TAG: ;; - ;; DONETAG + ;; DONETAG: (byte-compile-variable-ref var) (byte-compile-push-constant jump-table) @@ -4114,6 +4128,8 @@ byte-compile-cond-jump-table cases (butlast cases 1))) (dolist (case cases) + ;; TODO: Perhaps use a new tag type (SWITCH-TAG) for this, so we can + ;; recognize and deal with switch bytecode/lapcode more easily. (setq tag (byte-compile-make-tag) test-obj (nth 0 case) body (nth 1 case))