X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fstrings.lisp;h=0bdeeabe277a0338f6c37bd2439de584da76e39d;hb=895cdddc64ad069c4d8173a21d0d5ce47b79e919;hp=69f1f02836f9fbf0ff37b21af145a076029ed091;hpb=6ab554f2441048c9c726104d4f3c6a6acccaf383;p=uffi.git

diff --git a/src/strings.lisp b/src/strings.lisp
index 69f1f02..0bdeeab 100644
--- a/src/strings.lisp
+++ b/src/strings.lisp
@@ -15,7 +15,7 @@
 (in-package #:uffi)
 
 
-(defvar +null-cstring-pointer+
+(def-pointer-var +null-cstring-pointer+
     #+(or cmu sbcl scl) nil
     #+allegro 0
     #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char))
@@ -26,13 +26,13 @@
   "Converts a string from a c-call. Same as convert-from-foreign-string, except
 that LW/CMU automatically converts strings from c-calls."
   #+(or cmu sbcl lispworks scl) obj
-  #+allegro 
+  #+allegro
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
        (if (zerop ,stored)
 	   nil
 	   (values (excl:native-to-string ,stored)))))
-  #+(or openmcl digitool) 
+  #+(or openmcl digitool)
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
        (if (ccl:%null-ptr-p ,stored)
@@ -74,7 +74,7 @@ that LW/CMU automatically converts strings from c-calls."
 
 (defmacro with-cstring ((cstring lisp-string) &body body)
   #+(or cmu sbcl scl lispworks)
-  `(let ((,cstring ,lisp-string)) ,@body) 
+  `(let ((,cstring ,lisp-string)) ,@body)
   #+allegro
   (let ((acl-native (gensym))
 	(stored-lisp-string (gensym)))
@@ -107,7 +107,7 @@ that LW/CMU automatically converts strings from c-calls."
     `(let ((,stored ,obj))
        (if (null ,stored)
 	   +null-cstring-pointer+
-	   (fli:convert-to-foreign-string 
+	   (fli:convert-to-foreign-string
 	    ,stored
 	    :external-format '(:latin-1 :eol-style :lf)))))
   #+allegro
@@ -123,7 +123,7 @@ that LW/CMU automatically converts strings from c-calls."
 	(i (gensym)))
     `(let ((,stored-obj ,obj))
        (etypecase ,stored-obj
-	 (null 
+	 (null
 	  (alien:sap-alien (system:int-sap 0) (* (alien:unsigned 8))))
 	 (string
 	  (let* ((,size (length ,stored-obj))
@@ -144,7 +144,7 @@ that LW/CMU automatically converts strings from c-calls."
 	(i (gensym)))
     `(let ((,stored-obj ,obj))
        (etypecase ,stored-obj
-	 (null 
+	 (null
 	  (sb-alien:sap-alien (sb-sys:int-sap 0) (* (sb-alien:unsigned 8))))
 	 (string
 	  (let* ((,size (length ,stored-obj))
@@ -182,7 +182,7 @@ that LW/CMU automatically converts strings from c-calls."
 	       (fast-native-to-string ,stored-obj ,length)
 	       (values
 		(excl:native-to-string
-		 ,stored-obj 
+		 ,stored-obj
 		 ,@(when length (list :length length))
 		 :truncate (not ,null-terminated-p)))))))
   #+lispworks
@@ -192,7 +192,7 @@ that LW/CMU automatically converts strings from c-calls."
 	   nil
 	   (if (eq ,locale :none)
 	       (fast-native-to-string ,stored-obj ,length)
-	       (fli:convert-from-foreign-string 
+	       (fli:convert-from-foreign-string
 		,stored-obj
 		,@(when length (list :length length))
 		:null-terminated-p ,null-terminated-p
@@ -234,27 +234,27 @@ that LW/CMU automatically converts strings from c-calls."
   #+ignore
   (let ((array-def (gensym)))
     `(let ((,array-def (list 'alien:array 'c-call:char ,size)))
-       (eval `(alien:cast (alien:make-alien ,,array-def) 
-			  ,(if ,unsigned 
+       (eval `(alien:cast (alien:make-alien ,,array-def)
+			  ,(if ,unsigned
 			       '(* (alien:unsigned 8))
 			     '(* (alien:signed 8)))))))
 
   #+(or cmu scl)
-  `(alien:make-alien ,(if unsigned 
+  `(alien:make-alien ,(if unsigned
 			     '(alien:unsigned 8)
 			     '(alien:signed 8))
     ,size)
 
   #+sbcl
-  `(sb-alien:make-alien ,(if unsigned 
+  `(sb-alien:make-alien ,(if unsigned
 			     '(sb-alien:unsigned 8)
 			     '(sb-alien:signed 8))
     ,size)
 
   #+lispworks
-  `(fli:allocate-foreign-object :type 
-				,(if unsigned 
-				     ''(:unsigned :char) 
+  `(fli:allocate-foreign-object :type
+				,(if unsigned
+				     ''(:unsigned :char)
 				   :char)
 				:nelems ,size)
   #+allegro
@@ -389,19 +389,20 @@ that LW/CMU automatically converts strings from c-calls."
 
 (def-type char-ptr-def (* :unsigned-char))
 
-#+(or lispworks (and allegro (not ics)))
+#+(or (and allegro (not ics)) (and lispworks (not lispworks5)))
 (defun fast-native-to-string (s len)
   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
 	   (type char-ptr-def s))
   (let* ((len (or len (strlen s)))
          (str (make-string len)))
     (declare (fixnum len)
-	     (type (simple-array (signed-byte 8) (*)) str))
+	     (type (simple-array #+lispworks base-char
+                                 #-lispworks (signed-byte 8) (*)) str))
     (dotimes (i len str)
-      (setf (aref str i) 
+      (setf (aref str i)
 	(uffi:deref-array s '(:array :char) i)))))
 
-#+(and allegro ics)
+#+(or (and allegro ics) lispworks5)
 (defun fast-native-to-string (s len)
   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
 	   (type char-ptr-def s))