CMUCL commit: RELEASE-20B-BRANCH src/pcl/simple-streams/external-formats (5 files)
Raymond Toy
rtoy at common-lisp.net
Fri Aug 13 03:52:54 CEST 2010
Date: Thursday, August 12, 2010 @ 21:52:54
Author: rtoy
Path: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats
Tag: RELEASE-20B-BRANCH
Modified: utf-16-be.lisp utf-16-le.lisp utf-16.lisp utf-32-be.lisp
utf-32-le.lisp
Merge fixes from HEAD for broken external formats.
----------------+
utf-16-be.lisp | 21 +++++++++++----------
utf-16-le.lisp | 17 +++++++++--------
utf-16.lisp | 17 +++++++++--------
utf-32-be.lisp | 12 ++++--------
utf-32-le.lisp | 8 ++++----
5 files changed, 37 insertions(+), 38 deletions(-)
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 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 Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-16-be.lisp Thu Aug 12 21:52:53 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 2010-07-12 14:42:11 rtoy Exp $")
+(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 $")
(in-package "STREAM")
(intl:textdomain "cmucl")
@@ -55,13 +55,13 @@
(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 ,wd)
+ (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 ,wd)
+ (funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2)
+replacement-character-code+)))
(t (setf ,state nil)))
(values ,code 2)))
@@ -84,13 +84,14 @@
(,output (ldb (byte 8 8) code))
(,output (ldb (byte 8 0) code))))
(let ((,c (car ,state)))
- (,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)))))
+ (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))))))
(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.10 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 Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-16-le.lisp Thu Aug 12 21:52:53 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 2010-07-12 14:42:11 rtoy Exp $")
+(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 $")
(in-package "STREAM")
(intl:textdomain "cmucl")
@@ -85,13 +85,14 @@
(,output (ldb (byte 8 0) code))
(,output (ldb (byte 8 8) code))))
(let ((,c (car ,state)))
- (,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)))))
+ (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))))))
(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.12 src/pcl/simple-streams/external-formats/utf-16.lisp:1.12.4.1
--- src/pcl/simple-streams/external-formats/utf-16.lisp:1.12 Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-16.lisp Thu Aug 12 21:52:54 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 2010-07-12 14:42:11 rtoy Exp $")
+(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 $")
(in-package "STREAM")
(intl:textdomain "cmucl")
@@ -126,13 +126,14 @@
(,output (ldb (byte 8 8) code))
(,output (ldb (byte 8 0) code))))
(let ((,c (car ,state)))
- (out (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)))))
+ (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))
+ +replacement-character-code+)
+ ,c))))))
(copy-state (state)
;; The state is list. Copy it
`(copy-list ,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 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 Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-32-be.lisp Thu Aug 12 21:52:54 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 2010-07-12 14:42:11 rtoy Exp $")
+(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 $")
(in-package "STREAM")
(intl:textdomain "cmucl")
@@ -35,9 +35,9 @@
(lisp::surrogatep ,c))
;; Surrogates are illegal. Use replacement character.
(values (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))
+ (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
@@ -49,10 +49,6 @@
;; Big-endian output
(dotimes (,i 4)
(,output (ldb (byte 8 (* 8 (- 3 ,i))) ,c)))))
- ;; Write BOM
- (unless ,state
- (out #xFEFF)
- (setf ,state t))
(cond ((lisp::surrogatep ,code)
(out (if ,error
(funcall ,error "Surrogate code #x~4,'0X is illegal for UTF32 output"
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 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 Mon Jul 12 10:42:11 2010
+++ src/pcl/simple-streams/external-formats/utf-32-le.lisp Thu Aug 12 21:52:54 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 2010-07-12 14:42:11 rtoy Exp $")
+(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 $")
(in-package "STREAM")
(intl:textdomain "cmucl")
@@ -35,10 +35,10 @@
(lisp::surrogatep ,c))
;; Surrogates are illegal. Use replacement character.
(values (if ,error
- (if (>= ,code lisp:codepoint-limit)
- (funcall ,error "Illegal codepoint #x~4,'0X" ,code 4)
+ (if (>= ,c lisp:codepoint-limit)
+ (funcall ,error "Illegal codepoint #x~4,'0X" ,c 4)
(funcall ,error "Surrogate #x~4,'0X not allowed in UTF32"
- ,code 4))
+ ,c 4))
+replacement-character-code+)
4))
(t
More information about the cmucl-commit
mailing list