CMUCL commit: RELEASE-20B-BRANCH src (10 files)

Raymond Toy rtoy at common-lisp.net
Sun Aug 15 01:51:08 CEST 2010


    Date: Saturday, August 14, 2010 @ 19:51:08
  Author: rtoy
    Path: /project/cmucl/cvsroot/src
     Tag: RELEASE-20B-BRANCH

Modified: code/extfmts.lisp pcl/simple-streams/external-formats/ascii.lisp
          pcl/simple-streams/external-formats/mac-roman.lisp
          pcl/simple-streams/external-formats/utf-16-be.lisp
          pcl/simple-streams/external-formats/utf-16-le.lisp
          pcl/simple-streams/external-formats/utf-16.lisp
          pcl/simple-streams/external-formats/utf-32-be.lisp
          pcl/simple-streams/external-formats/utf-32-le.lisp
          pcl/simple-streams/external-formats/utf-32.lisp
          pcl/simple-streams/external-formats/utf-8.lisp

Merge fixes from trunk to silence some compiler notes and fix bug in
utf-16-be and utf-16-le.


----------------------------------------------------+
 code/extfmts.lisp                                  |   11 ++--
 pcl/simple-streams/external-formats/ascii.lisp     |   12 +++-
 pcl/simple-streams/external-formats/mac-roman.lisp |    9 ++-
 pcl/simple-streams/external-formats/utf-16-be.lisp |   27 +++++++--
 pcl/simple-streams/external-formats/utf-16-le.lisp |   27 +++++++--
 pcl/simple-streams/external-formats/utf-16.lisp    |   26 ++++++---
 pcl/simple-streams/external-formats/utf-32-be.lisp |   18 ++++--
 pcl/simple-streams/external-formats/utf-32-le.lisp |   20 ++++---
 pcl/simple-streams/external-formats/utf-32.lisp    |   20 ++++---
 pcl/simple-streams/external-formats/utf-8.lisp     |   52 +++++++++++++------
 10 files changed, 155 insertions(+), 67 deletions(-)


Index: src/code/extfmts.lisp
diff -u src/code/extfmts.lisp:1.35.4.1 src/code/extfmts.lisp:1.35.4.2
--- src/code/extfmts.lisp:1.35.4.1	Wed Aug  4 08:12:09 2010
+++ src/code/extfmts.lisp	Sat Aug 14 19:51:08 2010
@@ -5,7 +5,7 @@
 ;;; domain.
 ;;; 
 (ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.35.4.1 2010-08-04 12:12:09 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.35.4.2 2010-08-14 23:51:08 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -649,9 +649,12 @@
   (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))))
 
Index: src/pcl/simple-streams/external-formats/ascii.lisp
diff -u src/pcl/simple-streams/external-formats/ascii.lisp:1.6 src/pcl/simple-streams/external-formats/ascii.lisp:1.6.4.1
--- src/pcl/simple-streams/external-formats/ascii.lisp:1.6	Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/ascii.lisp	Sat Aug 14 19:51:08 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Raymond Toy and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/ascii.lisp,v 1.6 2010-07-12 14:42:11 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/ascii.lisp,v 1.6.4.1 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -19,13 +19,19 @@
        (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))))
 
Index: src/pcl/simple-streams/external-formats/mac-roman.lisp
diff -u src/pcl/simple-streams/external-formats/mac-roman.lisp:1.8 src/pcl/simple-streams/external-formats/mac-roman.lisp:1.8.4.1
--- src/pcl/simple-streams/external-formats/mac-roman.lisp:1.8	Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/mac-roman.lisp	Sat Aug 14 19:51:08 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Paul Foley and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/mac-roman.lisp,v 1.8.4.1 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -44,6 +44,9 @@
 		    (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)))))))
Index: src/pcl/simple-streams/external-formats/utf-16-be.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.10.4.1 src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.10.4.2
--- src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.10.4.1	Thu Aug 12 21:52:53 2010
+++ src/pcl/simple-streams/external-formats/utf-16-be.lisp	Sat Aug 14 19:51:08 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Paul Foley and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.10.4.1 2010-08-13 01:52:53 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.10.4.2 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -36,7 +36,10 @@
 			,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 @@
 		    (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)))
@@ -87,9 +97,12 @@
 	 (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))
+			    (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)
Index: src/pcl/simple-streams/external-formats/utf-16-le.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.10.4.1 src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.10.4.2
--- src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.10.4.1	Thu Aug 12 21:52:53 2010
+++ src/pcl/simple-streams/external-formats/utf-16-le.lisp	Sat Aug 14 19:51:08 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Paul Foley and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.10.4.1 2010-08-13 01:52:53 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.10.4.2 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -38,7 +38,10 @@
 			,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 @@
 		    (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)))
@@ -88,9 +98,12 @@
 	 (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))
+			    (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)
Index: src/pcl/simple-streams/external-formats/utf-16.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16.lisp:1.12.4.1 src/pcl/simple-streams/external-formats/utf-16.lisp:1.12.4.2
--- src/pcl/simple-streams/external-formats/utf-16.lisp:1.12.4.1	Thu Aug 12 21:52:54 2010
+++ src/pcl/simple-streams/external-formats/utf-16.lisp	Sat Aug 14 19:51:08 2010
@@ -1,7 +1,7 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*-
 ;;;
 ;;; **********************************************************************
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.12.4.1 2010-08-13 01:52:54 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.12.4.2 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -66,7 +66,10 @@
 			     ,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 @@
 			       ,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 @@
 		   ;; 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 @@
 	 (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)
Index: src/pcl/simple-streams/external-formats/utf-32-be.lisp
diff -u src/pcl/simple-streams/external-formats/utf-32-be.lisp:1.9.4.1 src/pcl/simple-streams/external-formats/utf-32-be.lisp:1.9.4.2
--- src/pcl/simple-streams/external-formats/utf-32-be.lisp:1.9.4.1	Thu Aug 12 21:52:54 2010
+++ src/pcl/simple-streams/external-formats/utf-32-be.lisp	Sat Aug 14 19:51:08 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Raymond Toy and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.9.4.1 2010-08-13 01:52:54 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.9.4.2 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -35,9 +35,12 @@
 		  (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 @@
 		(,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))))))
Index: src/pcl/simple-streams/external-formats/utf-32-le.lisp
diff -u src/pcl/simple-streams/external-formats/utf-32-le.lisp:1.9.4.1 src/pcl/simple-streams/external-formats/utf-32-le.lisp:1.9.4.2
--- src/pcl/simple-streams/external-formats/utf-32-le.lisp:1.9.4.1	Thu Aug 12 21:52:54 2010
+++ src/pcl/simple-streams/external-formats/utf-32-le.lisp	Sat Aug 14 19:51:08 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Raymond Toy and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.9.4.1 2010-08-13 01:52:54 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.9.4.2 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -35,10 +35,13 @@
 		  (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 @@
 		(,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))))))
Index: src/pcl/simple-streams/external-formats/utf-32.lisp
diff -u src/pcl/simple-streams/external-formats/utf-32.lisp:1.11 src/pcl/simple-streams/external-formats/utf-32.lisp:1.11.4.1
--- src/pcl/simple-streams/external-formats/utf-32.lisp:1.11	Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-32.lisp	Sat Aug 14 19:51:08 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Raymond Toy and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.11.4.1 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -70,10 +70,13 @@
 		   ;; 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 @@
 	 (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)))))
Index: src/pcl/simple-streams/external-formats/utf-8.lisp
diff -u src/pcl/simple-streams/external-formats/utf-8.lisp:1.14 src/pcl/simple-streams/external-formats/utf-8.lisp:1.14.4.1
--- src/pcl/simple-streams/external-formats/utf-8.lisp:1.14	Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-8.lisp	Sat Aug 14 19:51:08 2010
@@ -4,7 +4,7 @@
 ;;; This code was written by Paul Foley and has been placed in the public
 ;;; domain.
 ;;;
-(ext:file-comment "$Header: /project/cmucl/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: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.14.4.1 2010-08-14 23:51:08 rtoy Exp $")
 
 (in-package "STREAM")
 (intl:textdomain "cmucl")
@@ -40,10 +40,13 @@
 			    (,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 @@
 		      (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 @@
 	(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))



More information about the cmucl-commit mailing list