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

Add pointer-address to Gauche

This commit is contained in:
retropikzel 2025-03-11 14:46:11 +02:00
parent 7245f59824
commit 3fcc91e7c0
5 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
README.md
View File

@ -89,10 +89,10 @@ changing anymore and some implementations are in **beta**.
| | 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-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-define | pffi-define-callback |
|--------------|-----------|--------------|------------------------------|-------------------------|-------------------|--------------------|-----------------------|----------------------|---------------|-------------------|-------------------|------------------|----------------------|----------------------|------------------|---------------------|------------------------|-----------------|------------------|-------------|----------------------|
| Chibi | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | |
| Chibi | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | |
| Chicken-5 | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Cyclone | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | |
| Gambit | X | X | | | | | | | | | | | | | X | X | X | X | X | | |
| Gambit | X | X | | | | | | X | | | | | | | X | X | X | X | X | | |
| Gauche | X | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | |
| Gerbil | X | | | | | | | | | | | | | | X | X | X | X | X | | |
| Larceny | X | | | | | | | | | | | | | | X | X | X | X | X | | |

1
retropikzel/pffi.sld
View File

@ -180,6 +180,7 @@
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!

5
retropikzel/pffi/gauche.scm
View File

@ -4,6 +4,7 @@
pffi-pointer-null
pffi-pointer-null?
pffi-pointer-allocate
pffi-pointer-address
pffi-pointer?
pffi-pointer-free
pffi-pointer-set!
@ -55,6 +56,10 @@
(lambda (size)
(pointer-allocate size)))
(define pffi-pointer-address
(lambda (object)
(pointer-address object)))
(define pffi-pointer?
(lambda (pointer)
(pointer? pointer)))

1
src/gauche/gauchelib.scm
View File

@ -27,6 +27,7 @@
(define-cproc pointer-null () pointer_null)
(define-cproc pointer-null? (pointer) is_pointer_null)
(define-cproc pointer-allocate (size::<int>) pointer_allocate)
(define-cproc pointer-address (object) pointer_address)
(define-cproc pointer? (pointer) is_pointer)
(define-cproc pointer-free (pointer) pointer_free)

5
test.scm
View File

@ -444,8 +444,9 @@
(debug test-pointer1)
(debug (pffi-pointer? test-pointer1))
(assert equal? (pffi-pointer? test-pointer1) #t)
;(debug (pffi-pointer-address test-pointer1))
;(assert equal? (number? (pffi-pointer-address test-pointer1)) #t)
(debug (pffi-pointer-address test-pointer1))
(assert equal? (number? (pffi-pointer-address test-pointer1)) #t)
(assert equal? (> (pffi-pointer-address test-pointer1) 0) #t)
;; pffi-pointer?