clsql/uffi clsql-uffi.lisp,1.8,1.9

Update of /pubcvs/clsql/uffi
In directory boa.b9.com:/tmp/cvs-serv13123/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.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** clsql-uffi.lisp	15 May 2003 07:45:17 -0000	1.8
--- clsql-uffi.lisp	16 May 2003 08:04:02 -0000	1.9
***************
*** 146,147 ****
--- 146,195 ----
        (incf i))
      str))
+ 
+ #-allegro
+ (defun native-to-string (s)
+   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
+ 	   (type char-ptr-def s))
+   (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))
+ 
+ #+allegro
+ (excl:ics-target-case
+  (:-ics
+   (defun native-to-string (s)
+     (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
+ 	     (type char-ptr-def s))
+     (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)))
+  (:+ics
+   (defun native-to-string (s)
+   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
+ 	   (type char-ptr-def s))
+   (let* ((len (strlen s))
+ 	 (str (make-string len)))
+     (declare (fixnum len)
+ 	     (type (simple-array (unsigned-byte 8) (*)) str))
+     (do ((i 0))
+ 	((= i len))
+       (declare (fixnum i))
+       (setf (aref str i) (uffi:deref-array s '(:array :unsigned-char) i))
+       (incf i))
+     str))))