r1555: *** empty log message ***

[uffi.git] / src / strings.cl

diff --git a/src/strings.cl b/src/strings.cl
index 6eeea2c60ff7d7bc7778940450c367cc4abd8227..0d1844e301eb05eb4fc4931e3ee0e25d8e032ff8 100644 (file)
--- a/src/strings.cl
+++ b/src/strings.cl
@@ -2,36 +2,30 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:          immediates.cl
-;;;; Purpose:       UFFI source to handle immediate types
+;;;; Name:          strings.cl
+;;;; Purpose:       UFFI source to handle strings, cstring and foreigns
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;; $Id: strings.cl,v 1.5 2002/03/14 21:03:12 kevin Exp $
 ;;;;
-;;;; $Id: strings.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
-;;;; This file is part of the UFFI. 
-;;;;
-;;;; UFFI is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License (version 2) as
-;;;; published by the Free Software Foundation.
-;;;;
-;;;; UFFI is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with UFFI; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
 (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 +43,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 +58,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 +89,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 +97,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 +122,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 +152,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 +160,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))