I asked this in comp.lang.scheme already:
Is it possible to declare C types that are structs that include arrays (not pointers)? Also, what about bit fields?
The answer I got in comp.lang.scheme is that one needs to use lists of strings (?!) for the former. Perhaps I'm missing something, but this seems to be very kludgy, even if it does work. Structs that have arrays are pretty common in C APIs (Bit fields happen too) What's the best approach here?
Afficher les réponses par date
On 19-May-09, at 10:26 PM, FFT wrote:
I asked this in comp.lang.scheme already:
Is it possible to declare C types that are structs that include arrays (not pointers)? Also, what about bit fields?
The answer I got in comp.lang.scheme is that one needs to use lists of strings (?!) for the former. Perhaps I'm missing something, but this seems to be very kludgy, even if it does work. Structs that have arrays are pretty common in C APIs (Bit fields happen too) What's the best approach here?
I'm not sure this answers your question... but the code below defines a c-define-struct macro which simplifies interfacing to C structs.
Do you have an example of the kind of C struct you want to interface to?
Marc
;; File: "c-define-struct.scm"
;;;----------------------------------------------------------------------------
;; Defines the c-define-struct macro, which extends the Gambit FFI to ;; interface to C structures.
(define-macro (c-define-struct type . fields) (let* ((type-str (symbol->string type)) (sym (lambda strs (string->symbol (apply string-append strs)))) (struct-type-str (string-append "struct " type-str)) (struct-type*-str (string-append struct-type-str "*")) (release-type-str (string-append "release_" type-str)) (type* (sym type-str "*")) (type*/nonnull (sym type-str "*/nonnull")) (type*/release-rc (sym type-str "*/release-rc")) (expansion `(begin
;; Define the release function which is called when the ;; object is no longer accessible from the Scheme world.
(c-declare ,(string-append "static ___SCMOBJ " release-type-str "( void* ptr )\n" "{\n" " ___EXT(___release_rc)( ptr );\n" " return ___FIX(___NO_ERR);\n" "}\n"))
;; Define the C types.
(c-define-type ,type (struct ,type-str)) (c-define-type ,type* (pointer ,type (,type*))) (c-define-type ,type*/nonnull (nonnull-pointer ,type (,type*))) (c-define-type ,type*/release-rc (nonnull-pointer ,type (,type*) ,release-type-str))
;; Define type allocator procedure.
(define ,(sym "alloc-" type-str) (c-lambda () ,type*/release-rc ,(string-append "___result_voidstar = ___EXT(___alloc_rc)( sizeof( " struct-type-str " ) );")))
;; Define field getters.
,@(map (lambda (field-spec) (let* ((field (car field-spec)) (field-str (symbol->string field)) (field-type (cadr field-spec))) `(define ,(sym type-str "-" field-str) (c-lambda (,type*/nonnull) ,field-type ,(string-append "___result = ___arg1->" field-str ";"))))) fields)
;; Define field setters.
,@(map (lambda (field-spec) (let* ((field (car field-spec)) (field-str (symbol->string field)) (field-type (cadr field-spec))) `(define ,(sym type-str "-" field-str "-set!") (c-lambda (,type*/nonnull ,field-type) void ,(string-append "___arg1->" field-str " = ___arg2;"))))) fields))))
(if #t ;; change to #f if not debugging (pp `(definition: (c-define-struct ,type ,@fields) expansion: ,expansion)))
expansion))
;;;----------------------------------------------------------------------------
;; A simple test of the c-define-struct macro.
;; The following C struct declaration would normally come from a .h file.
(c-declare "struct pt { int x; int y; };")
;; Now use the c-define-struct macro to generate a Scheme interface.
(c-define-struct pt (x int) (y int) )
;; The previous call to c-define-struct expands to the following ;; definitions.
;; (begin ;; ;; (c-declare ;; "static ___SCMOBJ release_pt( void* ptr ) ;; { ;; ___EXT(___release_rc)( ptr ); ;; return ___FIX(___NO_ERR); ;; }") ;; ;; (c-define-type pt (struct "pt")) ;; (c-define-type pt* (pointer pt (pt*))) ;; (c-define-type pt*/nonnull (nonnull-pointer pt (pt*))) ;; (c-define-type pt*/release-rc (nonnull-pointer pt (pt*) "release_pt")) ;; ;; (define alloc-pt ;; (c-lambda ;; () ;; pt*/release-rc ;; "___result_voidstar = ___EXT(___alloc_rc)( sizeof( struct pt ) );")) ;; ;; (define pt-x (c-lambda (pt*/nonnull) int "___result = ___arg1-
x;"))
;; (define pt-y (c-lambda (pt*/nonnull) int "___result = ___arg1-
y;"))
;; ;; (define pt-x-set! (c-lambda (pt*/nonnull int) void "___arg1->x = ___arg2;")) ;; (define pt-y-set! (c-lambda (pt*/nonnull int) void "___arg1->y = ___arg2;")))
;; Now let's define a user-friendly constructor procedure.
(define (make-pt x y) (let ((obj (alloc-pt))) (pt-x-set! obj x) (pt-y-set! obj y) obj))
(define p (make-pt 111 222))
(pp (list (pt-x p) (pt-y p)))
;; Demonstrate that the objects are automatically reclaimed by the ;; garbage collector (try running "top" in a different xterm and the ;; memory usage will stay constant).
(time (let loop ((n 10000000)) (if (> n 0) (begin (make-pt n n) (loop (- n 1))))))
;;;----------------------------------------------------------------------------
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; };
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))
;;;----------------------------------------------------------------------------
On Thu, May 21, 2009 at 6:57 AM, Marc Feeley feeley@iro.umontreal.ca wrote:
Thanks! Do you plan to add the macro to the main distribution? (It's not actually legal for me or others to use it without a license, as I understand)
On 22-May-09, at 4:38 AM, FFT wrote:
On Thu, May 21, 2009 at 6:57 AM, Marc Feeley feeley@iro.umontreal.ca wrote:
Thanks! Do you plan to add the macro to the main distribution? (It's not actually legal for me or others to use it without a license, as I understand)
I won't add it "as is" right now because there are a few issues I would like to solve (like the GC issue with structures).
The c-define-struct.scm file is under the same licensing scheme as the rest of Gambit (choose between one of the two licenses).
Marc