From 224b62bca5e19c06bfa42705a0e5b419d8519098 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sat, 14 Aug 2010 23:18:04 +0000 Subject: [PATCH] extfmts.lisp: ascii.lisp: iso8859-1.lisp: iso8859-2.lisp: mac-roman.lisp: utf-16.lisp: utf-32-be.lisp: utf-32-le.lisp: utf-32.lisp: utf-8.lisp: o Inhibit warnings about funcalls to error (fdefinition of symbols). I'm tired of seeing the warnings. utf-16-be.lisp: utf-16-le.lisp: o Inhibit warnings about funcalls to error (fdefinition of symbols). I'm tired of seeing the warnings. o Fix bug in FLUSH-STATE: need to call the OUT function, not the ,OUTPUT function! --- code/extfmts.lisp | 11 ++-- .../external-formats/ascii.lisp | 12 +++-- .../external-formats/iso8859-1.lisp | 9 ++-- .../external-formats/iso8859-2.lisp | 8 ++- .../external-formats/mac-roman.lisp | 9 ++-- .../external-formats/utf-16-be.lisp | 35 +++++++++---- .../external-formats/utf-16-le.lisp | 35 +++++++++---- .../external-formats/utf-16.lisp | 26 +++++++--- .../external-formats/utf-32-be.lisp | 18 ++++--- .../external-formats/utf-32-le.lisp | 20 ++++--- .../external-formats/utf-32.lisp | 20 ++++--- .../external-formats/utf-8.lisp | 52 +++++++++++++------ 12 files changed, 175 insertions(+), 80 deletions(-) diff --git a/code/extfmts.lisp b/code/extfmts.lisp index 9fcc8005d..f99be449d 100644 --- a/code/extfmts.lisp +++ b/code/extfmts.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.36 2010/08/04 02:56:36 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.37 2010/08/14 23:18:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -649,9 +649,12 @@ character and illegal outputs are replaced by a question mark.") (code-to-octets (code state output error) `(,output (if (> ,code 255) (if ,error - (funcall ,error - (intl:gettext "Cannot output codepoint #x~X to ISO8859-1 stream") - ,code 1) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error + (intl:gettext "Cannot output codepoint #x~X to ISO8859-1 stream") + ,code 1)) #x3F) ,code)))) diff --git a/pcl/simple-streams/external-formats/ascii.lisp b/pcl/simple-streams/external-formats/ascii.lisp index b3c2cbe37..7ec5f41f5 100644 --- a/pcl/simple-streams/external-formats/ascii.lisp +++ b/pcl/simple-streams/external-formats/ascii.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Raymond Toy and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/ascii.lisp,v 1.6 2010/07/12 14:42:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/ascii.lisp,v 1.7 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -19,13 +19,19 @@ replaced with a question mark.") (values (if (< ,c #x80) ,c (if ,error - (funcall ,error "Invalid octet #x~4,'0X for ASCII" ,c 1) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Invalid octet #x~4,'0X for ASCII" ,c 1)) +replacement-character-code+)) 1))) (code-to-octets (code state output error) `(,output (if (> ,code #x7F) (if ,error - (funcall ,error "Cannot output codepoint #x~X to ASCII stream" ,code) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Cannot output codepoint #x~X to ASCII stream" ,code)) #x3F) ,code)))) diff --git a/pcl/simple-streams/external-formats/iso8859-1.lisp b/pcl/simple-streams/external-formats/iso8859-1.lisp index 70f3deb46..0dea3931c 100644 --- a/pcl/simple-streams/external-formats/iso8859-1.lisp +++ b/pcl/simple-streams/external-formats/iso8859-1.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/iso8859-1.lisp,v 1.6 2010/07/12 14:42:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/iso8859-1.lisp,v 1.7 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -25,7 +25,10 @@ character and illegal outputs are replaced by a question mark.") (code-to-octets (code state output error) `(,output (if (> ,code 255) (if ,error - (funcall ,error "Cannot output codepoint #x~X to ISO8859-1 stream" - ,code 1) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Cannot output codepoint #x~X to ISO8859-1 stream" + ,code 1)) #x3F) ,code)))) diff --git a/pcl/simple-streams/external-formats/iso8859-2.lisp b/pcl/simple-streams/external-formats/iso8859-2.lisp index 4c4101839..7220b0886 100644 --- a/pcl/simple-streams/external-formats/iso8859-2.lisp +++ b/pcl/simple-streams/external-formats/iso8859-2.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/iso8859-2.lisp,v 1.7 2010/07/12 14:42:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/iso8859-2.lisp,v 1.8 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -42,5 +42,9 @@ character and illegal outputs are replaced by a question mark.") (if ,code (+ (the (unsigned-byte 7) ,present) 160) (if ,error - (funcall ,error "Cannot output codepoint #x~X to ISO8859-2 stream" ,code) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Cannot output codepoint #x~X to ISO8859-2 stream" + ,code)) #x3F))))))) diff --git a/pcl/simple-streams/external-formats/mac-roman.lisp b/pcl/simple-streams/external-formats/mac-roman.lisp index 9e3bc1aa1..8080f54ef 100644 --- a/pcl/simple-streams/external-formats/mac-roman.lisp +++ b/pcl/simple-streams/external-formats/mac-roman.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/mac-roman.lisp,v 1.8 2010/07/12 14:42:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/mac-roman.lisp,v 1.9 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -44,6 +44,9 @@ character and illegal outputs are replaced by a question mark.") (if ,present (+ (the (unsigned-byte 7) ,present) 128) (if ,error - (funcall ,error "Cannot output codepoint #x~X to MAC-ROMAN stream" - ,code) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Cannot output codepoint #x~X to MAC-ROMAN stream" + ,code)) #x3F))))))) diff --git a/pcl/simple-streams/external-formats/utf-16-be.lisp b/pcl/simple-streams/external-formats/utf-16-be.lisp index 24770a31f..5b9f30c17 100644 --- a/pcl/simple-streams/external-formats/utf-16-be.lisp +++ b/pcl/simple-streams/external-formats/utf-16-be.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.11 2010/08/13 01:35:25 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.12 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -36,7 +36,10 @@ Unicode replacement character.") ,state nil) (setf ,code (if ,error - (funcall ,error "Bare low surrogate #x~4,'0X" ,code 2) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Bare low surrogate #x~4,'0X" ,code 2)) +replacement-character-code+)))) ((lisp::surrogatep ,code :high) ;; Remember the high surrogate in case we bail out @@ -55,13 +58,20 @@ Unicode replacement character.") (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400)) (setf ,code (if ,error - (funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next 2) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "High surrogate followed by #x~4,'0X ~ + instead of low surrogate" ,next 2)) +replacement-character-code+))))) ((= ,code #xFFFE) ;; Replace with REPLACEMENT CHARACTER. (setf ,code (if ,error - (funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2)) +replacement-character-code+))) (t (setf ,state nil))) (values ,code 2))) @@ -85,13 +95,16 @@ Unicode replacement character.") (,output (ldb (byte 8 0) code)))) (let ((,c (car ,state))) (when ,c - (,output (if (lisp::surrogatep ,c) - (if ,error - (funcall ,error - "Flushing bare surrogate #x~4,'0X is illegal for UTF-16" - (char-code ,c)) - +replacement-character-code+) - ,c)))))) + (out (if (lisp::surrogatep ,c) + (if ,error + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error + "Flushing bare surrogate #x~4,'0X is illegal for UTF-16" + (char-code ,c))) + +replacement-character-code+) + ,c)))))) (copy-state (state) ;; The state is either NIL or a codepoint, so nothing really ;; special is needed to copy it. diff --git a/pcl/simple-streams/external-formats/utf-16-le.lisp b/pcl/simple-streams/external-formats/utf-16-le.lisp index f08c0717b..db175b5e3 100644 --- a/pcl/simple-streams/external-formats/utf-16-le.lisp +++ b/pcl/simple-streams/external-formats/utf-16-le.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.11 2010/08/13 01:35:25 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.12 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -38,7 +38,10 @@ Unicode replacement character.") ,state nil) (setf ,code (if ,error - (funcall ,error "Bare low surrogate #x~4,'0X" ,code 2) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Bare low surrogate #x~4,'0X" ,code 2)) +replacement-character-code+)))) ((lisp::surrogatep ,code :high) ;; Remember the high surrogate in case we bail out @@ -56,13 +59,20 @@ Unicode replacement character.") (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400)) (setq ,code (if ,error - (funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next 2) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "High surrogate followed by #x~4,'0X ~ + instead of low surrogate" ,next 2)) +replacement-character-code+))))) ((= ,code #xFFFE) ;; replace with REPLACEMENT CHARACTER. (setf ,code (if ,error - (funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2)) +replacement-character-code+))) (t (setf ,state nil))) (values ,code 2))) @@ -86,13 +96,16 @@ Unicode replacement character.") (,output (ldb (byte 8 8) code)))) (let ((,c (car ,state))) (when ,c - (,output (if (lisp::surrogatep ,c) - (if ,error - (funcall ,error - "Flushing bare surrogate #x~4,'0X is illegal for UTF-16" - (char-code ,c)) - +replacement-character-code+) - ,c)))))) + (out (if (lisp::surrogatep ,c) + (if ,error + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error + "Flushing bare surrogate #x~4,'0X is illegal for UTF-16" + (char-code ,c))) + +replacement-character-code+) + ,c)))))) (copy-state (state) ;; The state is either NIL or a codepoint, so nothing really ;; special is needed. diff --git a/pcl/simple-streams/external-formats/utf-16.lisp b/pcl/simple-streams/external-formats/utf-16.lisp index 5e15223d5..7567ff0f4 100644 --- a/pcl/simple-streams/external-formats/utf-16.lisp +++ b/pcl/simple-streams/external-formats/utf-16.lisp @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*- ;;; ;;; ********************************************************************** -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.13 2010/08/13 01:48:44 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.14 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -66,7 +66,10 @@ Unicode replacement character.") ,state nil) (setf ,code (if ,error - (funcall ,error "Bare low surrogate #x~4,'0X" ,code 2) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Bare low surrogate #x~4,'0X" ,code 2)) +replacement-character-code+)))) ((lisp::surrogatep ,code :high) ;; Save the high (leading) code in the state, in @@ -90,7 +93,10 @@ Unicode replacement character.") ,wd 4) (setf ,code (if ,error - (funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next ,wd) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "High surrogate followed by #x~4,'0X instead of low surrogate" ,next ,wd)) +replacement-character-code+))))) ((and (= ,code #xFFFE) (zerop ,st)) (setf (car ,state) 1) (go :again)) @@ -100,7 +106,10 @@ Unicode replacement character.") ;; Replace with REPLACEMENT CHARACTER. (setf ,code (if ,error - (funcall ,error "BOM is not valid within a UTF-16 stream" ,code ,wd) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "BOM is not valid within a UTF-16 stream" ,code ,wd)) +replacement-character-code+)))) (return (values ,code ,wd)))))) (code-to-octets (code state output error c c1 c2) @@ -129,9 +138,12 @@ Unicode replacement character.") (when ,c (out (if (lisp::surrogatep ,c) (if ,error - (funcall ,error - "Flushing bare surrogate #x~4,'0X is illegal for UTF-16" - (char-code ,c)) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error + "Flushing bare surrogate #x~4,'0X is illegal for UTF-16" + (char-code ,c))) +replacement-character-code+) ,c)))))) (copy-state (state) diff --git a/pcl/simple-streams/external-formats/utf-32-be.lisp b/pcl/simple-streams/external-formats/utf-32-be.lisp index c7edf38ef..4ae251be5 100644 --- a/pcl/simple-streams/external-formats/utf-32-be.lisp +++ b/pcl/simple-streams/external-formats/utf-32-be.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Raymond Toy and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.10 2010/08/13 01:33:05 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.11 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -35,9 +35,12 @@ Unicode replacement character.") (lisp::surrogatep ,c)) ;; Surrogates are illegal. Use replacement character. (values (if ,error - (if (>= ,c lisp:codepoint-limit) - (funcall ,error "Illegal codepoint #x~4,'0X" ,c 4) - (funcall ,error "Surrogate #x~4,'0X not allowed in UTF32" ,c 4)) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (if (>= ,c lisp:codepoint-limit) + (funcall ,error "Illegal codepoint #x~4,'0X" ,c 4) + (funcall ,error "Surrogate #x~4,'0X not allowed in UTF32" ,c 4))) +replacement-character-code+) 4)) (t @@ -51,8 +54,11 @@ Unicode replacement character.") (,output (ldb (byte 8 (* 8 (- 3 ,i))) ,c))))) (cond ((lisp::surrogatep ,code) (out (if ,error - (funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output" - ,code) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output" + ,code)) +replacement-character-code+))) (t (out ,code)))))) diff --git a/pcl/simple-streams/external-formats/utf-32-le.lisp b/pcl/simple-streams/external-formats/utf-32-le.lisp index a0a4e3d6a..7af4ec708 100644 --- a/pcl/simple-streams/external-formats/utf-32-le.lisp +++ b/pcl/simple-streams/external-formats/utf-32-le.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Raymond Toy and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.10 2010/08/13 01:33:05 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.11 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -35,10 +35,13 @@ Unicode replacement character.") (lisp::surrogatep ,c)) ;; Surrogates are illegal. Use replacement character. (values (if ,error - (if (>= ,c lisp:codepoint-limit) - (funcall ,error "Illegal codepoint #x~4,'0X" ,c 4) - (funcall ,error "Surrogate #x~4,'0X not allowed in UTF32" - ,c 4)) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (if (>= ,c lisp:codepoint-limit) + (funcall ,error "Illegal codepoint #x~4,'0X" ,c 4) + (funcall ,error "Surrogate #x~4,'0X not allowed in UTF32" + ,c 4))) +replacement-character-code+) 4)) (t @@ -52,8 +55,11 @@ Unicode replacement character.") (,output (ldb (byte 8 (* 8 ,i)) ,c))))) (cond ((lisp::surrogatep ,code) (out (if ,error - (funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output" - ,code) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output" + ,code)) +replacement-character-code+))) (t (out ,code)))))) diff --git a/pcl/simple-streams/external-formats/utf-32.lisp b/pcl/simple-streams/external-formats/utf-32.lisp index e0f00ab8a..b3b1e8886 100644 --- a/pcl/simple-streams/external-formats/utf-32.lisp +++ b/pcl/simple-streams/external-formats/utf-32.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Raymond Toy and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.11 2010/07/12 14:42:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.12 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -70,10 +70,13 @@ Unicode replacement character.") ;; character. (setf ,code (if ,error - (if (>= ,code lisp:codepoint-limit) - (funcall ,error "Illegal codepoint #x~4,'0X" ,code 4) - (funcall ,error "Surrogate #x~4,'0X not allowed in UTF32" - ,code 4)) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (if (>= ,code lisp:codepoint-limit) + (funcall ,error "Illegal codepoint #x~4,'0X" ,code 4) + (funcall ,error "Surrogate #x~4,'0X not allowed in UTF32" + ,code 4))) +replacement-character-code+))) ((and (zerop ,st) (= ,code #xFFFE0000)) ;; BOM for little-endian @@ -97,8 +100,11 @@ Unicode replacement character.") (setf ,state t)) (cond ((lisp::surrogatep ,code) (out (if ,error - (funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output" - ,code) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output" + ,code)) +replacement-character-code+))) (t (out ,code))))) diff --git a/pcl/simple-streams/external-formats/utf-8.lisp b/pcl/simple-streams/external-formats/utf-8.lisp index d95f1f652..0b2ec6848 100644 --- a/pcl/simple-streams/external-formats/utf-8.lisp +++ b/pcl/simple-streams/external-formats/utf-8.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.14 2010/07/12 14:42:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.15 2010/08/14 23:18:04 rtoy Rel $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -40,10 +40,13 @@ replacement character.") (,unput 1) (return (values - (if ,error - (funcall ,error "Invalid utf8 octet #x~X at offset ~D" - ,c (1+ ,j)) - +replacement-character-code+) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (if ,error + (funcall ,error "Invalid utf8 octet #x~X at offset ~D" + ,c (1+ ,j)) + +replacement-character-code+)) (1+ ,j))))))))) (check (,n ,i) (declare (type (unsigned-byte 31) ,n) @@ -62,12 +65,21 @@ replacement character.") (values (if ,error (cond ((>= ,n lisp:codepoint-limit) - (funcall ,error "Invalid codepoint #x~X of ~D octets" - ,n (1+ ,i))) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Invalid codepoint #x~X of ~D octets" + ,n (1+ ,i)))) ((lisp::surrogatep ,n) - (funcall ,error "Invalid surrogate code #x~X" ,n (1+ ,i))) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Invalid surrogate code #x~X" ,n (1+ ,i)))) (t - (funcall ,error "Overlong utf8 sequence of ~*~D octets" nil (1+ ,i)))) + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Overlong utf8 sequence of ~*~D octets" nil (1+ ,i))))) +replacement-character-code+) (1+ ,i))) (values ,n (1+ ,i))))) @@ -76,18 +88,26 @@ replacement character.") (cond ((null ,c) (values nil 0)) ((< ,c #b10000000) (values ,c 1)) ((< ,c #b11000010) - (values (if ,error - (funcall ,error "Invalid initial utf8 octet: #x~X" ,c 1) - +replacement-character-code+) + (values + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (if ,error + (funcall ,error "Invalid initial utf8 octet: #x~X" ,c 1) + +replacement-character-code+)) 1)) ((< ,c #b11100000) (utf8 ,c 1)) ((< ,c #b11110000) (utf8 ,c 2)) ((< ,c #b11111000) (utf8 ,c 3)) (t - (values (if ,error - (funcall ,error "Invalid initial utf8 octet: #x~X" ,c 1) - +replacement-character-code+) - 1)))))) + (values + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (if ,error + (funcall ,error "Invalid initial utf8 octet: #x~X" ,c 1) + +replacement-character-code+)) + 1)))))) (code-to-octets (code state output error i j n p init) `(flet ((utf8 (,n ,i) (let* ((,j (- 6 ,i)) -- GitLab