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