X-Git-Url: http://git.kpe.io/?p=uffi.git;a=blobdiff_plain;f=src%2Fstrings.lisp;h=f41113ba416955665ddcb68617c905dca530b85e;hp=69f1f02836f9fbf0ff37b21af145a076029ed091;hb=996ef9dcf5bf917a6a0e977a23b9cafb522c107c;hpb=1637f388b265527527ab4a583196127a71fcd549 diff --git a/src/strings.lisp b/src/strings.lisp index 69f1f02..f41113b 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 @@ -398,7 +398,7 @@ that LW/CMU automatically converts strings from c-calls." (declare (fixnum len) (type (simple-array (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)