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

Fix pointer memory access on racket

This commit is contained in:
retropikzel 2024-08-21 21:05:08 +03:00
parent d6a86144e8
commit b72c35ae2c
2 changed files with 18 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
README.md
View File

@ -66,6 +66,9 @@ These implementations do not have callback support on their FFI. If I'm wrong pl
## Support maybe possible/dreaming about ## Support maybe possible/dreaming about
- [Airship](https://gitlab.com/mbabich/airship-scheme) - [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
## Not supported ## Not supported

26
retropikzel/r7rs-pffi/version/racket.scm
View File

@ -68,8 +68,7 @@
(define scheme-name (function-ptr procedure (define scheme-name (function-ptr procedure
(_cprocedure (_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)
@ -77,12 +76,11 @@
(define pffi-pointer-allocate (define pffi-pointer-allocate
(lambda (size) (lambda (size)
(malloc size 'raw))) (malloc 'raw size)))
(define pffi-pointer-null (define pffi-pointer-null
(lambda () (lambda ()
#f ; In racket #f is null pointer #f )) ; #f is the null pointer on racket
))
(define pffi-string->pointer (define pffi-string->pointer
(lambda (string-content) (lambda (string-content)
@ -102,18 +100,24 @@
(define pffi-pointer-null? (define pffi-pointer-null?
(lambda (pointer) (lambda (pointer)
(not pointer) ; #f is the null pointer on racket (not pointer))) ; #f is the null pointer on racket
))
(define pffi-pointer-set! (define pffi-pointer-set!
(lambda (pointer type offset value) (lambda (pointer type offset value)
(ptr-set! pointer (pffi-type->native-type type) offset value))) (cond
((equal? type 'string)
(ptr-set! pointer (pffi-type->native-type type) 'abs offset (pffi-string->pointer value)))
;((equal? type 'pointer) (ptr-set! pointer _intptr offset (cast value _pointer _intptr)))
(else
(ptr-set! pointer (pffi-type->native-type type) 'abs offset value)))))
(define pffi-pointer-get (define pffi-pointer-get
(lambda (pointer type offset) (lambda (pointer type offset)
(if (equal? type 'string) (cond
(pffi-pointer->string (ptr-ref pointer (pffi-type->native-type type) offset)) ((equal? type 'string)
(ptr-ref pointer (pffi-type->native-type type) offset)))) (pffi-pointer->string (ptr-ref pointer (pffi-type->native-type type) 'abs offset)))
(else
(ptr-ref pointer (pffi-type->native-type type) 'abs offset)))))
(define pffi-pointer-deref (define pffi-pointer-deref
(lambda (pointer) (lambda (pointer)