Changeset 10663


Ignore:
Timestamp:
Sep 8, 2008, 3:41:12 PM (11 years ago)
Author:
gb
Message:

%GET-NATIVE-UTF-16-CSTRING.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-misc.lisp

    r10661 r10663  
    426426    (declare (fixnum end))))
    427427
     428;;; Assumes that pointer is terminated by a 0-valued 16-bit word
     429;;; and that it points to a valid utf-16 string with native endianness.
     430(defun %get-native-utf-16-cstring (pointer)
     431  (do* ((nchars 0 (1+ nchars))
     432        (i 0 (+ i 2))
     433        (code (%get-unsigned-word pointer i) (%get-unsigned-word pointer i)))
     434       ((zerop code)
     435        (do* ((string (make-string nchars))
     436              (out 0 (1+ out))
     437              (i 0 (+ i 2)))
     438             ((= out nchars) string)
     439          (declare (fixnum i out))
     440          (let* ((code (%get-unsigned-word pointer i)))
     441            (declare (type (unsigned-byte 16) code))
     442            (when (and (>= code #xd800)
     443                       (< code #xdc00))
     444              (incf i 2)
     445              (let* ((code2 (%get-unsigned-word pointer i)))
     446                (declare (type (unsigned-byte 16) code2))
     447                (setq code (utf-16-combine-surrogate-pairs code code2))))
     448            (setf (schar string out) (code-char code)))))
     449    (when (and (>= code #xd800) (< code #xdc00))
     450      (incf i 2))))
     451
     452
    428453;;; This is mostly here so we can bootstrap shared libs without
    429454;;; having to bootstrap #_strcmp.
Note: See TracChangeset for help on using the changeset viewer.