CMUCL commit: src (12 files)
Raymond Toy
rtoy at common-lisp.net
Sun Aug 15 01:18:04 CEST 2010
Date: Saturday, August 14, 2010 @ 19:18:04
Author: rtoy
Path: /project/cmucl/cvsroot/src
Modified: code/extfmts.lisp pcl/simple-streams/external-formats/ascii.lisp
pcl/simple-streams/external-formats/iso8859-1.lisp
pcl/simple-streams/external-formats/iso8859-2.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
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 ++--
pcl/simple-streams/external-formats/ascii.lisp | 12 +++-
pcl/simple-streams/external-formats/iso8859-1.lisp | 9 ++-
pcl/simple-streams/external-formats/iso8859-2.lisp | 8 ++
pcl/simple-streams/external-formats/mac-roman.lisp | 9 ++-
pcl/simple-streams/external-formats/utf-16-be.lisp | 35 ++++++++----
pcl/simple-streams/external-formats/utf-16-le.lisp | 35 ++++++++----
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 +++++++++++++------
12 files changed, 175 insertions(+), 80 deletions(-)
Index: src/code/extfmts.lisp
diff -u src/code/extfmts.lisp:1.36 src/code/extfmts.lisp:1.37
--- src/code/extfmts.lisp:1.36 Tue Aug 3 22:56:36 2010
+++ src/code/extfmts.lisp Sat Aug 14 19:18:03 2010
@@ -5,7 +5,7 @@
;;; domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.36 2010-08-04 02:56:36 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.37 2010-08-14 23:18:03 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.7
--- 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:18:04 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.7 2010-08-14 23:18:04 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/iso8859-1.lisp
diff -u src/pcl/simple-streams/external-formats/iso8859-1.lisp:1.6 src/pcl/simple-streams/external-formats/iso8859-1.lisp:1.7
--- src/pcl/simple-streams/external-formats/iso8859-1.lisp:1.6 Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/iso8859-1.lisp Sat Aug 14 19:18:04 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/iso8859-1.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/iso8859-1.lisp,v 1.7 2010-08-14 23:18:04 rtoy Exp $")
(in-package "STREAM")
(intl:textdomain "cmucl")
@@ -25,7 +25,10 @@
(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))))
Index: src/pcl/simple-streams/external-formats/iso8859-2.lisp
diff -u src/pcl/simple-streams/external-formats/iso8859-2.lisp:1.7 src/pcl/simple-streams/external-formats/iso8859-2.lisp:1.8
--- src/pcl/simple-streams/external-formats/iso8859-2.lisp:1.7 Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/iso8859-2.lisp Sat Aug 14 19:18:04 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/iso8859-2.lisp,v 1.7 2010-07-12 14:42:11 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/iso8859-2.lisp,v 1.8 2010-08-14 23:18:04 rtoy Exp $")
(in-package "STREAM")
(intl:textdomain "cmucl")
@@ -42,5 +42,9 @@
(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)))))))
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.9
--- 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:18:04 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.9 2010-08-14 23:18:04 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.11 src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.12
--- src/pcl/simple-streams/external-formats/utf-16-be.lisp:1.11 Thu Aug 12 21:35:25 2010
+++ src/pcl/simple-streams/external-formats/utf-16-be.lisp Sat Aug 14 19:18:04 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.11 2010-08-13 01:35:25 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.12 2010-08-14 23:18:04 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)))
@@ -85,13 +95,16 @@
(,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.
Index: src/pcl/simple-streams/external-formats/utf-16-le.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.11 src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.12
--- src/pcl/simple-streams/external-formats/utf-16-le.lisp:1.11 Thu Aug 12 21:35:25 2010
+++ src/pcl/simple-streams/external-formats/utf-16-le.lisp Sat Aug 14 19:18:04 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.11 2010-08-13 01:35:25 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.12 2010-08-14 23:18:04 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)))
@@ -86,13 +96,16 @@
(,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.
Index: src/pcl/simple-streams/external-formats/utf-16.lisp
diff -u src/pcl/simple-streams/external-formats/utf-16.lisp:1.13 src/pcl/simple-streams/external-formats/utf-16.lisp:1.14
--- src/pcl/simple-streams/external-formats/utf-16.lisp:1.13 Thu Aug 12 21:48:44 2010
+++ src/pcl/simple-streams/external-formats/utf-16.lisp Sat Aug 14 19:18:04 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.13 2010-08-13 01:48:44 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.14 2010-08-14 23:18:04 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.10 src/pcl/simple-streams/external-formats/utf-32-be.lisp:1.11
--- src/pcl/simple-streams/external-formats/utf-32-be.lisp:1.10 Thu Aug 12 21:33:05 2010
+++ src/pcl/simple-streams/external-formats/utf-32-be.lisp Sat Aug 14 19:18:04 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.10 2010-08-13 01:33:05 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.11 2010-08-14 23:18:04 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.10 src/pcl/simple-streams/external-formats/utf-32-le.lisp:1.11
--- src/pcl/simple-streams/external-formats/utf-32-le.lisp:1.10 Thu Aug 12 21:33:05 2010
+++ src/pcl/simple-streams/external-formats/utf-32-le.lisp Sat Aug 14 19:18:04 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.10 2010-08-13 01:33:05 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.11 2010-08-14 23:18:04 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.12
--- 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:18:04 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.12 2010-08-14 23:18:04 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.15
--- 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:18:04 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.15 2010-08-14 23:18:04 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