diff --git a/code/extfmts.lisp b/code/extfmts.lisp index 9fcc8005df6fa402b80c84a776c8ae41a154ca64..f99be449d4a50f346b374f992e553e585ea49ac9 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 b3c2cbe37c8dbde4248286ba51874c81a48abbd1..7ec5f41f5f6723b09b123ded021c8c946b2efe53 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 70f3deb46d218f8602c5750fd30b383e455795d3..0dea3931ce58dc176bc90275232ee15ed125635c 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 4c410183989bc8674f6bcb7a8b71bc2dc5facb99..7220b0886bbfa7d4cd384a00e879574495835bb4 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 9e3bc1aa1c4e8e0d370ce11124d82637f57838c6..8080f54ef0f111775f0b41d740fa3fa78add00ff 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 24770a31fa6abb22e89b0b01991b6a656e8452d9..5b9f30c172b832448ccca52f9cbaa6b8ebfcbd07 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 f08c0717bb4de38c4e3d25f970eb02aa4ea8c231..db175b5e33430e91eeed4456928ee4e8ef241aa4 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 5e15223d55806973e51db12bcbc0f9f19aba4197..7567ff0f485b642418fb4623a33f3dbc046c37db 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 c7edf38ef8d5283df6bfe70c962b52f1d340dcf6..4ae251be53cf60571308298e8706d4c6ba61c4aa 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 a0a4e3d6a6f35de0137b458c9f6ee84d2990471c..7af4ec708fd4bc8e1ac0914e20501cef01f1f819 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 e0f00ab8ade284398b5882a1e594339f5de40b28..b3b1e88869cb12c3e0a83ca32b4cf475ab1acc55 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 d95f1f6523ef73de4aec433d983560c73d795d0c..0b2ec6848faa53ccd950b9a0d5c082057bc0d577 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))