Changeset 8716


Ignore:
Timestamp:
Mar 11, 2008, 6:42:12 PM (12 years ago)
Author:
gb
Message:

Add %GET-NATIVE-UTF-16-STRING.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/win64/level-0/l0-misc.lisp

    r8579 r8716  
    439439          string))
    440440    (declare (fixnum end))))
     441
     442;;; Assumes that pointer is terminated by a 0-valued 16-bit word
     443;;; and that it points to a valid utf-16 string with native endianness.
     444(defun %get-native-utf-16-c-string (pointer)
     445  (do* ((nchars 0 (1+ nchars))
     446        (i 0 (+ i 2))
     447        (code (%get-unsigned-word pointer i) (%get-unsigned-word pointer i)))
     448       ((zerop code)
     449        (do* ((string (make-string nchars))
     450              (out 0 (1+ out))
     451              (i 0 (+ i 2)))
     452             ((= out nchars) string)
     453          (declare (fixnum i out))
     454          (let* ((code (%get-unsigned-word pointer i)))
     455            (declare (type (unsigned-byte 16) code))
     456            (when (and (>= code #xd800)
     457                       (< code #xdc00))
     458              (incf i 2)
     459              (let* ((code2 (%get-unsigned-word pointer i)))
     460                (declare (type (unsigned-byte 16) code2))
     461                (setq code (utf-16-combine-surrogate-pairs code code2))))
     462            (setf (schar string out) (code-char code)))))
     463    (when (and (>= code #xd800) (< code #xdc00))
     464      (incf i 2))))
     465
    441466
    442467;;; This is mostly here so we can bootstrap shared libs without
Note: See TracChangeset for help on using the changeset viewer.