Skip to content
Snippets Groups Projects
Commit 9081ac3d authored by rtoy's avatar rtoy
Browse files

utf-16-be.lisp:

o Fix typo.  There is no WD variable; it should be the constant 2.
o In FLUSH-STATE, only flush something if the state has something to
  be flushed.

utf-16-le.lisp:
o In FLUSH-STATE, only flush something if the state has something to
  be flushed.
parent ae84525d
No related branches found
No related tags found
No related merge requests found
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public ;;; This code was written by Paul Foley and has been placed in the public
;;; domain. ;;; domain.
;;; ;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/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: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-be.lisp,v 1.11 2010/08/13 01:35:25 rtoy Exp $")
(in-package "STREAM") (in-package "STREAM")
(intl:textdomain "cmucl") (intl:textdomain "cmucl")
...@@ -55,13 +55,13 @@ Unicode replacement character.") ...@@ -55,13 +55,13 @@ Unicode replacement character.")
(setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400)) (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400))
(setf ,code (setf ,code
(if ,error (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+))))) +replacement-character-code+)))))
((= ,code #xFFFE) ((= ,code #xFFFE)
;; Replace with REPLACEMENT CHARACTER. ;; Replace with REPLACEMENT CHARACTER.
(setf ,code (setf ,code
(if ,error (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+))) +replacement-character-code+)))
(t (setf ,state nil))) (t (setf ,state nil)))
(values ,code 2))) (values ,code 2)))
...@@ -84,13 +84,14 @@ Unicode replacement character.") ...@@ -84,13 +84,14 @@ Unicode replacement character.")
(,output (ldb (byte 8 8) code)) (,output (ldb (byte 8 8) code))
(,output (ldb (byte 8 0) code)))) (,output (ldb (byte 8 0) code))))
(let ((,c (car ,state))) (let ((,c (car ,state)))
(,output (if (lisp::surrogatep ,c) (when ,c
(if ,error (,output (if (lisp::surrogatep ,c)
(funcall ,error (if ,error
"Flushing bare surrogate #x~4,'0X is illegal for UTF-16" (funcall ,error
(char-code ,c)) "Flushing bare surrogate #x~4,'0X is illegal for UTF-16"
+replacement-character-code+) (char-code ,c))
,c))))) +replacement-character-code+)
,c))))))
(copy-state (state) (copy-state (state)
;; The state is either NIL or a codepoint, so nothing really ;; The state is either NIL or a codepoint, so nothing really
;; special is needed to copy it. ;; special is needed to copy it.
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public ;;; This code was written by Paul Foley and has been placed in the public
;;; domain. ;;; domain.
;;; ;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/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: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16-le.lisp,v 1.11 2010/08/13 01:35:25 rtoy Exp $")
(in-package "STREAM") (in-package "STREAM")
(intl:textdomain "cmucl") (intl:textdomain "cmucl")
...@@ -85,13 +85,14 @@ Unicode replacement character.") ...@@ -85,13 +85,14 @@ Unicode replacement character.")
(,output (ldb (byte 8 0) code)) (,output (ldb (byte 8 0) code))
(,output (ldb (byte 8 8) code)))) (,output (ldb (byte 8 8) code))))
(let ((,c (car ,state))) (let ((,c (car ,state)))
(,output (if (lisp::surrogatep ,c) (when ,c
(if ,error (,output (if (lisp::surrogatep ,c)
(funcall ,error (if ,error
"Flushing bare surrogate #x~4,'0X is illegal for UTF-16" (funcall ,error
(char-code ,c)) "Flushing bare surrogate #x~4,'0X is illegal for UTF-16"
+replacement-character-code+) (char-code ,c))
,c))))) +replacement-character-code+)
,c))))))
(copy-state (state) (copy-state (state)
;; The state is either NIL or a codepoint, so nothing really ;; The state is either NIL or a codepoint, so nothing really
;; special is needed. ;; special is needed.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment