-(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
(#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
(#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
)
(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)
(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
)
(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)
(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
)
(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)
(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