r1543: *** empty log message ***

[uffi.git] / src / strings.cl

diff --git a/src/strings.cl b/src/strings.cl
index 6eeea2c60ff7d7bc7778940450c367cc4abd8227..0f0c54cfef695065f72a45ee6ffca455a34f8eda 100644 (file)
--- 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.4 2002/03/10 11:13:07 kevin Exp $
 ;;;;
 ;;;; This file is part of the UFFI. 
 ;;;;
@@ -31,7 +31,12 @@
 (in-package :uffi)
 
 
-(defmacro convert-from-c-string (obj)
+(def-constant +null-cstring-pointer+
+    #+cmu nil
+    #+allegro 0
+    #+lispworks (fli:make-pointer :address 0 :type :char))
+
+(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."
   #+cmu obj
@@ -49,11 +54,13 @@ that CMU automatically converts strings from c-calls."
         (values (excl:native-to-string ,stored)))))
   )
 
-(defmacro convert-to-c-string (obj)
+(defmacro convert-to-cstring (obj)
   #+lispworks
   `(if (null ,obj)
-       +null-c-string-ptr+
-     (fli:convert-to-foreign-string ,obj))
+       +null-cstring-pointer+
+     (fli:make-pointer
+      :address (fli:pointer-address (fli:convert-to-foreign-string ,obj))
+      :type :char))
   #+allegro
   `(if (null ,obj)
        0
@@ -62,7 +69,7 @@ that CMU automatically converts strings from c-calls."
   (declare (ignore obj))
   )
 
-(defmacro free-c-string (obj)
+(defmacro free-cstring (obj)
   #+lispworks
   `(unless (fli:null-pointer-p ,obj)
      (fli:free-foreign-object ,obj))
@@ -93,7 +100,7 @@ that CMU automatically converts strings from c-calls."
       :null-terminated-p ,null-terminated-p
       :external-format '(:latin-1 :eol-style :lf)))      
   #+cmu
-  `(cmucl-naturalize-c-string (alien:alien-sap ,obj)
+  `(cmucl-naturalize-cstring (alien:alien-sap ,obj)
                              :length ,length
                              :null-terminated-p ,null-terminated-p)
   )
@@ -101,8 +108,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-cstring-pointer+
+     (fli:make-pointer
+      :address (fli:pointer-address (fli:convert-to-foreign-string ,obj))
+      :type :char))
   #+allegro
   `(if (null ,obj)
        0
@@ -124,18 +133,27 @@ 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)
   )
 
-(defmacro with-c-string ((foreign-string lisp-string) &body body)
+(defmacro with-cstring ((foreign-string lisp-string) &body body)
   #+cmu
   `(let ((,foreign-string ,lisp-string)) ,@body) 
   #+allegro
@@ -145,7 +163,7 @@ that CMU automatically converts strings from c-calls."
         ,@body)))
   #+lispworks
   (let ((result (gensym)))
-    `(let* ((,foreign-string (convert-to-c-string ,lisp-string))
+    `(let* ((,foreign-string (convert-to-cstring ,lisp-string))
            (,result ,@body))
        (fli:free-foreign-object ,foreign-string)
        ,result))
@@ -153,7 +171,7 @@ that CMU automatically converts strings from c-calls."
 
 ;; Modified from CMUCL's source to handle non-null terminated strings
 #+cmu
-(defun cmucl-naturalize-c-string (sap &key 
+(defun cmucl-naturalize-cstring (sap &key 
                                           length
                                           (null-terminated-p t))
   (declare (type system:system-area-pointer sap))