On 21-May-09, at 2:33 AM, FFT wrote:
On Wed, May 20, 2009 at 8:31 PM, Marc Feeley feeley@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))
;;;----------------------------------------------------------------------------