From d088e362ddd9bdd99c2d1815ab87c5328cdc92a3 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 10 Mar 2002 11:14:39 +0000 Subject: [PATCH] r1529: *** empty log message *** --- ChangeLog | 24 ++++++++++++++---------- Makefile | 6 +++--- doc/ref.sgml | 22 +++++++++++----------- examples/compress.cl | 6 +++--- examples/getenv.cl | 12 ++++++------ examples/gethostname.cl | 4 ++-- examples/getshells.cl | 8 ++++---- examples/strtol.cl | 4 ++-- src/aggregates.cl | 6 +++--- src/immediates.cl | 10 +++++----- src/objects.cl | 6 +----- src/strings.cl | 25 +++++++++++++++---------- test-examples.cl | 22 ++++++++++++++++++++++ tests/compress.cl | 6 +++--- tests/getenv.cl | 12 ++++++------ tests/gethostname.cl | 4 ++-- tests/getshells.cl | 8 ++++---- tests/strtol.cl | 4 ++-- 18 files changed, 108 insertions(+), 81 deletions(-) create mode 100644 test-examples.cl diff --git a/ChangeLog b/ChangeLog index f5fc945..2e92fe1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,19 +1,23 @@ +10 Mar 2002 + * Made Allegro CL array access more efficient + * Renamed c-string to cstring to emphasize it as a basic type + 9 Mar 2002 - - Changed def-routine name to def-function - - Fixed bug in def-function for Lispworks - - Fixed error in +null-c-string-pointer+ name - - Fixed error in (make-null-pointer) for Lispworks - - Reworked Lispwork c-strings to be (* :char) rather than + * Changed def-routine name to def-function + * Fixed bug in def-function for Lispworks + * Fixed error in +null-c-string-pointer+ name + * Fixed error in (make*null*pointer) for Lispworks + * Reworked Lispwork c-strings to be (* :char) rather than the implementation default of (* (:unsigned :char)) to be consistent with CMUCL. Bumped version to 0.2.0 because of change this change. - - Modified getenv.cl example to avoid name collison with LW - - Modified compress.cl to setup output buffer as :unsigned-char - - Added test-all-examples function. All routines tested + * Modified getenv.cl example to avoid name collison with LW + * Modified compress.cl to setup output buffer as :unsigned*char + * Added test*all*examples function. All routines tested okay with ACL, LW, and CMUCL 8 Mar 2002 - - Added ZIP file output with LF->CRLF translations to distribution - - Modified def-enum to use uffi:def-constant rather than + * Added ZIP file output with LF->CRLF translations to distribution + * Modified def*enum to use uffi:def*constant rather than cl:defconstant diff --git a/Makefile b/Makefile index 8f79c96..02bfae9 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ # Programer: Kevin M. Rosenberg, M.D. # Date Started: Mar 2002 # -# CVS Id: $Id: Makefile,v 1.7 2002/03/10 05:13:09 kevin Exp $ +# CVS Id: $Id: Makefile,v 1.8 2002/03/10 11:13:07 kevin Exp $ # # Copyright (c) 2002 by Kevin M. Rosenberg # @@ -41,12 +41,12 @@ realclean: clean docs: @(cd doc; make dist-doc) -VERSION=0.2.0 +VERSION=0.2.1 DISTDIR=uffi-${VERSION} DIST_TARBALL=${DISTDIR}.tar.gz DIST_ZIP=${DISTDIR}.zip SOURCE_FILES=src doc examples Makefile COPYING COPYRIGHT README \ - INSTALL uffi.lsm ChangeLog NEWS + INSTALL uffi.lsm ChangeLog NEWS test-all-examples.cl dist: realclean docs @rm -fr ${DISTDIR} ${DIST_TARBALL} ${DIST_ZIP} diff --git a/doc/ref.sgml b/doc/ref.sgml index 5b783d3..a0d77f1 100644 --- a/doc/ref.sgml +++ b/doc/ref.sgml @@ -165,7 +165,7 @@ - +null-c-string-ptr+ + +null-cstring-ptr+ A constant returning a &null; character pointer; @@ -175,31 +175,31 @@ Strings - convert-from-c-string + convert-from-cstring - Converts a Lisp string to a c-string. + Converts a Lisp string to a cstring. - convert-to-c-string + convert-to-cstring Converts a Lisp string to a - c-string. These - c-string's should be freed with - free-c-string. + cstring. These + cstring's should be freed with + free-cstring. - free-c-string + free-cstring Frees any memory possibly allocated by - convert-to-c-string. + convert-to-cstring. - with-c-string + with-cstring - Binds a lexical variable to a newly allocated c-string. Automatically frees c-string. + Binds a lexical variable to a newly allocated cstring. Automatically frees cstring. diff --git a/examples/compress.cl b/examples/compress.cl index 640ce26..4cb184f 100644 --- a/examples/compress.cl +++ b/examples/compress.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: compress.cl,v 1.4 2002/03/10 05:09:00 kevin Exp $ +;;;; $Id: compress.cl,v 1.5 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -35,7 +35,7 @@ (uffi:def-function ("compress" c-compress) ((dest (* :unsigned-char)) (destlen (* :long)) - (source :c-string) + (source :cstring) (source-len :long)) :returning :int :module "zlib") @@ -48,7 +48,7 @@ (dest (uffi:allocate-foreign-string destsize :unsigned t)) (destlen (uffi:allocate-foreign-object :long))) (setf (uffi:deref-pointer destlen :long) destsize) - (uffi:with-c-string (source-native source) + (uffi:with-cstring (source-native source) (let ((result (c-compress dest destlen source-native sourcelen)) (newdestlen (uffi:deref-pointer destlen :long))) (unwind-protect diff --git a/examples/getenv.cl b/examples/getenv.cl index 2f83426..c6da2a0 100644 --- a/examples/getenv.cl +++ b/examples/getenv.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: getenv.cl,v 1.4 2002/03/10 05:13:09 kevin Exp $ +;;;; $Id: getenv.cl,v 1.5 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -31,15 +31,15 @@ (uffi:def-function ("getenv" c-getenv) - ((name :c-string)) - :returning :c-string) + ((name :cstring)) + :returning :cstring) (defun my-getenv (key) "Returns an environment variable, or NIL if it does not exist" (check-type key string) - (uffi:with-c-string (key-native key) - (let ((value-c-string (c-getenv key-native))) - (uffi:convert-from-c-string value-c-string)))) + (uffi:with-cstring (key-native key) + (let ((value-cstring (c-getenv key-native))) + (uffi:convert-from-cstring value-cstring)))) #+test-uffi (progn diff --git a/examples/gethostname.cl b/examples/gethostname.cl index fbb3539..125b83a 100644 --- a/examples/gethostname.cl +++ b/examples/gethostname.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: gethostname.cl,v 1.3 2002/03/10 04:15:33 kevin Exp $ +;;;; $Id: gethostname.cl,v 1.4 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -33,7 +33,7 @@ ;;; This example is inspired by the example on the CL-Cookbook web site (uffi:def-function ("gethostname" c-gethostname) - ((name :c-string) + ((name :cstring) (len :int)) :returning :int) diff --git a/examples/getshells.cl b/examples/getshells.cl index 50040ec..7bab9ca 100644 --- a/examples/getshells.cl +++ b/examples/getshells.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: getshells.cl,v 1.3 2002/03/10 04:15:33 kevin Exp $ +;;;; $Id: getshells.cl,v 1.4 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -40,14 +40,14 @@ (uffi:def-function "getusershell" nil - :returning :c-string) + :returning :cstring) (defun getshells () "Returns list of valid shells" (setusershell) (let (shells) - (do ((shell (uffi:convert-from-c-string (getusershell)) - (uffi:convert-from-c-string (getusershell)))) + (do ((shell (uffi:convert-from-cstring (getusershell)) + (uffi:convert-from-cstring (getusershell)))) ((null shell)) (push shell shells)) (endusershell) diff --git a/examples/strtol.cl b/examples/strtol.cl index 9813160..518eb29 100644 --- a/examples/strtol.cl +++ b/examples/strtol.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: strtol.cl,v 1.5 2002/03/10 05:09:00 kevin Exp $ +;;;; $Id: strtol.cl,v 1.6 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -31,7 +31,7 @@ (uffi:def-type char-ptr (* :char)) -;; This example does not use :c-string to pass the input string since +;; This example does not use :cstring to pass the input string since ;; the routine needs to do pointer arithmetic to see how many characters ;; were parsed diff --git a/src/aggregates.cl b/src/aggregates.cl index b0438d9..bf163c8 100644 --- a/src/aggregates.cl +++ b/src/aggregates.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: aggregates.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $ +;;;; $Id: aggregates.cl,v 1.2 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of the UFFI. ;;;; @@ -62,7 +62,7 @@ of the enum-name name, separator-string, and field-name" (defmacro def-array (name-array type) #+allegro `(ff:def-foreign-type ,name-array - (:struct (:my-field (:array ,(convert-from-uffi-type type :array))))) + (:array ,(convert-from-uffi-type type :array))) #+lispworks `(fli:define-c-typedef ,name-array (:pointer (:pointer ,(convert-from-uffi-type type :array)))) @@ -120,7 +120,7 @@ of the enum-name name, separator-string, and field-name" #+(or lispworks cmu) (declare (ignore type)) #+cmu `(alien:deref ,obj ,i) #+lispworks `(fli:dereference ,obj :index ,i) - #+allegro `(ff:fslot-value-typed ,type :c ,obj ':my-field ,i) + #+allegro `(ff:fslot-value-typed ,type :c ,obj ,i) ) diff --git a/src/immediates.cl b/src/immediates.cl index 62e216f..ae1013c 100644 --- a/src/immediates.cl +++ b/src/immediates.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: immediates.cl,v 1.2 2002/03/10 05:09:00 kevin Exp $ +;;;; $Id: immediates.cl,v 1.3 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of the UFFI. ;;;; @@ -89,7 +89,7 @@ supports this." '((* . *) (:void . c-call:void) (:short . c-call:short) (:pointer-void . (* t)) - (:c-string . c-call:c-string) + (:cstring . c-call:cstring) (:char . c-call:char) (:unsigned-char . (alien:unsigned 8)) (:int . alien:integer) (:unsigned-int . c-call:unsigned-int) (:long . c-call:long) (:unsigned-long . c-call:unsigned-long) @@ -100,7 +100,7 @@ supports this." '((* . *) (:void . :void) (:short . :short) (:pointer-void . (* :void)) - (:c-string . (* :char)) + (:cstring . (* :char)) (:char . :char) (:unsigned-char . :unsigned-char) (:int . :int) (:unsigned-int . :unsigned-int) (:long . :long) (:unsigned-long . :unsigned-long) @@ -111,7 +111,7 @@ supports this." '((* . :pointer) (:void . :void) (:short . :short) (:pointer-void . (:pointer :void)) - (:c-string . (:pointer :char)) + (:cstring . (:pointer :char)) (:char . :char) (:unsigned-char . (:unsigned :char)) (:int . :int) (:unsigned-int . (:unsigned :int)) (:long . :long) (:unsigned-long . (:unsigned :long)) @@ -134,7 +134,7 @@ supports this." (cond #+allegro ((and (or (eq context :routine) (eq context :return)) - (eq type :c-string)) + (eq type :cstring)) (setq type '((* :char) integer))) #+cmu ((eq context :type) diff --git a/src/objects.cl b/src/objects.cl index 6167636..a4b4a6e 100644 --- a/src/objects.cl +++ b/src/objects.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: objects.cl,v 1.2 2002/03/10 00:11:47 kevin Exp $ +;;;; $Id: objects.cl,v 1.3 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of the UFFI. ;;;; @@ -54,10 +54,6 @@ #+cmu `(alien:null-alien ,obj) ) -(def-constant +null-c-string-pointer+ - #+cmu nil - #+allegro 0 - #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char))) (defmacro make-null-pointer (type) #+(or allegro cmu) (declare (ignore type)) diff --git a/src/strings.cl b/src/strings.cl index 0e1e20d..0f0c54c 100644 --- a/src/strings.cl +++ b/src/strings.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: strings.cl,v 1.3 2002/03/10 05:09:00 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,10 +54,10 @@ 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+ + +null-cstring-pointer+ (fli:make-pointer :address (fli:pointer-address (fli:convert-to-foreign-string ,obj)) :type :char)) @@ -64,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)) @@ -95,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) ) @@ -103,7 +108,7 @@ that CMU automatically converts strings from c-calls." (defmacro convert-to-foreign-string (obj) #+lispworks `(if (null ,obj) - +null-c-string-pointer+ + +null-cstring-pointer+ (fli:make-pointer :address (fli:pointer-address (fli:convert-to-foreign-string ,obj)) :type :char)) @@ -148,7 +153,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 +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)) @@ -166,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)) diff --git a/test-examples.cl b/test-examples.cl new file mode 100644 index 0000000..09a3783 --- /dev/null +++ b/test-examples.cl @@ -0,0 +1,22 @@ +(mk:load-system :uffi) + +(pushnew :test-uffi cl:*features*) + +(flet ((load-test (name) + (load (merge-pathnames + (make-pathname :name name + :type "cl" + :directory '(:relative "examples")) + *load-truename*)))) + + (load-test "strtol") + (load-test "gettime") + (load-test "getenv") + (load-test "gethostname") + (load-test "getshells") + (load-test "compress")) + +(setq cl:*features* (remove :test-uffi cl:*features*)) + + + diff --git a/tests/compress.cl b/tests/compress.cl index 640ce26..4cb184f 100644 --- a/tests/compress.cl +++ b/tests/compress.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: compress.cl,v 1.4 2002/03/10 05:09:00 kevin Exp $ +;;;; $Id: compress.cl,v 1.5 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -35,7 +35,7 @@ (uffi:def-function ("compress" c-compress) ((dest (* :unsigned-char)) (destlen (* :long)) - (source :c-string) + (source :cstring) (source-len :long)) :returning :int :module "zlib") @@ -48,7 +48,7 @@ (dest (uffi:allocate-foreign-string destsize :unsigned t)) (destlen (uffi:allocate-foreign-object :long))) (setf (uffi:deref-pointer destlen :long) destsize) - (uffi:with-c-string (source-native source) + (uffi:with-cstring (source-native source) (let ((result (c-compress dest destlen source-native sourcelen)) (newdestlen (uffi:deref-pointer destlen :long))) (unwind-protect diff --git a/tests/getenv.cl b/tests/getenv.cl index 2f83426..c6da2a0 100644 --- a/tests/getenv.cl +++ b/tests/getenv.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: getenv.cl,v 1.4 2002/03/10 05:13:09 kevin Exp $ +;;;; $Id: getenv.cl,v 1.5 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -31,15 +31,15 @@ (uffi:def-function ("getenv" c-getenv) - ((name :c-string)) - :returning :c-string) + ((name :cstring)) + :returning :cstring) (defun my-getenv (key) "Returns an environment variable, or NIL if it does not exist" (check-type key string) - (uffi:with-c-string (key-native key) - (let ((value-c-string (c-getenv key-native))) - (uffi:convert-from-c-string value-c-string)))) + (uffi:with-cstring (key-native key) + (let ((value-cstring (c-getenv key-native))) + (uffi:convert-from-cstring value-cstring)))) #+test-uffi (progn diff --git a/tests/gethostname.cl b/tests/gethostname.cl index fbb3539..125b83a 100644 --- a/tests/gethostname.cl +++ b/tests/gethostname.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: gethostname.cl,v 1.3 2002/03/10 04:15:33 kevin Exp $ +;;;; $Id: gethostname.cl,v 1.4 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -33,7 +33,7 @@ ;;; This example is inspired by the example on the CL-Cookbook web site (uffi:def-function ("gethostname" c-gethostname) - ((name :c-string) + ((name :cstring) (len :int)) :returning :int) diff --git a/tests/getshells.cl b/tests/getshells.cl index 50040ec..7bab9ca 100644 --- a/tests/getshells.cl +++ b/tests/getshells.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: getshells.cl,v 1.3 2002/03/10 04:15:33 kevin Exp $ +;;;; $Id: getshells.cl,v 1.4 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -40,14 +40,14 @@ (uffi:def-function "getusershell" nil - :returning :c-string) + :returning :cstring) (defun getshells () "Returns list of valid shells" (setusershell) (let (shells) - (do ((shell (uffi:convert-from-c-string (getusershell)) - (uffi:convert-from-c-string (getusershell)))) + (do ((shell (uffi:convert-from-cstring (getusershell)) + (uffi:convert-from-cstring (getusershell)))) ((null shell)) (push shell shells)) (endusershell) diff --git a/tests/strtol.cl b/tests/strtol.cl index 9813160..518eb29 100644 --- a/tests/strtol.cl +++ b/tests/strtol.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: strtol.cl,v 1.5 2002/03/10 05:09:00 kevin Exp $ +;;;; $Id: strtol.cl,v 1.6 2002/03/10 11:13:07 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -31,7 +31,7 @@ (uffi:def-type char-ptr (* :char)) -;; This example does not use :c-string to pass the input string since +;; This example does not use :cstring to pass the input string since ;; the routine needs to do pointer arithmetic to see how many characters ;; were parsed -- 2.34.1