From: Kevin M. Rosenberg Date: Fri, 15 Aug 2003 02:34:34 +0000 (+0000) Subject: r5500: *** empty log message *** X-Git-Tag: v1.6.1~191 X-Git-Url: http://git.kpe.io/?a=commitdiff_plain;ds=sidebyside;h=a27a393f26a7a423d758e902dbff07c81ccead91;p=uffi.git r5500: *** empty log message *** --- diff --git a/ChangeLog b/ChangeLog index 3c044d0..0b99ac9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2003-08-15 Kevin Rosenberg (kevin@rosenberg.net) + * Added with-cast-pointer and def-foreign-var (patches submitted + by Edi Weitz). + * Added many new tests + 2002-10-16 Kevin Rosenberg (kevin@rosenberg.net) * Added support for SBCL and SCL diff --git a/debian/changelog b/debian/changelog index e32c935..758b0ed 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-uffi (1.3.1-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Thu, 14 Aug 2003 18:27:32 -0600 + cl-uffi (1.3.0-1) unstable; urgency=low * Add initial support and tests for def-foreign-var diff --git a/doc/html.tar.gz b/doc/html.tar.gz index 4ce96df..8d746e5 100644 Binary files a/doc/html.tar.gz and b/doc/html.tar.gz differ diff --git a/doc/ref.sgml b/doc/ref.sgml index 99234c4..dd0e05a 100644 --- a/doc/ref.sgml +++ b/doc/ref.sgml @@ -1591,6 +1591,121 @@ if a cstring returned by a function is &null;. + + + def-foreign-var + +Defines a symbol macro to access a variable in foreign code + + Macro + + + Syntax + + def-foreign-var name type module + + + + Arguments and Values + + + name + + +A string or list specificying the symbol macro's name. If it is a + string, that names the foreign variable. A Lisp name is created + by translating #\_ to #\- and by converting to upper-case in + case-insensitive Lisp implementations. If it is a list, the first + item is a string specifying the foreign variable name and the + second it is a symbol stating the Lisp name. + + + + + type + + A foreign type of the foreign variable. + + + + + module + + + A string specifying the module (or library) the foreign variable + resides in. (Required by Lispworks) + + + + + + + Description + +Defines a symbol macro which can be used to access (get and set) the +value of a variable in foreign code. + + + + Examples + + C code + + int baz = 3; + + typedef struct { + int x; + double y; + } foo_struct; + + foo_struct the_struct = { 42, 3.2 }; + + int foo () { + return baz; + } + + + +Lisp code + + (uffi:def-struct foo-struct + (x :int) + (y :double)) + + (uffi:def-function ("foo" foo) + () + :returning :int + :module "foo") + + (uffi:def-foreign-var ("baz" *baz*) :int "foo") + (uffi:def-foreign-var ("the_struct" *the-struct*) foo-struct "foo") + + +*baz* + => 3 + +(incf *baz*) + => 4 + +(foo) + => 4 + + + + + Side Effects + None. + + + Affected by + None. + + + Exceptional Situations + None. + + + diff --git a/doc/uffi.pdf b/doc/uffi.pdf index 253860e..85b947e 100644 Binary files a/doc/uffi.pdf and b/doc/uffi.pdf differ diff --git a/src/objects.lisp b/src/objects.lisp index 4d86f1a..b567c11 100644 --- a/src/objects.lisp +++ b/src/objects.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: objects.lisp,v 1.18 2003/08/14 21:58:29 kevin Exp $ +;;;; $Id: objects.lisp,v 1.19 2003/08/15 02:34:34 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -232,19 +232,25 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated." #-lispworks (declare (ignore module)) (let ((foreign-name (if (atom names) names (first names))) (lisp-name (if (atom names) (make-lisp-name names) (second names))) - (var-type (convert-from-uffi-type type :foreign-var))) + #-allegro + (var-type (convert-from-uffi-type type :type))) #+(or cmu scl) `(alien:def-alien-variable (,foreign-name ,lisp-name) ,var-type) #+sbcl `(sb-alien:define-alien-variable (,foreign-name ,lisp-name) ,var-type) #+allegro - `(ff:def-foreign-variable (,lisp-name ,foreign-name) :convention :c - :type ,var-type) + `(define-symbol-macro ,lisp-name + (ff:fslot-value-typed (quote ,(convert-from-uffi-type type :deref)) + :c (ff:get-entry-point ,foreign-name))) #+lispworks (let ((temp-name (gensym))) `(progn - (fli:define-foreign-variable (,temp-name ,foreign-name) :type ,var-type :module ,module) - (define-symbol-macro ,lisp-name (,temp-name)))) + (fli:define-foreign-variable (,temp-name ,foreign-name) + :accessor :address-of + :type ,var-type + :module ,module) + (define-symbol-macro ,lisp-name (fli:dereference (,temp-name) + :copy-foreign-object nil)))) #-(or allegro cmu scl sbcl lispworks) `(define-symbol-macro ,lisp-name '(error "DEF-FOREIGN-VAR not (yet) defined for ~A" diff --git a/src/primitives.lisp b/src/primitives.lisp index 1e860fb..73027ef 100644 --- a/src/primitives.lisp +++ b/src/primitives.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: primitives.lisp,v 1.11 2003/08/14 21:58:29 kevin Exp $ +;;;; $Id: primitives.lisp,v 1.12 2003/08/15 02:34:34 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -85,8 +85,6 @@ supports takes advantage of this optimization." (defvar +type-conversion-hash+ (make-hash-table :size 20 :test #'eq)) #+(or cmu sbcl scl) (defvar *cmu-def-type-hash* (make-hash-table :size 20 :test #'eq)) - #+allegro (defvar *allegro-foreign-type-hash* - (make-hash-table :size 20 :test #'eq)) ) #+(or cmu sbcl scl) @@ -223,23 +221,6 @@ supports takes advantage of this optimization." (:float . :single-float) (:double . :double-float) (:array . :array))) -#+allegro -(defvar *allegro-foreign-type-list* - '((:char . :signed-byte) - (:unsigned-char . :unsigned-byte) - (:byte . :signed-byte) - (:unsigned-byte . :unsigned-byte) - (:short . :signed-word) - (:unsigned-short . :unsigned-word) - (:int . :signed-long) - (:unsigned-int . :unsigned-long32) - (:long . :signed-long) - (:unsigned-long . :unsigned-long) - (:float . :single-float) - (:double . :double-float) - ) - "Conversion for Allegro's system:memref function") - (dolist (type *type-conversion-list*) (setf (gethash (car type) +type-conversion-hash+) (cdr type))) @@ -247,14 +228,6 @@ supports takes advantage of this optimization." (dolist (type *cmu-sbcl-def-type-list*) (setf (gethash (car type) *cmu-def-type-hash*) (cdr type))) -#+allegro -(dolist (type *allegro-foreign-type-list*) - (setf (gethash (car type) *allegro-foreign-type-hash*) (cdr type))) - -(defun foreign-var-type-convert (type) - #+allegro (gethash type *allegro-foreign-type-hash*)) - - (defun basic-convert-from-uffi-type (type) (let ((found-type (gethash type +type-conversion-hash+))) (if found-type @@ -282,9 +255,6 @@ supports takes advantage of this optimization." (basic-convert-from-uffi-type :cstring-returning)) #+(and mcl (not openmcl)) ((and (eq type :void) (eq context :return)) nil) - #+allegro - ((eq context :foreign-var) - (foreign-var-type-convert type)) (t (basic-convert-from-uffi-type type))) (let ((sub-type (car type))) diff --git a/tests/foreign-var.lisp b/tests/foreign-var.lisp index e0c3235..52bceb1 100644 --- a/tests/foreign-var.lisp +++ b/tests/foreign-var.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Aug 2003 ;;;; -;;;; $Id: foreign-var.lisp,v 1.2 2003/08/14 21:58:44 kevin Exp $ +;;;; $Id: foreign-var.lisp,v 1.3 2003/08/15 02:34:34 kevin Exp $ ;;;; ;;;; ************************************************************************* @@ -32,3 +32,51 @@ (deftest fvar.8 double-3-1 3.1d0) +(uffi:def-foreign-var ("fvar_addend" *fvar-addend*) :int "uffi_tests") + +(uffi:def-struct fvar-struct + (i :int) + (d :double)) + +(uffi:def-foreign-var ("fvar_struct" *fvar-struct*) fvar-struct + "uffi_tests") + +(uffi:def-function ("fvar_struct_int" fvar-struct-int) + () + :returning :int + :module "uffi_tests") + + (uffi:def-function ("fvar_struct_double" fvar-struct-double) + () + :returning :double + :module "uffi_tests") + +(deftest fvarst.1 *fvar-addend* 3) +(deftest fvarst.2 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 42) +(deftest fvarst.3 (= (+ *fvar-addend* + (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i)) + (fvar-struct-int)) + t) +(deftest fvarst.4 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd) 3.2d0) +(deftest fvarst.5 (= (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd) + (fvar-struct-double)) + t) + +(deftest fvarst.6 + (let ((orig *fvar-addend*)) + (incf *fvar-addend* 3) + (prog1 + *fvar-addend* + (setf *fvar-addend* orig))) + 6) + +(deftest fvarst.7 + (let ((orig *fvar-addend*)) + (incf *fvar-addend* 3) + (prog1 + (fvar-struct-int) + (setf *fvar-addend* orig))) + 48) + +;;(decf (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 10) +;;(deftest fvarst.8 (fvar-struct-int) 38) diff --git a/tests/uffi-c-test-lib.c b/tests/uffi-c-test-lib.c index 99b9004..26884c6 100644 --- a/tests/uffi-c-test-lib.c +++ b/tests/uffi-c-test-lib.c @@ -6,7 +6,7 @@ * Programer: Kevin M. Rosenberg * Date Started: Mar 2002 * - * CVS Id: $Id: uffi-c-test-lib.c,v 1.3 2003/08/14 21:40:13 kevin Exp $ + * CVS Id: $Id: uffi-c-test-lib.c,v 1.4 2003/08/15 02:34:34 kevin Exp $ * * This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg * @@ -118,3 +118,24 @@ cast_test_float () *y = 3.21; return y; } + +DLLEXPORT int fvar_addend = 3; + +typedef struct { + int i; + double d; +} fvar_struct_type; + +fvar_struct_type fvar_struct = {42, 3.2}; + +DLLEXPORT +int fvar_struct_int () { + return (fvar_addend + fvar_struct.i); +} + +DLLEXPORT +double fvar_struct_double () { + return fvar_struct.d; +} + +