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))))))
;;;----------------------------------------------------------------------------