+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
+cl-uffi (1.3.1-1) unstable; urgency=low
+
+ * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org> 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
</refsect1>
</refentry>
+ <refentry id="def-foreign-var">
+ <refnamediv>
+ <refname>def-foreign-var</refname>
+ <refpurpose>
+Defines a symbol macro to access a variable in foreign code
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-foreign-var</function> <replaceable>name type module</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>
+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.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A foreign type of the foreign variable.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>module</returnvalue></term>
+ <listitem>
+ <para>
+ A string specifying the module (or library) the foreign variable
+ resides in. (Required by Lispworks)
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+Defines a symbol macro which can be used to access (get and set) the
+value of a variable in foreign code.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <refsect2>
+ <title>C code</title>
+<programlisting>
+ int baz = 3;
+
+ typedef struct {
+ int x;
+ double y;
+ } foo_struct;
+
+ foo_struct the_struct = { 42, 3.2 };
+
+ int foo () {
+ return baz;
+ }
+</programlisting>
+</refsect2>
+<refsect2>
+<title>Lisp code</title>
+<programlisting>
+ (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
+</programlisting>
+</refsect2>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
</reference>
<reference>
;;;; 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
;;;;
#-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"
;;;; 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
;;;;
(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)
(: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)))
(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
(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)))
;;;; 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 $
;;;;
;;;; *************************************************************************
(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)
* 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
*
*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;
+}
+
+
projects / uffi.git / commitdiff