X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fstrings.cl;h=0e1e20de513da50e414010a83c03e8768f46dad6;hb=bd00c8ed506689d49306569634294446e0a017e5;hp=6eeea2c60ff7d7bc7778940450c367cc4abd8227;hpb=192193db6e4fbda90a840474d4aa2e8762597927;p=uffi.git diff --git a/src/strings.cl b/src/strings.cl index 6eeea2c..0e1e20d 100644 --- a/src/strings.cl +++ b/src/strings.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: strings.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $ +;;;; $Id: strings.cl,v 1.3 2002/03/10 05:09:00 kevin Exp $ ;;;; ;;;; This file is part of the UFFI. ;;;; @@ -52,8 +52,10 @@ that CMU automatically converts strings from c-calls." (defmacro convert-to-c-string (obj) #+lispworks `(if (null ,obj) - +null-c-string-ptr+ - (fli:convert-to-foreign-string ,obj)) + +null-c-string-pointer+ + (fli:make-pointer + :address (fli:pointer-address (fli:convert-to-foreign-string ,obj)) + :type :char)) #+allegro `(if (null ,obj) 0 @@ -101,8 +103,10 @@ that CMU automatically converts strings from c-calls." (defmacro convert-to-foreign-string (obj) #+lispworks `(if (null ,obj) - +null-c-string-ptr+ - (fli:convert-to-foreign-string ,obj)) + +null-c-string-pointer+ + (fli:make-pointer + :address (fli:pointer-address (fli:convert-to-foreign-string ,obj)) + :type :char)) #+allegro `(if (null ,obj) 0 @@ -124,13 +128,22 @@ that CMU automatically converts strings from c-calls." ) -(defmacro allocate-foreign-string (size) +(defmacro allocate-foreign-string (size &key (unsigned nil)) #+cmu (let ((array-def (gensym))) `(let ((,array-def (list 'alien:array 'c-call:char ,size))) - (eval `(alien:cast (alien:make-alien ,,array-def) (* (alien:unsigned 8)))))) + (eval `(alien:cast (alien:make-alien ,,array-def) + ,(if ,unsigned + '(* (alien:unsigned 8)) + '(* (alien:signed 8))))))) #+lispworks - `(fli:allocate-foreign-object :type '(:unsigned :char) :nelems ,size) + `(fli:allocate-foreign-object :type + ,(if unsigned + ''(:unsigned :char) + :char) + :nelems ,size) + #+allegro + (declare (ignore unsigned)) #+allegro `(ff:allocate-fobject :char :c ,size) )