diff --git a/pcl/simple-streams/external-formats/utf-16-be.lisp b/pcl/simple-streams/external-formats/utf-16-be.lisp index a68ae5abfe28be1dbd011cc980d0460084c04e1f..a4150f26e6f6f8a85ddf73157dcb43f50fce1875 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.6 2010/07/02 23:13:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.7 2010/07/03 13:45:01 rtoy Exp $") (in-package "STREAM") @@ -71,7 +71,18 @@ (output (logior ,c2 #xDC00)))) (t (output +replacement-character-code+))))) - nil + (flush-state (state output error c) + `(flet ((out (code) + (,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))))) (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 4034ce532d9955d32a92f9423c201068485f03e4..365eea5ffb2a2d35273c09a39fd268cefac96760 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.6 2010/07/02 23:13:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.7 2010/07/03 13:45:01 rtoy Exp $") (in-package "STREAM") @@ -72,7 +72,18 @@ (output (logior ,c2 #xDC00)))) (t (output +replacement-character-code+))))) - nil + (flush-state (state output error c) + `(flet ((out (code) + (,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))))) (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 e64e8f5fdc0e36c3dc8dde4c22eca05bb9c0e836..04e2686871f2d587303f206a2355ae6498f56a9f 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.8 2010/07/02 23:13:11 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.9 2010/07/03 13:45:01 rtoy Exp $") (in-package "STREAM") @@ -112,7 +112,18 @@ (output (logior ,c2 #xDC00)))) (t (output +replacement-character-code+))))) - nil + (flush-state (state output error c) + `(flet ((out (code) + (,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))))) (copy-state (state) ;; The state is list. Copy it `(copy-list ,state)))