[gambit-list] FFI
Marc Feeley
feeley at iro.umontreal.ca
Thu May 21 09:57:43 EDT 2009
On 21-May-09, at 2:33 AM, FFT wrote:
> On Wed, May 20, 2009 at 8:31 PM, Marc Feeley
> <feeley at iro.umontreal.ca> wrote:
>
>> Do you have an example of the kind of C struct you want to
>> interface to?
>
> struct s1 {
> float x, y, z;
> };
>
> struct s2 {
> struct s1 coordinates[4];
> char name[5];
> int tag : 3;
> unsigned flag : 1;
> unsigned direction : 2;
> };
I have improved c-define-struct.scm to support arrays embedded in
structs. Check the attached file. Below is an example based on your
structures.
Marc
;;;----------------------------------------------------------------------------
;; A test of the c-define-struct macro.
(include "c-define-struct.scm")
;; The following C struct declaration would normally come from a .h
file.
(c-declare "
struct s1 {
float x, y, z;
};
struct s2 {
struct s1 coordinates[4];
char name[5];
int tag : 3;
unsigned flag : 1;
unsigned direction : 2;
};
")
;; Now use the c-define-struct macro to generate a Scheme interface.
(c-define-struct s1
(x float)
(y float)
(z float)
)
(c-define-struct s2
(coordinates (array s1))
(name (array char))
(tag int)
(flag unsigned-int)
(direction unsigned-int)
)
;; The previous calls to c-define-struct expand to the following
;; definitions.
;; (begin
;;
;; (c-declare
;; "static ___SCMOBJ release_s1( void* ptr )
;; {
;; ___EXT(___release_rc)( ptr );
;; return ___FIX(___NO_ERR);
;; }")
;;
;; (c-define-type s1 (struct "s1"))
;; (c-define-type s1* (pointer s1 (s1*)))
;; (c-define-type s1*/nonnull (nonnull-pointer s1 (s1*)))
;; (c-define-type s1*/release-rc (nonnull-pointer s1 (s1*)
"release_s1"))
;;
;; (define alloc-s1
;; (c-lambda
;; ()
;; s1*/release-rc
;; "___result_voidstar = ___EXT(___alloc_rc)( sizeof( struct
s1 ) );"))
;;
;; (define s1-x (c-lambda (s1*/nonnull) float "___result = ___arg1-
>x;"))
;; (define s1-x-set!
;; (c-lambda (s1*/nonnull float) void "___arg1->x = ___arg2;"))
;; (define s1-y (c-lambda (s1*/nonnull) float "___result = ___arg1-
>y;"))
;; (define s1-y-set!
;; (c-lambda (s1*/nonnull float) void "___arg1->y = ___arg2;"))
;; (define s1-z (c-lambda (s1*/nonnull) float "___result = ___arg1-
>z;"))
;; (define s1-z-set!
;; (c-lambda (s1*/nonnull float) void "___arg1->z = ___arg2;")))
;;
;; (begin
;;
;; (c-declare
;; "static ___SCMOBJ release_s2( void* ptr )
;; {
;; ___EXT(___release_rc)( ptr );
;; return ___FIX(___NO_ERR);
;; }")
;;
;; (c-define-type s2 (struct "s2"))
;; (c-define-type s2* (pointer s2 (s2*)))
;; (c-define-type s2*/nonnull (nonnull-pointer s2 (s2*)))
;; (c-define-type s2*/release-rc (nonnull-pointer s2 (s2*)
"release_s2"))
;;
;; (define alloc-s2
;; (c-lambda
;; ()
;; s2*/release-rc
;; "___result_voidstar = ___EXT(___alloc_rc)( sizeof( struct
s2 ) );"))
;;
;; (define s2-coordinates-ref
;; (c-lambda
;; (s2*/nonnull int)
;; s1*/nonnull
;; "___result_voidstar = &___arg1->coordinates[___arg2];"))
;; (define s2-name-ref
;; (c-lambda (s2*/nonnull int) char "___result = ___arg1-
>name[___arg2];"))
;; (define s2-name-set!
;; (c-lambda
;; (s2*/nonnull int char)
;; void
;; "___arg1->name[___arg2] = ___arg3;"))
;; (define s2-tag (c-lambda (s2*/nonnull) int "___result = ___arg1-
>tag;"))
;; (define s2-tag-set!
;; (c-lambda (s2*/nonnull int) void "___arg1->tag = ___arg2;"))
;; (define s2-flag
;; (c-lambda (s2*/nonnull) unsigned-int "___result = ___arg1-
>flag;"))
;; (define s2-flag-set!
;; (c-lambda (s2*/nonnull unsigned-int) void "___arg1->flag =
___arg2;"))
;; (define s2-direction
;; (c-lambda (s2*/nonnull) unsigned-int "___result = ___arg1-
>direction;"))
;; (define s2-direction-set!
;; (c-lambda
;; (s2*/nonnull unsigned-int)
;; void
;; "___arg1->direction = ___arg2;")))
;; The procedure (s2-coordinates-ref s2-ptr i) returns a foreign
;; pointer to the s1 structure at index i in the coordinates array,
;; and (s2-name-ref s2-ptr i) returns the character at index i in the
;; name array.
;; IMPORTANT NOTE: the foreign pointer returned by s2-coordinates-ref
;; is a pointer to a C struct within another C struct (the
;; "container"). The foreign pointer is only valid as long as the
;; container is allocated. Be wary that in the case of a C structure
;; allocated from Scheme, such as with a call to alloc-s2, the garbage
;; collector could reclaim the structure as soon as the foreign
;; pointer to it is dropped.
;; Now let's create some structs and access them.
(define (s1-init! coord x y z)
(s1-x-set! coord x)
(s1-y-set! coord y)
(s1-z-set! coord z))
(define (s1-print coord)
(pp (list (s1-x coord)
(s1-y coord)
(s1-z coord))))
(define p (alloc-s2))
(s1-init! (s2-coordinates-ref p 0) 1.0 2.0 3.0)
(s1-init! (s2-coordinates-ref p 1) 1.1 2.1 3.1)
(s1-init! (s2-coordinates-ref p 2) 1.2 2.2 3.2)
(s1-init! (s2-coordinates-ref p 3) 1.3 2.3 3.3)
(s2-name-set! p 0 #\a)
(s2-name-set! p 1 #\b)
(s2-name-set! p 2 #\c)
(s2-name-set! p 3 #\d)
(s2-name-set! p 4 #\e)
(s1-print (s2-coordinates-ref p 0))
(s1-print (s2-coordinates-ref p 1))
(s1-print (s2-coordinates-ref p 2))
(s1-print (s2-coordinates-ref p 3))
(pp (s2-name-ref p 2))
;;;----------------------------------------------------------------------------
-------------- next part --------------
A non-text attachment was scrubbed...
Name: c-define-struct.scm
Type: application/octet-stream
Size: 5012 bytes
Desc: not available
URL: <http://mailman.iro.umontreal.ca/pipermail/gambit-list/attachments/20090521/db57c4dd/attachment-0001.obj>
-------------- next part --------------
More information about the Gambit-list
mailing list