[gambit-list] FFI
Marc Feeley
feeley at iro.umontreal.ca
Wed May 20 23:31:47 EDT 2009
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 , at 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))))))
;;;----------------------------------------------------------------------------
More information about the Gambit-list
mailing list