X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Fenc-cyr.lisp;h=7883f0649ae25f086a5ed4161fff5d0d767ab043;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=637ea96b4ee97b6a4bba0b342ff9374a61906d8c;hpb=42fcad110cd7e966c89bda8f5d3be96862ba1dbd;p=sbcl.git diff --git a/src/code/external-formats/enc-cyr.lisp b/src/code/external-formats/enc-cyr.lisp index 637ea96..7883f06 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 @@ -32,7 +32,7 @@ (#x9C #x00B0) ; DEGREE SIGN (#x9D #x00B2) ; SUPERSCRIPT TWO (#x9E #x00B7) ; MIDDLE DOT - (#x9F #x00F7) ; DIVISION SIGN + (#x9F #x00F7) ; DIVISION SIGN (#xA0 #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL (#xA1 #x2551) ; BOX DRAWINGS DOUBLE VERTICAL (#xA2 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE @@ -64,7 +64,7 @@ (#xBC #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE (#xBD #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE (#xBE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL - (#xBF #x00A9) ; COPYRIGHT SIGN + (#xBF #x00A9) ; COPYRIGHT SIGN (#xC0 #x044E) ; CYRILLIC SMALL LETTER YU (#xC1 #x0430) ; CYRILLIC SMALL LETTER A (#xC2 #x0431) ; CYRILLIC SMALL LETTER BE @@ -132,16 +132,16 @@ ) (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 simple-string string) + (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)) - (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-koi8-r-bytes null-padding))) (defmacro define-koi8-r->string* (accessor type) @@ -149,31 +149,29 @@ (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*) - (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))) + koi8-r->string-aref + string->koi8-r) ;; TODO -- error check (define-unibyte-mapper koi8-u->code-mapper code->koi8-u-mapper (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL @@ -307,16 +305,16 @@ ) (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 simple-string string) + (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)) - (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-koi8-u-bytes null-padding))) (defmacro define-koi8-u->string* (accessor type) @@ -324,31 +322,29 @@ (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*) - (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))) + koi8-u->string-aref + string->koi8-u) ;; TODO -- error check (define-unibyte-mapper x-mac-cyrillic->code-mapper code->x-mac-cyrillic-mapper (#x80 #x0410) ; CYRILLIC CAPITAL LETTER A @@ -477,16 +473,16 @@ ) (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 simple-string string) + (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)) - (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-x-mac-cyrillic-bytes null-padding))) (defmacro define-x-mac-cyrillic->string* (accessor type) @@ -494,28 +490,26 @@ (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*) - (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))) + x-mac-cyrillic->string-aref + string->x-mac-cyrillic) ;; TODO -- error check