X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fstrings.cl;h=5a4b5671b291f92c271bb7c345a99e9d071ac6b2;hb=e1ba5e8ff148275ed252b179f43a4b045c1dcaf6;hp=0e1e20de513da50e414010a83c03e8768f46dad6;hpb=a6a97b850359b8b6bfce65ee9a8ee78552e4907e;p=uffi.git diff --git a/src/strings.cl b/src/strings.cl index 0e1e20d..5a4b567 100644 --- a/src/strings.cl +++ b/src/strings.cl @@ -1,37 +1,31 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; 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.8 2002/03/19 16:42:59 kevin Exp $ ;;;; -;;;; $Id: strings.cl,v 1.3 2002/03/10 05:09:00 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 '(:unsigned :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,22 +43,20 @@ 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-pointer+ - (fli:make-pointer - :address (fli:pointer-address (fli:convert-to-foreign-string ,obj)) - :type :char)) + +null-cstring-pointer+ + (fli:convert-to-foreign-string ,obj)) #+allegro `(if (null ,obj) - 0 - (values (excl:string-to-native ,obj))) + 0 + (values (excl:string-to-native ,obj))) #+cmu (declare (ignore obj)) ) -(defmacro free-c-string (obj) +(defmacro free-cstring (obj) #+lispworks `(unless (fli:null-pointer-p ,obj) (fli:free-foreign-object ,obj)) @@ -95,7 +87,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) ) @@ -103,10 +95,8 @@ that CMU automatically converts strings from c-calls." (defmacro convert-to-foreign-string (obj) #+lispworks `(if (null ,obj) - +null-c-string-pointer+ - (fli:make-pointer - :address (fli:pointer-address (fli:convert-to-foreign-string ,obj)) - :type :char)) + +null-cstring-pointer+ + (fli:convert-to-foreign-string ,obj)) #+allegro `(if (null ,obj) 0 @@ -117,18 +107,19 @@ that CMU automatically converts strings from c-calls." (i (gensym))) `(when (stringp ,obj) (let* ((,size (length ,obj)) - (,storage (alien:make-alien char (1+ ,size)))) - (setq ,storage (alien:cast ,storage (* char))) - (dotimes (,i ,size) - (declare (fixnum ,i) - (optimize (speed 3) (safety 0))) - (setf (alien:deref ,storage ,i) (char-code (char ,obj ,i)))) - (setf (alien:deref ,storage ,size) 0) + (,storage (alien:make-alien (alien:unsigned 8) (1+ ,size)))) + (setq ,storage (alien:cast ,storage (* (alien:unsigned 8)))) + (locally + (declare (optimize (speed 3) (safety 0))) + (dotimes (,i ,size) + (declare (fixnum ,i)) + (setf (alien:deref ,storage ,i) (char-code (char ,obj ,i)))) + (setf (alien:deref ,storage ,size) 0)) ,storage))) ) -(defmacro allocate-foreign-string (size &key (unsigned nil)) +(defmacro allocate-foreign-string (size &key (unsigned t)) #+cmu (let ((array-def (gensym))) `(let ((,array-def (list 'alien:array 'c-call:char ,size))) @@ -148,7 +139,7 @@ that CMU automatically converts strings from c-calls." `(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 @@ -158,7 +149,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)) @@ -166,7 +157,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))