Changeset 8847


Ignore:
Timestamp:
Mar 21, 2008, 10:39:36 AM (11 years ago)
Author:
gb
Message:

Move some UTF-16 stuff to level-0.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/win64/level-1/l1-unicode.lisp

    r8573 r8847  
    32093209
    32103210
    3211 (defun utf-16-octets-in-string (string start end)
    3212   (if (>= end start)
    3213     (do* ((noctets 0)
    3214           (i start (1+ i)))
    3215          ((= i end) noctets)
    3216       (declare (fixnum noctets))
    3217       (let* ((code (char-code (schar string i))))
    3218         (declare (type (mod #x110000) code))
    3219         (incf noctets
    3220               (if (< code #x10000)
    3221                 2
    3222                 4))))
    3223     0))
     3211
    32243212
    32253213
     
    33493337             (setf (schar string i) (or char #\Replacement_Character)))))))
    33503338    :memory-encode-function
    3351     (nfunction
    3352      native-utf-16-memory-encode
    3353      (lambda (string pointer idx start end)
    3354        (declare (fixnum idx))
    3355        (do* ((i start (1+ i)))
    3356             ((>= i end) idx)
    3357          (let* ((code (char-code (schar string i)))
    3358                 (highbits (- code #x10000)))
    3359            (declare (type (mod #x110000) code)
    3360                   (fixnum  highbits))
    3361          (cond ((< highbits 0)
    3362                 (setf (%get-unsigned-word pointer idx) code)
    3363                 (incf idx 2))
    3364                (t
    3365                 (setf (%get-unsigned-word pointer idx) (logior #xd800 (the fixnum (ash highbits -10))))
    3366                 (incf idx 2)
    3367                 (setf (%get-unsigned-word pointer idx) (logior #xdc00 (the fixnum (logand highbits #x3ff))))
    3368                 (incf idx 2)))))))
     3339    #'native-utf-16-memory-encode
    33693340    :memory-decode-function
    33703341    (nfunction
Note: See TracChangeset for help on using the changeset viewer.