From: Kevin M. Rosenberg Date: Thu, 21 Mar 2002 11:38:07 +0000 (+0000) Subject: r1608: Reworked LW cstring to use built-in LW conversion X-Git-Tag: v1.6.1~558 X-Git-Url: http://git.kpe.io/?p=uffi.git;a=commitdiff_plain;h=f860fa69768ba86084196b9e482d497d7ef60901 r1608: Reworked LW cstring to use built-in LW conversion --- diff --git a/ChangeLog b/ChangeLog index ec60019..8e4c6a0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -11,6 +11,7 @@ See TODO file -- actively maintained. Includes changes that you * Fixed documentation error on gethostname * Added ensure-char-* and def-union to documentation * Added double-float vector example to c-test-fns + * Reworked cstring on Lispworks to have LW handle string conversion 20 Mar 2002 * Updated strings.cl so that foreign-strings are always unsigned. diff --git a/src/primitives.cl b/src/primitives.cl index bf013e6..0b5f055 100644 --- a/src/primitives.cl +++ b/src/primitives.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: primitives.cl,v 1.11 2002/03/21 10:58:57 kevin Exp $ +;;;; $Id: primitives.cl,v 1.12 2002/03/21 11:38:07 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -64,7 +64,9 @@ supports takes advantage of this optimization." (:unsigned-long . (alien:unsigned 32)) (:float . alien:single-float) (:double . alien:double-float) - )) + ) + "Conversions in CMUCL or def-foreign-type are different thatn in def-function") + #+cmu (defconstant +type-conversion-list+ @@ -99,7 +101,8 @@ supports takes advantage of this optimization." '((* . :pointer) (:void . :void) (:short . :short) (:pointer-void . (:pointer :unsigned :void)) - (:cstring . (:pointer (:unsigned :char))) + (:cstring . (:reference-pass :ef-mb-string :allow-null t)) + (:cstring-returning . (:reference :ef-mb-string :allow-null t)) (:char . :char) (:byte :byte) (:unsigned-char . (:unsigned :char)) @@ -115,6 +118,12 @@ supports takes advantage of this optimization." (dolist (type +cmu-def-type-list+) (setf (gethash (car type) +cmu-def-type-hash+) (cdr type))) +(defun basic-convert-from-uffi-type (type) + (let ((found-type (gethash type +type-conversion-hash+))) + (if found-type + found-type + type))) + (defun convert-from-uffi-type (type context) "Converts from a uffi type to an implementation specific type" (if (atom type) @@ -128,17 +137,15 @@ supports takes advantage of this optimization." (let ((cmu-type (gethash type +cmu-def-type-hash+))) (if cmu-type cmu-type - (let ((found-type (gethash type +type-conversion-hash+))) - (if found-type - found-type - type))))) + (basic-convert-from-uffi-type type)))) + #+lispworks + ((and (eq context :return) + (eq type :cstring)) + (basic-convert-from-uffi-type :cstring-returning)) (t - (let ((found-type (gethash type +type-conversion-hash+))) - (if found-type - found-type - type)))) - (cons (convert-from-uffi-type (first type) context) - (convert-from-uffi-type (rest type) context)))) + (basic-convert-from-uffi-type type))) + (cons (convert-from-uffi-type (first type) context) + (convert-from-uffi-type (rest type) context)))) diff --git a/src/strings.cl b/src/strings.cl index e6abd80..ba4dfa2 100644 --- a/src/strings.cl +++ b/src/strings.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: strings.cl,v 1.10 2002/03/21 05:57:03 kevin Exp $ +;;;; $Id: strings.cl,v 1.11 2002/03/21 11:38:07 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -27,14 +27,9 @@ (defmacro convert-from-cstring (obj) "Converts a string from a c-call. Same as convert-from-foreign-string, except -that CMU automatically converts strings from c-calls." +that LW/CMU automatically converts strings from c-calls." #+cmu obj - #+lispworks - (let ((stored (gensym))) - `(let ((,stored ,obj)) - (if (fli:null-pointer-p ,stored) - nil - (fli:convert-from-foreign-string ,stored)))) + #+lispworks obj #+allegro (let ((stored (gensym))) `(let ((,stored ,obj)) @@ -44,56 +39,37 @@ that CMU automatically converts strings from c-calls." ) (defmacro convert-to-cstring (obj) - #+lispworks - `(if (null ,obj) - +null-cstring-pointer+ - (fli:convert-to-foreign-string ,obj)) + #+cmu obj + #+lispworks obj #+allegro `(if (null ,obj) 0 (values (excl:string-to-native ,obj))) - #+cmu - (declare (ignore obj)) ) (defmacro free-cstring (obj) - #+lispworks - `(unless (fli:null-pointer-p ,obj) - (fli:free-foreign-object ,obj)) + #+cmu (declare (ignore obj)) + #+lispworks (declare (ignore obj)) #+allegro `(unless (zerop obj) (ff:free-fobject ,obj)) - #+cmu - (declare (ignore obj)) ) -;; Either length or null-terminated-p must be non-nil -(defmacro convert-from-foreign-string (obj &key - length - (null-terminated-p t)) - #+allegro - `(if (zerop ,obj) - nil - (values (excl:native-to-string - ,obj - ,@(if length (list :length length) (values)) - :truncate (not ,null-terminated-p)))) - #+lispworks - `(if (fli:null-pointer-p ,obj) - nil - (fli:convert-from-foreign-string - ,obj - ,@(if length (list :length length) (values)) - :null-terminated-p ,null-terminated-p - :external-format '(:latin-1 :eol-style :lf))) +(defmacro with-cstring ((cstring lisp-string) &body body) #+cmu - `(if (null-pointer-p ,obj) - nil - (cmucl-naturalize-cstring (alien:alien-sap ,obj) - :length ,length - :null-terminated-p ,null-terminated-p)) + `(let ((,cstring ,lisp-string)) ,@body) + #+lispworks + `(let ((,cstring ,lisp-string)) ,@body) + #+allegro + (let ((acl-native (gensym))) + `(excl:with-native-string (,acl-native ,lisp-string) + (let ((,cstring (if ,lisp-string ,acl-native 0))) + ,@body))) ) + +;;; Foreign string functions + (defmacro convert-to-foreign-string (obj) #+lispworks `(if (null ,obj) @@ -124,6 +100,35 @@ that CMU automatically converts strings from c-calls." ) +;; Either length or null-terminated-p must be non-nil +(defmacro convert-from-foreign-string (obj &key + length + (null-terminated-p t)) + #+allegro + `(if (zerop ,obj) + nil + (values (excl:native-to-string + ,obj + ,@(if length (list :length length) (values)) + :truncate (not ,null-terminated-p)))) + #+lispworks + `(if (fli:null-pointer-p ,obj) + nil + (fli:convert-from-foreign-string + ,obj + ,@(if length (list :length length) (values)) + :null-terminated-p ,null-terminated-p + :external-format '(:latin-1 :eol-style :lf))) + #+cmu + `(if (null-pointer-p ,obj) + nil + (cmucl-naturalize-cstring (alien:alien-sap ,obj) + :length ,length + :null-terminated-p ,null-terminated-p)) + ) + + + (defmacro allocate-foreign-string (size &key (unsigned t)) #+cmu (let ((array-def (gensym))) @@ -152,21 +157,7 @@ that CMU automatically converts strings from c-calls." (free-foreign-object ,foreign-string) ,result))) -(defmacro with-cstring ((cstring lisp-string) &body body) - #+cmu - `(let ((,cstring ,lisp-string)) ,@body) - #+allegro - (let ((acl-native (gensym))) - `(excl:with-native-string (,acl-native ,lisp-string) - (let ((,cstring (if ,lisp-string ,acl-native 0))) - ,@body))) - #+lispworks - (let ((result (gensym))) - `(let* ((,cstring (convert-to-cstring ,lisp-string)) - (,result (progn ,@body))) - (fli:free-foreign-object ,cstring) - ,result)) - ) +