This commit is contained in:
retropikzel 2024-07-01 20:13:27 +03:00
parent 14bbd63d5f
commit 7c15de41e8
1 changed files with 102 additions and 100 deletions

View File

@ -48,6 +48,7 @@
((equal? type 'pointer) _pointer) ((equal? type 'pointer) _pointer)
((equal? type 'string) _pointer) ((equal? type 'string) _pointer)
((equal? type 'void) _void) ((equal? type 'void) _void)
((equal? type 'callback) _pointer)
(else (error "pffi-type->native-type -- No such pffi type" type))))) (else (error "pffi-type->native-type -- No such pffi type" type)))))
(define pffi-pointer? (define pffi-pointer?
@ -66,10 +67,11 @@
(define-syntax pffi-define-callback (define-syntax pffi-define-callback
(syntax-rules () (syntax-rules ()
((pffi-define-callback scheme-name return-type argument-types procedure) ((pffi-define-callback scheme-name return-type argument-types procedure)
(define scheme-name (define scheme-name (function-ptr procedure
(ffi-callback procedure (_cprocedure
(mlist->list (map pffi-type->native-type argument-types)) (mlist->list (map pffi-type->native-type argument-types))
(pffi-type->native-type return-type)))))) (pffi-type->native-type return-type)))
))))
(define pffi-size-of (define pffi-size-of
(lambda (type) (lambda (type)