[Openmcl-cvs-notifications] r11203 - /trunk/source/level-1/l1-unicode.lisp

gb at clozure.com gb at clozure.com
Thu Oct 23 05:50:38 EDT 2008


Author: gb
Date: Thu Oct 23 05:50:38 2008
New Revision: 11203

Log:
Add GET-ENCODED-CSTRING.

Modified:
    trunk/source/level-1/l1-unicode.lisp

Modified: trunk/source/level-1/l1-unicode.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-unicode.lisp (original)
+++ trunk/source/level-1/l1-unicode.lisp Thu Oct 23 05:50:38 2008
@@ -4834,7 +4834,24 @@
                  0
                  string)
         string))))
-        =

+
+
+(defun get-encoded-cstring (encoding-name pointer)
+  (let* ((encoding (ensure-character-encoding encoding-name)))
+    (get-encoded-string
+     encoding
+     pointer
+     (ecase (character-encoding-code-unit-size encoding)
+       (8 (%cstrlen pointer))
+       (16 (do* ((i 0 (+ i 2)))
+                ((=3D 0 (%get-unsigned-word pointer i))
+                 (return i))
+             (declare (fixnum i))))
+       (32 (do* ((i 0 (+ i 4)))
+                ((=3D 0 (%get-unsigned-long pointer i))
+                 (return i))
+             (declare (fixnum i))))))))
+    =

 =

       =

 =




More information about the Openmcl-cvs-notifications mailing list