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

Adding struct dereferencing

This commit is contained in:
retropikzel 2025-01-31 15:39:23 +02:00
parent 19c9c3f802
commit 27c2d17fd1
8 changed files with 31 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile
View File

@ -18,7 +18,8 @@ retropikzel/r7rs-pffi/r7rs-pffi-chibi.so: retropikzel/r7rs-pffi/r7rs-pffi-chibi.
${CC} -o retropikzel/r7rs-pffi/r7rs-pffi-chibi.so \
retropikzel/r7rs-pffi/r7rs-pffi-chibi.c \
-fPIC \
-lffi
-lffi \
-shared
test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so
${CHIBI} test.scm

1
README.md
View File

@ -113,6 +113,7 @@ Usage recommended.
| pffi-struct-offset-get | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-get | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-set! | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| pffi-struct-dereference | | | | | | | | | | | | X | | | | |
| pffi-define | X | X | X | | | | X | X | | X | X | X | | | | |
| pffi-define-callback | | X | | | | | X | | | X | X | X | | | | |

10
retropikzel/r7rs-pffi.sld
View File

@ -29,9 +29,9 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-struct-dereference
pffi-define
pffi-define-callback
)
pffi-define-callback)
(include-shared "r7rs-pffi/r7rs-pffi-chibi"))
(chicken5
(import (scheme base)
@ -248,8 +248,7 @@
pffi-struct-get
pffi-struct-set!
pffi-define
pffi-define-callback
))
pffi-define-callback))
(kawa
(import (scheme base)
(scheme write)
@ -276,6 +275,7 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-struct-dereference
pffi-define
pffi-define-callback
))
@ -374,6 +374,7 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-struct-dereference
pffi-define
pffi-define-callback))
(sagittarius
@ -404,6 +405,7 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-struct-dereference
pffi-define
pffi-define-callback))
(skint

6
retropikzel/r7rs-pffi/chibi.scm
View File

@ -215,6 +215,6 @@
(define scheme-name
(make-c-callback return-type argument-types procedure)))))
(define pffi-pointer-dereference
(lambda (pointer)
pointer))
(define pffi-struct-dereference
(lambda (struct)
(pffi-struct-pointer struct)))

11
retropikzel/r7rs-pffi/kawa.scm
View File

@ -50,6 +50,7 @@
((equal? type 'pointer) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8))
((equal? type 'void) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 1))
((equal? type 'callback) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8))
((equal? type 'struct) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8))
(else (error "pffi-type->native-type -- No such pffi type" type)))))
(define pffi-pointer?
@ -191,3 +192,13 @@
(if (equal? type 'char)
(integer->char r)
r))))
(define pffi-struct-dereference
(lambda (struct)
;; WIP
(pffi-struct-pointer struct)
#;(invoke (pffi-struct-pointer struct) 'reinterpret (static-field java.lang.Integer 'MAX_VALUE))
#;(invoke (pffi-struct-pointer struct)
'get
(invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 1)
0)))

7
retropikzel/r7rs-pffi/racket.scm
View File

@ -21,6 +21,7 @@
((equal? type 'pointer) _pointer)
((equal? type 'void) _void)
((equal? type 'callback) _pointer)
((equal? type 'struct) _pointer)
(else (error "pffi-type->native-type -- No such pffi type" type)))))
(define pffi-pointer?
@ -108,6 +109,6 @@
(integer->char r)
r))))
(define pffi-pointer-dereference
(lambda (pointer)
pointer))
(define pffi-struct-dereference
(lambda (struct)
(pffi-struct-pointer struct)))

7
retropikzel/r7rs-pffi/sagittarius.scm
View File

@ -22,6 +22,7 @@
((equal? type 'string) 'string)
((equal? type 'void) 'void)
((equal? type 'callback) 'callback)
((equal? type 'struct) 'void*)
(else (error "pffi-type->native-type -- No such pffi type" type)))))
(define pffi-pointer?
@ -77,9 +78,9 @@
(lambda (pointer)
(address pointer)))
(define pffi-pointer-dereference
(lambda (pointer)
(deref pointer 0)))
(define pffi-struct-dereference
(lambda (struct)
(deref (pffi-struct-pointer struct) 0)))
(define pffi-pointer-null
(lambda ()

2
retropikzel/r7rs-pffi/struct.scm
View File

@ -50,8 +50,6 @@
(define (pffi-struct-make name members . pointer)
(for-each
(lambda (member)
(write member)
(newline)
(when (not (pair? member))
(error "All struct members must be pairs" (list name member)))
(when (not (symbol? (car member)))