Changeset 8844


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

Move some UTF-16 stuff here. FD-OPEN assumes native-endian UTF-16
encoding on Windows.

File:
1 edited

Legend:

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

    r8715 r8844  
    4949                    3
    5050                    4))))))
     51    0))
     52
     53(defun utf-16-octets-in-string (string start end)
     54  (if (>= end start)
     55    (do* ((noctets 0)
     56          (i start (1+ i)))
     57         ((= i end) noctets)
     58      (declare (fixnum noctets))
     59      (let* ((code (char-code (schar string i))))
     60        (declare (type (mod #x110000) code))
     61        (incf noctets
     62              (if (< code #x10000)
     63                2
     64                4))))
    5165    0))
    5266
     
    8599                   (logand #x3f code))
    86100             (incf idx 4))))))
     101
     102(defun native-utf-16-memory-encode (string pointer idx start end)
     103  (declare (fixnum idx))
     104  (do* ((i start (1+ i)))
     105       ((>= i end) idx)
     106    (let* ((code (char-code (schar string i)))
     107           (highbits (- code #x10000)))
     108      (declare (type (mod #x110000) code)
     109               (fixnum  highbits))
     110      (cond ((< highbits 0)
     111             (setf (%get-unsigned-word pointer idx) code)
     112             (incf idx 2))
     113            (t
     114             (setf (%get-unsigned-word pointer idx) (logior #xd800 (the fixnum (ash highbits -10))))
     115             (incf idx 2)
     116             (setf (%get-unsigned-word pointer idx) (logior #xdc00 (the fixnum (logand highbits #x3ff))))
     117             (incf idx 2))))))
    87118
    88119(defun utf-8-memory-decode (pointer noctets idx string)
     
    171202
    172203(defun fd-open (path flags &optional (create-mode #o666))
    173   (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((p path))
     204  (#+darwin-target with-utf-8-cstrs
     205   #+windows-target with-native-utf-16-cstrs
     206   #-(or darwin-target windows-target) with-cstrs
     207   ((p path))
    174208    (let* ((fd (syscall syscalls::open p flags create-mode)))
    175209      (declare (fixnum fd))
Note: See TracChangeset for help on using the changeset viewer.