clsql/uffi clsql-uffi.lisp,1.5,1.6

"Kevin M. Rosenberg" <[email protected]> Thu, 15 May 2003 01:33:23 -0600
Newsgroups gmane.lisp.clsql.cvs
Message-ID <[email protected]>
Update of /pubcvs/clsql/uffi
In directory boa.b9.com:/tmp/cvs-serv29634/uffi

Modified Files:
	clsql-uffi.lisp 
Log Message:
Auto commit for Debian build

Index: clsql-uffi.lisp
===================================================================
RCS file: /pubcvs/clsql/uffi/clsql-uffi.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** clsql-uffi.lisp	6 May 2003 02:22:58 -0000	1.5
--- clsql-uffi.lisp	15 May 2003 07:33:21 -0000	1.6
***************
*** 121,124 ****
--- 121,144 ----
  		  (make-64-bit-integer high32 low32)))))
  	 (t
+ 	  (native-to-string char-ptr)
+ 	  #+ignore
  	  (uffi:convert-from-foreign-string char-ptr)))))))
    
+ 
+ (uffi:def-function "strlen"
+     ((str (* :unsigned-char)))
+   :returning :unsigned-int)
+ 
+ (defun native-to-string (s)
+   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0)))
+   (let* ((len (strlen s))
+ 	 (str (make-string len)))
+     (declare (fixnum len)
+ 	     (simple-string str))
+     (do ((i 0))
+ 	((= i len))
+       (declare (fixnum i))
+       (setf (schar str i)
+ 	(code-char (uffi:deref-array s '(:array :unsigned-char) i)))
+       (incf i))
+     str))