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

Merge changes from 20a release branch.

parent 95322e54
No related branches found
No related tags found
No related merge requests found
......@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy 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-32-be.lisp,v 1.2 2009/06/11 16:04:02 rtoy Rel $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.3 2009/09/28 18:12:59 rtoy Exp $")
(in-package "STREAM")
......@@ -20,7 +20,7 @@
(ash ,c2 16)
(ash ,c3 8)
,c4)))
(declaim (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4)
(declare (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4)
(optimize (speed 3)))
(cond ((or (> ,c #x10ffff)
(lisp::surrogatep ,c))
......
......@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy 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-32-le.lisp,v 1.2 2009/06/11 16:04:02 rtoy Rel $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.3 2009/09/28 18:12:59 rtoy Exp $")
(in-package "STREAM")
......@@ -20,7 +20,7 @@
(ash ,c2 8)
(ash ,c3 16)
(ash ,c4 24))))
(declaim (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4)
(declare (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4)
(optimize (speed 3)))
(cond ((or (> ,c #x10ffff)
(lisp::surrogatep ,c))
......
......@@ -4,7 +4,7 @@
;;; This code was written by Raymond Toy 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-32.lisp,v 1.3 2009/09/09 15:51:28 rtoy Rel $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.4 2009/09/28 18:12:59 rtoy Exp $")
(in-package "STREAM")
......@@ -51,12 +51,14 @@
(ash ,c3 8)
,c4)))
(,wd 4))
(declaim (type (integer 0 2) ,st)
(declare (type (integer 0 2) ,st)
(type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4)
(type lisp:codepoint ,code)
(optimize (speed 3)))
(cond ((lisp::surrogatep ,code)
;; Surrogates are illegal. Use replacement character.
(cond ((or (> ,code #x10fff)
(lisp::surrogatep ,code))
;; Surrogates are illegal and codepoints outside
;; the Unicode range are illegal. Use replacement
;; character.
(setf ,code +replacement-character-code+))
((and (zerop ,st) (= ,code #xFFFE0000))
;; BOM for little-endian
......
......@@ -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-8.lisp,v 1.4 2009/06/11 16:04:02 rtoy Rel $")
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.5 2009/09/28 18:12:59 rtoy Exp $")
(in-package "STREAM")
......@@ -35,12 +35,15 @@
(,unput 1)
(return (values +replacement-character-code+ (1+ ,j)))))))))
(check (,n ,i)
(declare (type lisp:codepoint ,n)
(declare (type (unsigned-byte 31) ,n)
(type (integer 1 5) ,i))
;; We check for overlong sequences (sequences that
;; encode to codepoints that don't need that long of a
;; sequence) and any surrogate values.
(if (or (<= ,n (the (member 127 1023 32767) (svref #(127 1023 32767) (1- ,i)))) ; overlong
;; sequence) and any surrogate values and any code
;; outside the 21-bit Unicode range.
(if (or (> ,n #x10ffff)
(<= ,n (the (member 127 1023 32767)
(svref #(127 1023 32767) (1- ,i)))) ; overlong
(lisp::surrogatep ,n)) ; surrogate
(progn
(,unput ,i)
......
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