Date: Wednesday, August 4, 2010 @ 08:12:09 Author: rtoy Path: /project/cmucl/cvsroot/src/code Tag: RELEASE-20B-BRANCH
Modified: extfmts.lisp
Merge some change from HEAD to keep compiler quieter when compiling external formats.
--------------+ extfmts.lisp | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-)
Index: src/code/extfmts.lisp diff -u src/code/extfmts.lisp:1.35 src/code/extfmts.lisp:1.35.4.1 --- src/code/extfmts.lisp:1.35 Mon Jul 12 09:58:42 2010 +++ src/code/extfmts.lisp Wed Aug 4 08:12:09 2010 @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.35 2010-07-12 13:58:42 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.35.4.1 2010-08-04 12:12:09 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -753,11 +753,15 @@ ;; illegal. So are codepoints that are too large. (if ,error (if (lisp::surrogatep code) - (funcall ,error - (format nil (intl:gettext "Surrogate codepoint #x~~4,'0X is illegal for ~A") - ,external-format) - code nil) - (funcall ,error (intl:gettext "Illegal codepoint on input: #x~X") code nil)) + (locally + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error + (format nil (intl:gettext "Surrogate codepoint #x~~4,'0X is illegal for ~A") + ,external-format) + code nil)) + (locally + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error (intl:gettext "Illegal codepoint on input: #x~X") code nil))) #-(and unicode (not unicode-bootstrap)) #? #+(and unicode (not unicode-bootstrap)) #\U+FFFD)) #+unicode @@ -788,18 +792,22 @@ (,wryte (if (lisp::surrogatep (char-code ,nchar) :low) (surrogates-to-codepoint (car ,nstate) ,nchar) (if ,error - (funcall ,error - (intl:gettext "Cannot convert invalid surrogate #x~X to character") - ,nchar) + (locally + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error + (intl:gettext "Cannot convert invalid surrogate #x~X to character") + ,nchar)) +replacement-character-code+))) (setf (car ,nstate) nil)) ;; A lone trailing (low) surrogate gets replaced with ;; the replacement character. (,wryte (if (lisp::surrogatep (char-code ,nchar) :low) (if ,error - (funcall ,error - (intl:gettext "Cannot convert lone trailing surrogate #x~X to character") - ,nchar) + (locally + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error + (intl:gettext "Cannot convert lone trailing surrogate #x~X to character") + ,nchar)) +replacement-character-code+) (char-code ,nchar)))))))))