[cffi-devel] uffi and CUSTOM:*FOREIGN-ENCODING* from clisp

[Yaroslav Kavenchuk]

Pascal Bourguignon make patch
http://sourceforge.net/mailarchive/forum.php?thread_id=8889229&forum_id=6767

I test it - it is work! :)

Please, append it.

Thanks!

File strings.diff
=========================================================
--- /src/strings.lisp    Fri Oct  7 03:32:50 2005
+++ /src/strings.lisp    Fri Nov  4 23:56:57 2005
@@ -33,6 +33,7 @@
 ;;; and vice versa.  Currently this is blithely ignorant of encoding
 ;;; and assumes characters can fit in 8 bits.
 
+#-clisp
 (defun lisp-string-to-foreign (string ptr size)
   "Copy at most SIZE-1 characters from a Lisp STRING to PTR.
 The foreign string will be null-terminated."
@@ -42,6 +43,7 @@
         do (setf (%mem-ref ptr :unsigned-char (post-incf i)) (char-code 
char))
         finally (setf (%mem-ref ptr :unsigned-char i) 0)))
 
+#-clisp
 (defun foreign-string-to-lisp (ptr &optional (size most-positive-fixnum)
                                (null-terminated-p t))
   "Copy at most SIZE characters from PTR into a Lisp string.
@@ -52,6 +54,41 @@
             for code = (mem-ref ptr :unsigned-char i)
             until (and null-terminated-p (zerop code))
             do (write-char (code-char code) s)))))
+
+#+clisp
+(defun lisp-string-to-foreign (string ptr size)
+  "Copy at most SIZE-1 characters from a Lisp STRING to PTR.
+The foreign string will be null-terminated."
+  (decf size)
+  (loop
+     :with bytes = (ext:convert-string-to-bytes string 
custom:*foreign-encoding*)
+     :with i = 0
+     :for byte :across bytes
+     :while (< i size)
+     :do (setf (%mem-ref ptr :unsigned-char (post-incf i)) byte)
+     :finally (setf (%mem-ref ptr :unsigned-char i) 0)))
+
+#+clisp
+(defun clength (ptr size)
+  (loop
+     :for i :from 0 :below size
+     :do (when (zerop (mem-ref ptr :unsigned-char i))
+           (return-from clength i))
+     :finally (return-from clength size)))
+
+#+clisp
+(defun foreign-string-to-lisp (ptr &optional (size most-positive-fixnum)
+                               (null-terminated-p t))
+  "Copy at most SIZE characters from PTR into a Lisp string.
+If PTR is a null pointer, returns nil."
+  (unless (null-ptr-p ptr)
+    (loop
+       :with clen = (if null-terminated-p (clength ptr size) size)
+       :with bytes = (make-array clen :element-type '(unsigned-byte 8))
+       :for i fixnum from 0 below clen
+       :do (setf (aref bytes i) (mem-ref ptr :unsigned-char i))
+       :finally (return (ext:convert-string-from-bytes bytes
+                                               
custom:*foreign-encoding*)))))
 
 ;;;# Using Foreign Strings