X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Fenc-cyr.lisp;h=a0e033e95433070bb9d4ac67c0a83394c7d38884;hb=b0639279b6c76ab5aa53c58c41ae472eaa361222;hp=0cfa0e34b7323eb0269044379136de45b8669736;hpb=b3e3fbe7d381147fccc8a3027cb6fae923e57d13;p=sbcl.git diff --git a/src/code/external-formats/enc-cyr.lisp b/src/code/external-formats/enc-cyr.lisp index 0cfa0e3..a0e033e 100644 --- a/src/code/external-formats/enc-cyr.lisp +++ b/src/code/external-formats/enc-cyr.lisp @@ -1,4 +1,4 @@ -(in-package #:sb!impl) +(in-package "SB!IMPL") (define-unibyte-mapper koi8-r->code-mapper code->koi8-r-mapper (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL @@ -132,11 +132,11 @@ ) (declaim (inline get-koi8-r-bytes)) -(defun get-koi8-r-bytes(string pos end) +(defun get-koi8-r-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :koi8-r string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->koi8-r-mapper :koi8-r string pos)) (defun string->koi8-r (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -149,31 +149,30 @@ (let ((name (make-od-name 'koi8-r->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 #'koi8-r->code-mapper))))) (instantiate-octets-definition define-koi8-r->string*) (defmacro define-koi8-r->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'koi8-r->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'koi8-r->code-mapper))) (instantiate-octets-definition define-koi8-r->string) -(push '((:koi8-r :|koi8-r|) - koi8-r->string-aref string->koi8-r) - *external-format-functions*) +(add-external-format-funs '(:koi8-r :|koi8-r|) + '(koi8-r->string-aref string->koi8-r)) (define-external-format (:koi8-r :|koi8-r|) 1 t (let ((koi8-r-byte (code->koi8-r-mapper bits))) (if koi8-r-byte (setf (sap-ref-8 sap tail) koi8-r-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (koi8-r->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 koi8-u->code-mapper code->koi8-u-mapper (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL @@ -307,11 +306,11 @@ ) (declaim (inline get-koi8-u-bytes)) -(defun get-koi8-u-bytes(string pos end) +(defun get-koi8-u-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :koi8-u string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->koi8-u-mapper :koi8-u string pos)) (defun string->koi8-u (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -324,31 +323,30 @@ (let ((name (make-od-name 'koi8-u->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 #'koi8-u->code-mapper))))) (instantiate-octets-definition define-koi8-u->string*) (defmacro define-koi8-u->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'koi8-u->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'koi8-u->code-mapper))) (instantiate-octets-definition define-koi8-u->string) -(push '((:koi8-u :|koi8-u|) - koi8-u->string-aref string->koi8-u) - *external-format-functions*) +(add-external-format-funs '(:koi8-u :|koi8-u|) + '(koi8-u->string-aref string->koi8-u)) (define-external-format (:koi8-u :|koi8-u|) 1 t (let ((koi8-u-byte (code->koi8-u-mapper bits))) (if koi8-u-byte (setf (sap-ref-8 sap tail) koi8-u-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (koi8-u->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 x-mac-cyrillic->code-mapper code->x-mac-cyrillic-mapper (#x80 #x0410) ; CYRILLIC CAPITAL LETTER A @@ -477,11 +475,11 @@ ) (declaim (inline get-x-mac-cyrillic-bytes)) -(defun get-x-mac-cyrillic-bytes(string pos end) +(defun get-x-mac-cyrillic-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :x-mac-cyrillic string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->x-mac-cyrillic-mapper :x-mac-cyrillic string pos)) (defun string->x-mac-cyrillic (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -494,28 +492,27 @@ (let ((name (make-od-name 'x-mac-cyrillic->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 #'x-mac-cyrillic->code-mapper))))) (instantiate-octets-definition define-x-mac-cyrillic->string*) (defmacro define-x-mac-cyrillic->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'x-mac-cyrillic->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'x-mac-cyrillic->code-mapper))) (instantiate-octets-definition define-x-mac-cyrillic->string) -(push '((:x-mac-cyrillic :|x-mac-cyrillic|) - x-mac-cyrillic->string-aref string->x-mac-cyrillic) - *external-format-functions*) +(add-external-format-funs '(:x-mac-cyrillic :|x-mac-cyrillic|) + '(x-mac-cyrillic->string-aref string->x-mac-cyrillic)) (define-external-format (:x-mac-cyrillic :|x-mac-cyrillic|) 1 t (let ((x-mac-cyrillic-byte (code->x-mac-cyrillic-mapper bits))) (if x-mac-cyrillic-byte (setf (sap-ref-8 sap tail) x-mac-cyrillic-byte) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (x-mac-cyrillic->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