X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Fenc-dos.lisp;h=edb9457826cb21e6cbdb5bb1ab1525d8aeb41356;hb=54b330585ed41edeb93a289f0e59aec67fa9ded9;hp=2755770ba9a2a70a1b337fd6dc197b39244b2b07;hpb=42fcad110cd7e966c89bda8f5d3be96862ba1dbd;p=sbcl.git diff --git a/src/code/external-formats/enc-dos.lisp b/src/code/external-formats/enc-dos.lisp index 2755770..edb9457 100644 --- a/src/code/external-formats/enc-dos.lisp +++ b/src/code/external-formats/enc-dos.lisp @@ -134,14 +134,14 @@ (declaim (inline get-cp437-bytes)) (defun get-cp437-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp437 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp437-mapper :cp437 string pos end)) (defun string->cp437 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp437-bytes null-padding))) (defmacro define-cp437->string* (accessor type) @@ -149,14 +149,14 @@ (let ((name (make-od-name 'cp437->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp437->code-mapper))))) (instantiate-octets-definition define-cp437->string*) (defmacro define-cp437->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp437->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp437->code-mapper))) (instantiate-octets-definition define-cp437->string) @@ -169,11 +169,11 @@ (let ((cp437-byte (code->cp437-mapper bits))) (if cp437-byte (setf (sap-ref-8 sap tail) cp437-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp437->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp850->code-mapper code->cp850-mapper (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA @@ -309,14 +309,14 @@ (declaim (inline get-cp850-bytes)) (defun get-cp850-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp850 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp850-mapper :cp850 string pos end)) (defun string->cp850 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp850-bytes null-padding))) (defmacro define-cp850->string* (accessor type) @@ -324,14 +324,14 @@ (let ((name (make-od-name 'cp850->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp850->code-mapper))))) (instantiate-octets-definition define-cp850->string*) (defmacro define-cp850->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp850->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp850->code-mapper))) (instantiate-octets-definition define-cp850->string) @@ -344,11 +344,11 @@ (let ((cp850-byte (code->cp850-mapper bits))) (if cp850-byte (setf (sap-ref-8 sap tail) cp850-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp850->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp852->code-mapper code->cp852-mapper (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA @@ -484,14 +484,14 @@ (declaim (inline get-cp852-bytes)) (defun get-cp852-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp852 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp852-mapper :cp852 string pos end)) (defun string->cp852 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp852-bytes null-padding))) (defmacro define-cp852->string* (accessor type) @@ -499,14 +499,14 @@ (let ((name (make-od-name 'cp852->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp852->code-mapper))))) (instantiate-octets-definition define-cp852->string*) (defmacro define-cp852->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp852->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp852->code-mapper))) (instantiate-octets-definition define-cp852->string) @@ -519,11 +519,11 @@ (let ((cp852-byte (code->cp852-mapper bits))) (if cp852-byte (setf (sap-ref-8 sap tail) cp852-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp852->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp855->code-mapper code->cp855-mapper (#x80 #x0452) ; CYRILLIC SMALL LETTER DJE @@ -659,14 +659,14 @@ (declaim (inline get-cp855-bytes)) (defun get-cp855-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp855 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp855-mapper :cp855 string pos end)) (defun string->cp855 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp855-bytes null-padding))) (defmacro define-cp855->string* (accessor type) @@ -674,14 +674,14 @@ (let ((name (make-od-name 'cp855->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp855->code-mapper))))) (instantiate-octets-definition define-cp855->string*) (defmacro define-cp855->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp855->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp855->code-mapper))) (instantiate-octets-definition define-cp855->string) @@ -694,11 +694,11 @@ (let ((cp855-byte (code->cp855-mapper bits))) (if cp855-byte (setf (sap-ref-8 sap tail) cp855-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp855->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp857->code-mapper code->cp857-mapper (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA @@ -833,14 +833,14 @@ (declaim (inline get-cp857-bytes)) (defun get-cp857-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp857 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp857-mapper :cp857 string pos end)) (defun string->cp857 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp857-bytes null-padding))) (defmacro define-cp857->string* (accessor type) @@ -848,14 +848,14 @@ (let ((name (make-od-name 'cp857->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp857->code-mapper))))) (instantiate-octets-definition define-cp857->string*) (defmacro define-cp857->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp857->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp857->code-mapper))) (instantiate-octets-definition define-cp857->string) @@ -868,11 +868,11 @@ (let ((cp857-byte (code->cp857-mapper bits))) (if cp857-byte (setf (sap-ref-8 sap tail) cp857-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp857->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp860->code-mapper code->cp860-mapper (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA @@ -1008,14 +1008,14 @@ (declaim (inline get-cp860-bytes)) (defun get-cp860-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp860 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp860-mapper :cp860 string pos end)) (defun string->cp860 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp860-bytes null-padding))) (defmacro define-cp860->string* (accessor type) @@ -1023,14 +1023,14 @@ (let ((name (make-od-name 'cp860->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp860->code-mapper))))) (instantiate-octets-definition define-cp860->string*) (defmacro define-cp860->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp860->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp860->code-mapper))) (instantiate-octets-definition define-cp860->string) @@ -1043,11 +1043,11 @@ (let ((cp860-byte (code->cp860-mapper bits))) (if cp860-byte (setf (sap-ref-8 sap tail) cp860-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp860->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp861->code-mapper code->cp861-mapper (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA @@ -1183,14 +1183,14 @@ (declaim (inline get-cp861-bytes)) (defun get-cp861-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp861 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp861-mapper :cp861 string pos end)) (defun string->cp861 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp861-bytes null-padding))) (defmacro define-cp861->string* (accessor type) @@ -1198,14 +1198,14 @@ (let ((name (make-od-name 'cp861->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp861->code-mapper))))) (instantiate-octets-definition define-cp861->string*) (defmacro define-cp861->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp861->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp861->code-mapper))) (instantiate-octets-definition define-cp861->string) @@ -1218,11 +1218,11 @@ (let ((cp861-byte (code->cp861-mapper bits))) (if cp861-byte (setf (sap-ref-8 sap tail) cp861-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp861->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp862->code-mapper code->cp862-mapper (#x80 #x05D0) ; HEBREW LETTER ALEF @@ -1358,14 +1358,14 @@ (declaim (inline get-cp862-bytes)) (defun get-cp862-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp862 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp862-mapper :cp862 string pos end)) (defun string->cp862 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp862-bytes null-padding))) (defmacro define-cp862->string* (accessor type) @@ -1373,14 +1373,14 @@ (let ((name (make-od-name 'cp862->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp862->code-mapper))))) (instantiate-octets-definition define-cp862->string*) (defmacro define-cp862->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp862->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp862->code-mapper))) (instantiate-octets-definition define-cp862->string) @@ -1393,11 +1393,11 @@ (let ((cp862-byte (code->cp862-mapper bits))) (if cp862-byte (setf (sap-ref-8 sap tail) cp862-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp862->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp863->code-mapper code->cp863-mapper (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA @@ -1533,14 +1533,14 @@ (declaim (inline get-cp863-bytes)) (defun get-cp863-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp863 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp863-mapper :cp863 string pos end)) (defun string->cp863 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp863-bytes null-padding))) (defmacro define-cp863->string* (accessor type) @@ -1548,14 +1548,14 @@ (let ((name (make-od-name 'cp863->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp863->code-mapper))))) (instantiate-octets-definition define-cp863->string*) (defmacro define-cp863->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp863->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp863->code-mapper))) (instantiate-octets-definition define-cp863->string) @@ -1568,11 +1568,11 @@ (let ((cp863-byte (code->cp863-mapper bits))) (if cp863-byte (setf (sap-ref-8 sap tail) cp863-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp863->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp864->code-mapper code->cp864-mapper (#x80 #x00B0) ; DEGREE SIGN @@ -1705,14 +1705,14 @@ (declaim (inline get-cp864-bytes)) (defun get-cp864-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp864 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp864-mapper :cp864 string pos end)) (defun string->cp864 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp864-bytes null-padding))) (defmacro define-cp864->string* (accessor type) @@ -1720,14 +1720,14 @@ (let ((name (make-od-name 'cp864->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp864->code-mapper))))) (instantiate-octets-definition define-cp864->string*) (defmacro define-cp864->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp864->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp864->code-mapper))) (instantiate-octets-definition define-cp864->string) @@ -1740,11 +1740,11 @@ (let ((cp864-byte (code->cp864-mapper bits))) (if cp864-byte (setf (sap-ref-8 sap tail) cp864-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp864->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp865->code-mapper code->cp865-mapper (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA @@ -1880,14 +1880,14 @@ (declaim (inline get-cp865-bytes)) (defun get-cp865-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp865 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp865-mapper :cp865 string pos end)) (defun string->cp865 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp865-bytes null-padding))) (defmacro define-cp865->string* (accessor type) @@ -1895,14 +1895,14 @@ (let ((name (make-od-name 'cp865->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp865->code-mapper))))) (instantiate-octets-definition define-cp865->string*) (defmacro define-cp865->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp865->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp865->code-mapper))) (instantiate-octets-definition define-cp865->string) @@ -1915,11 +1915,11 @@ (let ((cp865-byte (code->cp865-mapper bits))) (if cp865-byte (setf (sap-ref-8 sap tail) cp865-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp865->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp866->code-mapper code->cp866-mapper (#x80 #x0410) ; CYRILLIC CAPITAL LETTER A @@ -2055,14 +2055,14 @@ (declaim (inline get-cp866-bytes)) (defun get-cp866-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp866 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp866-mapper :cp866 string pos end)) (defun string->cp866 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp866-bytes null-padding))) (defmacro define-cp866->string* (accessor type) @@ -2070,14 +2070,14 @@ (let ((name (make-od-name 'cp866->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp866->code-mapper))))) (instantiate-octets-definition define-cp866->string*) (defmacro define-cp866->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp866->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp866->code-mapper))) (instantiate-octets-definition define-cp866->string) @@ -2090,11 +2090,11 @@ (let ((cp866-byte (code->cp866-mapper bits))) (if cp866-byte (setf (sap-ref-8 sap tail) cp866-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp866->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp869->code-mapper code->cp869-mapper (#x80 nil) @@ -2230,14 +2230,14 @@ (declaim (inline get-cp869-bytes)) (defun get-cp869-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp869 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp869-mapper :cp869 string pos end)) (defun string->cp869 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp869-bytes null-padding))) (defmacro define-cp869->string* (accessor type) @@ -2245,14 +2245,14 @@ (let ((name (make-od-name 'cp869->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp869->code-mapper))))) (instantiate-octets-definition define-cp869->string*) (defmacro define-cp869->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp869->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp869->code-mapper))) (instantiate-octets-definition define-cp869->string) @@ -2265,11 +2265,11 @@ (let ((cp869-byte (code->cp869-mapper bits))) (if cp869-byte (setf (sap-ref-8 sap tail) cp869-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp869->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper cp874->code-mapper code->cp874-mapper (#x80 #x20AC) ; EURO SIGN @@ -2404,14 +2404,14 @@ (declaim (inline get-cp874-bytes)) (defun get-cp874-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :cp874 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->cp874-mapper :cp874 string pos end)) (defun string->cp874 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp874-bytes null-padding))) (defmacro define-cp874->string* (accessor type) @@ -2419,14 +2419,14 @@ (let ((name (make-od-name 'cp874->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp874->code-mapper))))) (instantiate-octets-definition define-cp874->string*) (defmacro define-cp874->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'cp874->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'cp874->code-mapper))) (instantiate-octets-definition define-cp874->string) @@ -2439,8 +2439,8 @@ (let ((cp874-byte (code->cp874-mapper bits))) (if cp874-byte (setf (sap-ref-8 sap tail) cp874-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (cp874->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check