From 3fcc91e7c0032ff376fe97633fa82eb547946381 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Tue, 11 Mar 2025 14:46:11 +0200 Subject: [PATCH] Add pointer-address to Gauche --- README.md | 4 ++-- retropikzel/pffi.sld | 1 + retropikzel/pffi/gauche.scm | 5 +++++ src/gauche/gauchelib.scm | 1 + test.scm | 5 +++-- 5 files changed, 12 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 4795e29..22ab2af 100644 --- a/README.md +++ b/README.md @@ -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 | | | diff --git a/retropikzel/pffi.sld b/retropikzel/pffi.sld index 232629f..d64a8f6 100644 --- a/retropikzel/pffi.sld +++ b/retropikzel/pffi.sld @@ -180,6 +180,7 @@ pffi-pointer-null pffi-pointer-null? pffi-pointer-allocate + pffi-pointer-address pffi-pointer? pffi-pointer-free pffi-pointer-set! diff --git a/retropikzel/pffi/gauche.scm b/retropikzel/pffi/gauche.scm index 9193291..9365f7f 100644 --- a/retropikzel/pffi/gauche.scm +++ b/retropikzel/pffi/gauche.scm @@ -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))) diff --git a/src/gauche/gauchelib.scm b/src/gauche/gauchelib.scm index a3834d3..a31bbe9 100644 --- a/src/gauche/gauchelib.scm +++ b/src/gauche/gauchelib.scm @@ -27,6 +27,7 @@ (define-cproc pointer-null () pointer_null) (define-cproc pointer-null? (pointer) is_pointer_null) (define-cproc pointer-allocate (size::) pointer_allocate) + (define-cproc pointer-address (object) pointer_address) (define-cproc pointer? (pointer) is_pointer) (define-cproc pointer-free (pointer) pointer_free) diff --git a/test.scm b/test.scm index 9e1967d..8bb660b 100755 --- a/test.scm +++ b/test.scm @@ -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?