X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Fenc-basic.lisp;h=0deb08a3f55cbc71ac7b6753e9762c3b85ebb284;hb=8ea7b1a452fc87f91273c96bead8aa862bbc8b98;hp=dee5211c848f60b9143b278a6049121299f100a6;hpb=7cf58295cc5e1ca50651c4b93023ae8681fed8fb;p=sbcl.git diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp index dee5211..0deb08a 100644 --- a/src/code/external-formats/enc-basic.lisp +++ b/src/code/external-formats/enc-basic.lisp @@ -59,13 +59,14 @@ finally (return (coerce string 'simple-string)))))))) (instantiate-octets-definition define-ascii->string) -(define-external-format (:ascii :us-ascii :ansi_x3.4-1968 - :iso-646 :iso-646-us :|646|) - 1 t +(define-unibyte-external-format :ascii + (:us-ascii :ansi_x3.4-1968 :iso-646 :iso-646-us :|646|) (if (>= bits 128) (external-format-encoding-error stream bits) (setf (sap-ref-8 sap tail) bits)) - (code-char byte) + (if (>= byte 128) + (return-from decode-break-reason 1) + (code-char byte)) ascii->string-aref string->ascii) @@ -101,8 +102,7 @@ ;;; Multiple names for the :ISO{,-}8859-* families are needed because on ;;; FreeBSD (and maybe other BSD systems), nl_langinfo("LATIN-1") will ;;; return "ISO8859-1" instead of "ISO-8859-1". -(define-external-format (:latin-1 :latin1 :iso-8859-1 :iso8859-1) - 1 t +(define-unibyte-external-format :latin-1 (:latin1 :iso-8859-1 :iso8859-1) (if (>= bits 256) (external-format-encoding-error stream bits) (setf (sap-ref-8 sap tail) bits)) @@ -383,6 +383,7 @@ (instantiate-octets-definition define-utf8->string) (define-external-format/variable-width (:utf-8 :utf8) t + #!+sb-unicode (code-char #xfffd) #!-sb-unicode #\? (let ((bits (char-code byte))) (cond ((< bits #x80) 1) ((< bits #x800) 2) @@ -401,11 +402,11 @@ (sap-ref-8 sap (+ 1 tail)) (logior #x80 (ldb (byte 6 12) bits)) (sap-ref-8 sap (+ 2 tail)) (logior #x80 (ldb (byte 6 6) bits)) (sap-ref-8 sap (+ 3 tail)) (logior #x80 (ldb (byte 6 0) bits))))) - (cond ((< byte #x80) 1) - ((< byte #xc2) (return-from decode-break-reason 1)) - ((< byte #xe0) 2) - ((< byte #xf0) 3) - (t 4)) + (1 (cond ((< byte #x80) 1) + ((< byte #xc2) (return-from decode-break-reason 1)) + ((< byte #xe0) 2) + ((< byte #xf0) 3) + (t 4))) (code-char (ecase size (1 byte) (2 (let ((byte2 (sap-ref-8 sap (1+ head))))