Retropikzel
/
foreign-c
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use shared export definition

This commit is contained in:
retropikzel 2025-04-06 08:21:49 +03:00
parent b8e3c867f4
commit f5ddabf3e8
5 changed files with 23 additions and 414 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -446,7 +446,7 @@ correct.
Converts given list into C array of given type. Converts given list into C array of given type.
**pffi-array->list** type list size **pffi-array->list** type list length
Converts given C array into list of given type and length. Converts given C array into list of given type and length.

429
retropikzel/pffi.sld
View File

@ -9,32 +9,6 @@
(scheme process-context) (scheme process-context)
(chibi ast) (chibi ast)
(chibi)) (chibi))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback
;scheme-procedure-to-pointer
)
(include-shared "pffi/chibi-pffi")) (include-shared "pffi/chibi-pffi"))
(chicken-5 (chicken-5
(import (scheme base) (import (scheme base)
@ -46,31 +20,7 @@
(chicken locative) (chicken locative)
(chicken syntax) (chicken syntax)
(chicken memory) (chicken memory)
(chicken random)) (chicken random)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(chicken6 (chicken6
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -81,30 +31,7 @@
(chicken locative) (chicken locative)
(chicken syntax) (chicken syntax)
(chicken memory) (chicken memory)
(chicken random)) (chicken random)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(cyclone (cyclone
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -112,63 +39,14 @@
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(cyclone foreign) (cyclone foreign)
(scheme cyclone primitives)) (scheme cyclone primitives)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
;pffi-define-callback
))
(gambit (gambit
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme char) (scheme char)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(only (gambit) c-declare c-lambda c-define define-macro)) (only (gambit) c-declare c-lambda c-define define-macro)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
;pffi-define-callback
))
(gauche (gauche
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -176,62 +54,13 @@
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(gauche base) (gauche base)
(retropikzel pffi gauche)) (retropikzel pffi gauche)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
;pffi-define-callback
))
(gerbil (gerbil
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme char) (scheme char)
(scheme file) (scheme file)
(scheme process-context)) (scheme process-context)))
(export pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-define-library
;pffi-pointer-null
;pffi-pointer-null?
;pffi-pointer-allocate
;pffi-pointer?
;pffi-pointer-free
;pffi-pointer-set!
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
;pffi-define
;pffi-define-callback
))
(guile (guile
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -240,62 +69,13 @@
(scheme process-context) (scheme process-context)
(rnrs bytevectors) (rnrs bytevectors)
(system foreign) (system foreign)
(system foreign-library)) (system foreign-library)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(kawa (kawa
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme char) (scheme char)
(scheme file) (scheme file)
(scheme process-context)) (scheme process-context)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback
))
(larceny (larceny
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -306,63 +86,14 @@
(primitives std-ffi) (primitives std-ffi)
(primitives foreign-procedure) (primitives foreign-procedure)
(primitives foreign-file) (primitives foreign-file)
(primitives foreign-stdlib) (primitives foreign-stdlib)))
)
(export pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-define-library
;pffi-pointer-null
;pffi-pointer-null?
;pffi-pointer-allocate
;pffi-pointer?
;pffi-pointer-free
;pffi-pointer-set!
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
;pffi-define
;pffi-define-callback
))
(mosh (mosh
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme char) (scheme char)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(mosh ffi)) (mosh ffi)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(racket (racket
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -373,31 +104,7 @@
(ffi winapi) (ffi winapi)
(compatibility mlist) (compatibility mlist)
(ffi unsafe) (ffi unsafe)
(ffi vector)) (ffi vector)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(sagittarius (sagittarius
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -405,124 +112,26 @@
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(sagittarius ffi) (sagittarius ffi)
(sagittarius)) (sagittarius)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(skint (skint
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme char) (scheme char)
(scheme file) (scheme file)
(scheme process-context)) (scheme process-context)))
(export pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-define-library
;pffi-pointer-null
;pffi-pointer-null?
;pffi-pointer-allocate
;pffi-pointer?
;pffi-pointer-free
;pffi-pointer-set!
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
;pffi-define
;pffi-define-callback
))
(stklos (stklos
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme char) (scheme char)
(scheme file) (scheme file)
(scheme process-context) (scheme process-context)
(stklos)) (stklos)))
(export pffi-init
pffi-size-of
pffi-type?
pffi-align-of
pffi-define-library
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
;pffi-define-callback
))
(tr7 (tr7
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme char) (scheme char)
(scheme file) (scheme file)
(scheme process-context)) (scheme process-context)))
(export pffi-init
;pffi-size-of
pffi-type?
;pffi-align-of
;pffi-define-library
;pffi-shared-object-load
;pffi-pointer-null
;pffi-pointer-null?
;pffi-pointer-allocate
;pffi-pointer?
;pffi-pointer-free
;pffi-pointer-set!
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-make
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
;pffi-define
;pffi-define-callback
))
(ypsilon (ypsilon
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
@ -531,8 +140,9 @@
(scheme process-context) (scheme process-context)
(ypsilon c-ffi) (ypsilon c-ffi)
(ypsilon c-types) (ypsilon c-types)
(only (core) define-macro syntax-case)) (only (core) define-macro syntax-case)))
(export pffi-init (else (error "Unsupported implementation")))
(export pffi-init
pffi-size-of pffi-size-of
pffi-type? pffi-type?
pffi-align-of pffi-align-of
@ -555,8 +165,7 @@
pffi-list->array pffi-list->array
pffi-array->list pffi-array->list
pffi-define pffi-define
pffi-define-callback)) pffi-define-callback)
(else (error "Unsupported implementation")))
(cond-expand (cond-expand
(chibi (include "pffi/chibi.scm")) (chibi (include "pffi/chibi.scm"))
(chicken-5 (include "pffi/chicken5.scm")) (chicken-5 (include "pffi/chicken5.scm"))

2
retropikzel/pffi/gambit.scm
View File

@ -58,7 +58,7 @@
(map (map
(lambda (header) (lambda (header)
(string-append "#include <" header ">" (string #\newline))) (string-append "#include <" header ">" (string #\newline)))
header-list))))) (cdr headers))))))
(define pointer? (c-lambda ((pointer void)) bool "___return(1);")) (define pointer? (c-lambda ((pointer void)) bool "___return(1);"))
(define pffi-pointer? (define pffi-pointer?

2
retropikzel/pffi/larceny.scm
View File

@ -24,6 +24,8 @@
((eq? type 'float) 4) ((eq? type 'float) 4)
((eq? type 'double) 8) ((eq? type 'double) 8)
((eq? type 'pointer) 4) ((eq? type 'pointer) 4)
((eq? type 'void) 0)
((eq? type 'callback) 4)
(else (error "Can not get size of unknown type" type))))) (else (error "Can not get size of unknown type" type)))))
(define c-malloc (foreign-procedure "malloc" '(int) 'void*)) (define c-malloc (foreign-procedure "malloc" '(int) 'void*))

2
tests/compliance.scm
View File

@ -902,8 +902,6 @@
(define check-list1 (list 4 5 6)) (define check-list1 (list 4 5 6))
(assert equal? (pffi-array->list 'int test-array1 3) check-list1) (assert equal? (pffi-array->list 'int test-array1 3) check-list1)
;; pffi-struct-dereference ;; pffi-struct-dereference
;(print-header "pffi-struct-dereference 1") ;(print-header "pffi-struct-dereference 1")