Updated the support table. Added cond-expand to export side in .sld file.
This commit is contained in:
parent
72b6251c70
commit
6bb46c09c0
|
|
@ -21,6 +21,7 @@ pffi-define
|
|||
test/pffi-define
|
||||
size-of
|
||||
test/*
|
||||
test
|
||||
!test/*.scm
|
||||
retropikzel/pffi/*/*.c
|
||||
retropikzel/pffi/*/*.o*
|
||||
|
|
|
|||
|
|
@ -0,0 +1,7 @@
|
|||
|
||||
To run tests on different architecture than you are using, install podman and add the docker
|
||||
registry to it's configuration. Add the line
|
||||
|
||||
unqualified-search-registries = ["docker.io"]
|
||||
|
||||
to file: /etc/containers/registries.conf
|
||||
4
Makefile
4
Makefile
|
|
@ -69,7 +69,7 @@ test-kawa-podman-amd64:
|
|||
test-kawa:
|
||||
${KAWA} test.scm
|
||||
|
||||
LARCENY=larceny -r7 -I .
|
||||
LARCENY=larceny -r7 -I .
|
||||
test-larceny-podman-amd64:
|
||||
podman run --arch=amd64 -it -v ${PWD}:/workdir schemers/larceny:latest bash -c "cd /workdir && ${LARCENY} test.scm"
|
||||
|
||||
|
|
@ -115,7 +115,7 @@ test-ypsilon-podman-amd64:
|
|||
podman run --arch=amd64 -it -v ${PWD}:/workdir schemers/ypsilon bash -c "cd /workdir && ${YPSILON} test.scm"
|
||||
|
||||
test-ypsilon:
|
||||
tr7i test.scm
|
||||
${YPSILON} test.scm
|
||||
|
||||
documentation:
|
||||
cat README.md > docs/index.md
|
||||
|
|
|
|||
45
README.md
45
README.md
|
|
@ -38,25 +38,25 @@ guarantees are being made just yet.
|
|||
|
||||
## Implementation table
|
||||
|
||||
| | Chibi | Chicken | Cyclone | Gambit | Gauche | Gerbil | Guile | Kawa | Mosh | Racket | Sagittarius | Skint | STklos | tr7 |
|
||||
| ------------------------------- | ----- | ------- | ------- | ------- | ------ | ------ | ----- | ---- | ---- | ------ | ----------- | ----- | ------ | --- |
|
||||
| pffi-init | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-size-of | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-shared-object-auto-load | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-shared-object-load | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-pointer-null | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-pointer-null? | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-pointer-allocate | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-pointer? | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-pointer-free | X | X | X | | | | X | X | X | X | X | | X | |
|
||||
| pffi-pointer-set! | X | X | X | | | | X | X | X | X | X | | | |
|
||||
| pffi-pointer-get | X | X | X | | | | X | X | X | X | X | | | |
|
||||
| pffi-string->pointer | X | X | X | | | | X | X | X | X | X | | | |
|
||||
| pffi-pointer->string | X | X | X | | | | X | X | X | X | X | | | |
|
||||
| pffi-define | X | X | X | | | | X | X | X | X | X | | | |
|
||||
| pffi-define-callback | | X | | | | | X | | X | X | X | | | |
|
||||
| pffi-pointer-address | | X | | | | | X | | | X | X | | | |
|
||||
| pffi-pointer-dereference | | | | | | | X | | | X | X | | | |
|
||||
| | Chibi | Chicken | Cyclone | Gambit | Gauche | Gerbil | Guile | Kawa | Larceny | Mosh | Racket | Sagittarius | Skint | STklos | tr7 | Ypsilon |
|
||||
| ------------------------------- | ----- | ------- | ------- | ------- | ------ | ------ | ----- | ---- | ------- | ---- | ------ | ----------- | ----- | ------ | --- | ------- |
|
||||
| pffi-init | X | X | X | X | X | X | X | X | X | X | X | X | X | X | | |
|
||||
| pffi-size-of | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-shared-object-auto-load | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-shared-object-load | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-null | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-null? | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-allocate | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer? | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-free | X | X | X | | | | X | X | | X | X | X | | X | | |
|
||||
| pffi-pointer-set! | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-pointer-get | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-string->pointer | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-pointer->string | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-define | X | X | X | | | | X | X | | X | X | X | | | | |
|
||||
| pffi-define-callback | | X | | | | | X | | | X | X | X | | | | |
|
||||
| pffi-pointer-address | | X | | | | | X | | | | X | X | | | | |
|
||||
| pffi-pointer-dereference | | | | | | | X | | | | X | X | | | | |
|
||||
|
||||
### Usage notes
|
||||
|
||||
|
|
@ -74,6 +74,10 @@ guarantees are being made just yet.
|
|||
- --add-exports java.base/jdk.internal.foreign.layout=ALL-UNNAMED
|
||||
- --add-exports java.base/jdk.internal.foreign=ALL-UNNAMED
|
||||
- --enable-native-access=ALL-UNNAMED
|
||||
- Larceny
|
||||
- Runs on 32 bit mode
|
||||
- Mosh
|
||||
- FFI only works on x86_64
|
||||
- Racket
|
||||
- Needs [racket-r7rs](https://github.com/lexi-lambda/racket-r7rs)
|
||||
|
||||
|
|
@ -87,12 +91,11 @@ guarantees are being made just yet.
|
|||
- Javascript side needs design
|
||||
- [MIT-Scheme](https://www.gnu.org/software/mit-scheme/)
|
||||
- [s7](https://scheme.fail://ccrma.stanford.edu/software/snd/snd/s7.html)
|
||||
- [Ypsilon](http://www.littlewingpinball.com/doc/en/ypsilon/)
|
||||
- [Larceny](https://larcenists.org/)
|
||||
- [Airship](https://gitlab.com/mbabich/airship-scheme)
|
||||
- [Other gambit targets](https://gambitscheme.org/)
|
||||
- Gambit compiles to different targets other than C too, for example Javascript. It would be cool
|
||||
and interesting to see if this FFI could also support some of those
|
||||
- When LIPS and Biwascheme Javascript side is done then Gambit should be done too
|
||||
- [s48-r7rs](https://codeberg.org/prescheme/s48-r7rs)
|
||||
- [prescheme](https://codeberg.org/prescheme/prescheme)
|
||||
|
||||
|
|
|
|||
|
|
@ -9,6 +9,24 @@
|
|||
(scheme process-context)
|
||||
(chibi ast)
|
||||
(chibi))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
)
|
||||
(include-shared "r7rs-pffi/r7rs-pffi-chibi"))
|
||||
(chicken
|
||||
(import (scheme base)
|
||||
|
|
@ -20,7 +38,25 @@
|
|||
(chicken locative)
|
||||
(chicken syntax)
|
||||
(chicken memory)
|
||||
(chicken random)))
|
||||
(chicken random))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
pffi-define-callback
|
||||
pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(cyclone
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
|
|
@ -28,26 +64,98 @@
|
|||
(scheme file)
|
||||
(scheme process-context)
|
||||
(cyclone foreign)
|
||||
(scheme cyclone primitives)))
|
||||
(scheme cyclone primitives))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(gambit
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)
|
||||
(only (gambit) c-declare c-lambda c-define)))
|
||||
(only (gambit) c-declare c-lambda c-define))
|
||||
(export pffi-init
|
||||
;pffi-size-of
|
||||
;pffi-shared-object-auto-load
|
||||
;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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(gauche
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)))
|
||||
(scheme process-context))
|
||||
(export pffi-init
|
||||
;pffi-size-of
|
||||
;pffi-shared-object-auto-load
|
||||
;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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(gerbil
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)))
|
||||
(scheme process-context))
|
||||
(export pffi-init
|
||||
;pffi-size-of
|
||||
;pffi-shared-object-auto-load
|
||||
;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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(guile
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
|
|
@ -56,26 +164,104 @@
|
|||
(scheme process-context)
|
||||
(rnrs bytevectors)
|
||||
(system foreign)
|
||||
(system foreign-library)))
|
||||
(system foreign-library))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
pffi-define-callback
|
||||
pffi-pointer-address
|
||||
pffi-pointer-dereference))
|
||||
(kawa
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)))
|
||||
(scheme process-context))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(larceny
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)))
|
||||
(scheme process-context)
|
||||
(rename (primitives r5rs:require) (r5rs:require require))
|
||||
(primitives std-ffi)
|
||||
(primitives foreign-procedure)
|
||||
(primitives foreign-file)
|
||||
(primitives foreign-stdlib)
|
||||
)
|
||||
(export pffi-init
|
||||
;pffi-size-of
|
||||
;pffi-shared-object-auto-load
|
||||
;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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
)
|
||||
)
|
||||
(mosh
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)
|
||||
(mosh ffi)))
|
||||
(mosh ffi))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(racket
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
|
|
@ -86,7 +272,24 @@
|
|||
(ffi winapi)
|
||||
(compatibility mlist)
|
||||
(ffi unsafe)
|
||||
(ffi vector)))
|
||||
(ffi vector))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
pffi-define-callback
|
||||
pffi-pointer-address
|
||||
pffi-pointer-dereference))
|
||||
(sagittarius
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
|
|
@ -94,51 +297,122 @@
|
|||
(scheme file)
|
||||
(scheme process-context)
|
||||
(sagittarius ffi)
|
||||
(sagittarius)))
|
||||
(sagittarius))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
pffi-define-callback
|
||||
pffi-pointer-address
|
||||
pffi-pointer-dereference))
|
||||
(skint
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)))
|
||||
(scheme process-context))
|
||||
(export pffi-init
|
||||
;pffi-size-of
|
||||
;pffi-shared-object-auto-load
|
||||
;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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(stklos
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)
|
||||
(stklos)))
|
||||
(stklos))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(tr7
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)))
|
||||
(scheme process-context))
|
||||
(export pffi-init
|
||||
;pffi-size-of
|
||||
;pffi-shared-object-auto-load
|
||||
;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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(ypsilon
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)))
|
||||
(scheme process-context))
|
||||
(export ;pffi-init
|
||||
;pffi-size-of
|
||||
;pffi-shared-object-auto-load
|
||||
;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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
;pffi-pointer-dereference
|
||||
))
|
||||
(else (error "Unsupported implementation")))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-shared-object-auto-load
|
||||
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-define
|
||||
;pffi-define-callback
|
||||
;pffi-pointer-address
|
||||
pffi-pointer-dereference
|
||||
)
|
||||
(cond-expand
|
||||
(chibi (include "r7rs-pffi/chibi.scm"))
|
||||
(chicken (include "r7rs-pffi/chicken.scm"))
|
||||
|
|
@ -154,7 +428,7 @@
|
|||
(sagittarius (include "r7rs-pffi/sagittarius.scm"))
|
||||
(skint (include "r7rs-pffi/skint.scm"))
|
||||
(stklos (include "retropikzel/r7rs-pffi/stklos.scm"))
|
||||
(tr7 (include "retropikzel/r7rs-pffi/tr7.scm"))
|
||||
(tr7 (include "r7rs-pffi/tr7.scm"))
|
||||
(ypsilon (include "r7rs-pffi/ypsilon.scm"))
|
||||
(else #t))
|
||||
(cond-expand
|
||||
|
|
|
|||
|
|
@ -234,7 +234,7 @@
|
|||
*p = double_value(value);
|
||||
return_closcall1(data, k, make_boolean(boolean_t));")
|
||||
|
||||
#;(define-c pffi-pointer-pointer-set!
|
||||
(define-c pffi-pointer-pointer-set!
|
||||
"(void *data, int argc, closure _, object k, object pointer, object offset, object value)"
|
||||
"char* p = opaque_ptr(pointer) + obj_obj2int(offset);
|
||||
*p = &opaque_ptr(value);
|
||||
|
|
|
|||
|
|
@ -1 +1,27 @@
|
|||
(require 'std-ffi)
|
||||
|
||||
(define pffi-init (lambda () #t))
|
||||
|
||||
;; FIXME
|
||||
(define pffi-size-of
|
||||
(lambda (type)
|
||||
(cond ((eq? type 'int8) 1)
|
||||
((eq? type 'uint8) 1)
|
||||
((eq? type 'int16) 2)
|
||||
((eq? type 'uint16) 2)
|
||||
((eq? type 'int32) 4)
|
||||
((eq? type 'uint32) 4)
|
||||
((eq? type 'int64) 8)
|
||||
((eq? type 'uint64) 8)
|
||||
((eq? type 'char) 1)
|
||||
((eq? type 'unsigned-char) 1)
|
||||
((eq? type 'short) 2)
|
||||
((eq? type 'unsigned-short) 2)
|
||||
((eq? type 'int) 4)
|
||||
((eq? type 'unsigned-int) 4)
|
||||
((eq? type 'long) 4)
|
||||
((eq? type 'unsigned-long) 4)
|
||||
((eq? type 'float) 4)
|
||||
((eq? type 'double) 8)
|
||||
((eq? type 'pointer) 4)
|
||||
(else (error "Can not get size of unknown type" type)))))
|
||||
|
|
|
|||
57
test.scm
57
test.scm
|
|
@ -53,6 +53,7 @@
|
|||
|
||||
(pffi-init)
|
||||
|
||||
#|
|
||||
;; pffi-size-of
|
||||
|
||||
(print-header 'pffi-size-of)
|
||||
|
|
@ -139,34 +140,57 @@
|
|||
(assert equal? (number? size-unsigned-int) #t)
|
||||
(assert = size-unsigned-int 4)
|
||||
|
||||
(assert equal? (number? (pffi-size-of 'unsigned-int)) #t)
|
||||
(define size-long (pffi-size-of 'long))
|
||||
(debug size-long)
|
||||
(assert equal? (number? size-long) #t)
|
||||
(assert = size-long 8)
|
||||
(cond-expand
|
||||
(larceny ;; Works on 32 bit mode
|
||||
(assert equal? (number? (pffi-size-of 'long)) #t)
|
||||
(define size-long (pffi-size-of 'long))
|
||||
(debug size-long)
|
||||
(assert equal? (number? size-long) #t)
|
||||
(assert = size-long 4))
|
||||
(else
|
||||
(assert equal? (number? (pffi-size-of 'long)) #t)
|
||||
(define size-long (pffi-size-of 'long))
|
||||
(debug size-long)
|
||||
(assert equal? (number? size-long) #t)
|
||||
(assert = size-long 8)))
|
||||
|
||||
(assert equal? (number? (pffi-size-of 'long)) #t)
|
||||
(define size-unsigned-long (pffi-size-of 'unsigned-long))
|
||||
(debug size-unsigned-long)
|
||||
(assert equal? (number? size-unsigned-long) #t)
|
||||
(assert = size-unsigned-long 8)
|
||||
(cond-expand
|
||||
(larceny ;; Works on 32 bit mode
|
||||
(assert equal? (number? (pffi-size-of 'unsigned-long)) #t)
|
||||
(define size-unsigned-long (pffi-size-of 'unsigned-long))
|
||||
(debug size-unsigned-long)
|
||||
(assert equal? (number? size-unsigned-long) #t)
|
||||
(assert = size-unsigned-long 4))
|
||||
(else
|
||||
(assert equal? (number? (pffi-size-of 'long)) #t)
|
||||
(define size-unsigned-long (pffi-size-of 'unsigned-long))
|
||||
(debug size-unsigned-long)
|
||||
(assert equal? (number? size-unsigned-long) #t)
|
||||
(assert = size-unsigned-long 8)))
|
||||
|
||||
(assert equal? (number? (pffi-size-of 'unsigned-long)) #t)
|
||||
(assert equal? (number? (pffi-size-of 'float)) #t)
|
||||
(define size-float (pffi-size-of 'float))
|
||||
(debug size-float)
|
||||
(assert equal? (number? size-float) #t)
|
||||
(assert = size-float 4)
|
||||
|
||||
(assert equal? (number? (pffi-size-of 'float)) #t)
|
||||
(assert equal? (number? (pffi-size-of 'double)) #t)
|
||||
(define size-double (pffi-size-of 'double))
|
||||
(debug size-double)
|
||||
(assert equal? (number? size-double) #t)
|
||||
(assert = size-double 8)
|
||||
|
||||
(define size-pointer (pffi-size-of 'pointer))
|
||||
(debug size-pointer)
|
||||
(assert equal? (number? size-pointer) #t)
|
||||
(assert = size-pointer 8)
|
||||
(cond-expand
|
||||
(larceny ;; Works on 32 bit mode
|
||||
(define size-pointer (pffi-size-of 'pointer))
|
||||
(debug size-pointer)
|
||||
(assert equal? (number? size-pointer) #t)
|
||||
(assert = size-pointer 4))
|
||||
(else
|
||||
(define size-pointer (pffi-size-of 'pointer))
|
||||
(debug size-pointer)
|
||||
(assert equal? (number? size-pointer) #t)
|
||||
(assert = size-pointer 8)))
|
||||
|
||||
;; pffi-shared-object-auto-load
|
||||
|
||||
|
|
@ -179,7 +203,6 @@
|
|||
|
||||
(debug libc-stdlib)
|
||||
|
||||
#|
|
||||
;; pffi-pointer-null
|
||||
|
||||
(print-header 'pffi-pointer-null)
|
||||
|
|
|
|||
Loading…
Reference in New Issue