Mercurial > hg > xemacs-beta

comparison lisp/bytecomp.el @ 5377:eac2e6bd5b2c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Correct some minor problems in my last change. 2011-03-17 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-catch): * bytecomp.el (byte-compile-throw): Correct some minor problems in my last change. Happy St. Patrick's day, everyone!
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 17 Mar 2011 21:50:34 +0000
parents 4b529b940e2e
children f9dc75bdbdc4 4dee0387b9de
comparison
equal deleted inserted replaced
5376:4b529b940e2e 5377:eac2e6bd5b2c
4207 (if elt 4207 (if elt
4208 (cons elt byte-compile-active-blocks) 4208 (cons elt byte-compile-active-blocks)
4209 byte-compile-active-blocks)) 4209 byte-compile-active-blocks))
4210 (body 4210 (body
4211 (byte-compile-top-level (cons 'progn (cddr form)) 4211 (byte-compile-top-level (cons 'progn (cddr form))
4212 (and elt for-effect)))) 4212 (and (not elt) for-effect))))
4213 (if (and elt (not (cdr elt))) 4213 (if (and elt (not (cdr elt)))
4214 ;; A lexical block without any contained return-from clauses: 4214 ;; A lexical block without any contained return-from clauses:
4215 (byte-compile-form body) 4215 (byte-compile-form body)
4216 ;; A normal catch call, or a lexical block with a contained 4216 ;; A normal catch call, or a lexical block with a contained
4217 ;; return-from clause. 4217 ;; return-from clause.
4369 ,(length (cdr form)))))) 4369 ,(length (cdr form))))))
4370 ;; If this form was macroexpanded from `return-from', mark the 4370 ;; If this form was macroexpanded from `return-from', mark the
4371 ;; corresponding block as having been referenced. 4371 ;; corresponding block as having been referenced.
4372 (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) 4372 (let* ((symbol (car-safe (cdr-safe (nth 1 form))))
4373 (not-present '#:not-present) 4373 (not-present '#:not-present)
4374 (block (and symbol (symbolp symbol) 4374 (block (if (and symbol (symbolp symbol))
4375 (get symbol 'cl-block-name not-present))) 4375 (get symbol 'cl-block-name not-present)
4376 not-present))
4376 (assq (and (not (eq block not-present)) 4377 (assq (and (not (eq block not-present))
4377 (assq block byte-compile-active-blocks)))) 4378 (assq block byte-compile-active-blocks))))
4378 (when assq 4379 (if assq
4379 (setcdr assq t)) 4380 (setcdr assq t)
4380 (when (not (eq block not-present)) 4381 (if (not (eq block not-present))
4381 ;; No corresponding enclosing block. 4382 ;; No corresponding enclosing block.
4382 (byte-compile-warn "return-from: no enclosing block named `%s'" 4383 (byte-compile-warn "return-from: no enclosing block named `%s'"
4383 block))) 4384 block))))
4384 (mapc 'byte-compile-form (cdr form)) ;; Push the arguments 4385 (mapc 'byte-compile-form (cdr form)) ;; Push the arguments
4385 (byte-compile-out (get (car form) 'byte-opcode) 0) 4386 (byte-compile-out (get (car form) 'byte-opcode) 0)
4386 (pushnew '(null (function-max-args 'throw)) byte-compile-checks-on-load 4387 (pushnew '(null (function-max-args 'throw)) byte-compile-checks-on-load
4387 :test #'equal))) 4388 :test #'equal)))
4388 4389