[Openmcl-cvs-notifications] r10658 - /trunk/source/lib/macros.lisp

[gb at clozure.com]

Author: gb
Date: Mon Sep  8 11:27:55 2008
New Revision: 10658

Log:
WITH-NATIVE-UTF-16-CSTR[S].
INT-ERRNO-FFCALL.


Modified:
    trunk/source/lib/macros.lisp

Modified: trunk/source/lib/macros.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/lib/macros.lisp (original)
+++ trunk/source/lib/macros.lisp Mon Sep  8 11:27:55 2008
@@ -1640,7 +1640,22 @@
 =

 =

 =

-
+(defmacro with-native-utf-16-cstr ((sym str) &body body)
+  (let* ((data (gensym))
+         (offset (gensym))
+         (string (gensym))
+         (len (gensym))
+         (noctets (gensym))
+         (end (gensym)))
+    `(let* ((,string ,str)
+            (,len (length ,string)))
+      (multiple-value-bind (,data ,offset) (array-data-and-offset ,string)
+        (let* ((,end (+ ,offset ,len))
+               (,noctets (utf-16-octets-in-string ,data ,offset ,end)))
+          (%stack-block ((,sym (1+ ,noctets)))
+            (native-utf-16-memory-encode ,data ,sym 0 ,offset ,end)
+            (setf (%get-unsigned-word ,sym ,noctets) 0)
+            , at body))))))
 =

 (defmacro with-pointers (speclist &body body)
    (with-specs-aux 'with-pointer speclist body))
@@ -1652,6 +1667,9 @@
 =

 (defmacro with-utf-8-cstrs (speclist &body body)
    (with-specs-aux 'with-utf-8-cstr speclist body))
+
+(defmacro with-native-utf-16-cstrs (speclist &body body)
+  (with-specs-aux 'with-native-utf-16-cstr speclist body))
 =

 (defmacro with-encoded-cstr ((encoding-name (sym string &optional start en=
d))
                              &rest body &environment env)
@@ -3660,3 +3678,5 @@
         (%get-errno)
         ,value))))
 =

+(defmacro int-errno-ffcall (entry &rest args)
+  `(int-errno-call (ff-call ,entry , at args)))