Mercurial > hg > xemacs-beta
diff lisp/bytecomp.el @ 5474:4dee0387b9de
Merged with trunk.
author | Mats Lidell <matsl@xemacs.org> |
---|---|
date | Tue, 29 Mar 2011 00:02:47 +0200 |
parents | ac37a5f7e5be eac2e6bd5b2c |
children | 248176c74e6b |
line wrap: on
line diff
--- a/lisp/bytecomp.el Thu Mar 17 23:42:59 2011 +0100 +++ b/lisp/bytecomp.el Tue Mar 29 00:02:47 2011 +0200 @@ -4193,20 +4193,22 @@ "Byte-compile and return a `catch' from. If FORM is the result of macroexpanding a `block' form (the TAG argument is -a quoted symbol with a non-nil `cl-block-name' property) and there is no +a quoted symbol with a `cl-block-name' property) and there is no corresponding `return-from' within the block--or equivalently, it was optimized away--just byte compile and return the BODY." (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) - (block (and symbol (symbolp symbol) (get symbol 'cl-block-name))) - (elt (and block (cons block nil))) + (not-present '#:not-present) + (block (and symbol (symbolp symbol) + (get symbol 'cl-block-name not-present))) + (elt (and (not (eq block not-present)) (list block))) (byte-compile-active-blocks - (if block + (if elt (cons elt byte-compile-active-blocks) byte-compile-active-blocks)) (body (byte-compile-top-level (cons 'progn (cddr form)) - (if block nil for-effect)))) - (if (and block (not (cdr elt))) + (and (not elt) for-effect)))) + (if (and elt (not (cdr elt))) ;; A lexical block without any contained return-from clauses: (byte-compile-form body) ;; A normal catch call, or a lexical block with a contained @@ -4366,14 +4368,21 @@ ;; If this form was macroexpanded from `return-from', mark the ;; corresponding block as having been referenced. (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) - (block (and symbol (symbolp symbol) (get symbol 'cl-block-name))) - (assq (and block (assq block byte-compile-active-blocks)))) - (and assq (setcdr assq t))) - (byte-compile-form (nth 1 form)) ;; Push the arguments - (byte-compile-form (nth 2 form)) + (not-present '#:not-present) + (block (if (and symbol (symbolp symbol)) + (get symbol 'cl-block-name not-present) + not-present)) + (assq (and (not (eq block not-present)) + (assq block byte-compile-active-blocks)))) + (if assq + (setcdr assq t) + (if (not (eq block not-present)) + ;; No corresponding enclosing block. + (byte-compile-warn "return-from: no enclosing block named `%s'" + block)))) + (mapc 'byte-compile-form (cdr form)) ;; Push the arguments (byte-compile-out (get (car form) 'byte-opcode) 0) - (pushnew '(null (function-max-args 'throw)) - byte-compile-checks-on-load + (pushnew '(null (function-max-args 'throw)) byte-compile-checks-on-load :test #'equal))) ;;; top-level forms elsewhere