Started adding pffi-pointer-address

retropikzel/pffi.sld

@@ -155,7 +155,6 @@
           pffi-struct-offset-get
           pffi-struct-get
           pffi-struct-set!
-          pffi-struct-dereference
           pffi-array-allocate
           pffi-array-pointer
           pffi-array?

retropikzel/pffi/sagittarius.scm

@@ -27,8 +27,7 @@
 
 (define pffi-pointer?
   (lambda (object)
-    (or (pointer? object)
+    (pointer? object)))
-        (string? object))))
 
 (define-syntax pffi-define-function
   (syntax-rules ()
@@ -79,7 +78,7 @@
 
 (define pffi-pointer-address
   (lambda (pointer)
-    (address pointer 0)))
+    (address pointer)))
 
 (define pffi-pointer-null
   (lambda ()

retropikzel/pffi/shared/pointer.scm

@@ -8,6 +8,18 @@
                              "c"
                              '((additional-versions ("0" "6"))))))
 
+(cond-expand
+  (windows (pffi-define-library pffi-libc-stdio
+                                '("stdio.h")
+                                "ucrtbase"
+                                '((additional-versions ("0" "6")))))
+  (else (pffi-define-library pffi-libc-stdio
+                             '("stdio")
+                             "c"
+                             '((additional-versions ("0" "6"))))))
+;(pffi-define-function c-snprintf pffi-libc-stdio 'snprintf 'int '(pointer int pointer pointer))
+;(pffi-define-function c-strtol pffi-libc-stdio 'strtol 'uint64 '(pointer pointer int))
+
 (cond-expand
   (chibi #t) ; FIXME
   (else (pffi-define-function pffi-pointer-allocate pffi-libc-stdlib 'malloc 'pointer '(int))))
@@ -17,3 +29,47 @@
 (cond-expand
   (chibi #t) ; FIXME
   (else (pffi-define-function pffi-pointer-free pffi-libc-stdlib 'free 'void '(pointer))))
+
+#;(define pffi-pointer-null
+  (lambda ()
+    (let ((pointer (pffi-pointer-allocate (pffi-size-of 'pointer))))
+      (pffi-pointer-set! pointer 'int 0 0)
+      pointer)))
+
+#;(define pffi-pointer-null?
+  (lambda (pointer)
+    (let ((address
+            (let ((str (pffi-pointer-allocate 512)))
+              (c-snprintf str 512 (pffi-string->pointer "%p") pointer)
+              (display "Scheme: p1 address: ")
+              (write (pffi-pointer->string str))
+              (newline)
+              (display "Scheme: p1 address int: ")
+              (write (c-strtol str (pffi-pointer-null) 16))
+              (newline)
+              (c-strtol str (pffi-pointer-null) 16))))
+      (= address 0))))
+
+#;(define pffi-pointer-address
+  (lambda (pointer)
+    (let* ((address-number
+             (let ((str (pffi-pointer-allocate 512)))
+               (c-snprintf str 512 (pffi-string->pointer "%p") pointer)
+               (display "Scheme: p1 address: ")
+               (write (pffi-pointer->string str))
+               (newline)
+               (display "Scheme: p1 address int: ")
+               (write (c-strtol str (pffi-pointer-null) 16))
+               (newline)
+               (c-strtol str (pffi-pointer-null) 16)))
+           (address (pffi-pointer-allocate (pffi-size-of 'uint64))))
+               (display "Scheme: p2 address: ")
+               (write address)
+               (newline)
+      ;address-number
+      (pffi-pointer-set! address 'uint64 0 address-number)
+      ;address-number
+      ;(pffi-pointer-get address 'pointer 0)
+      address
+      )
+    ))

retropikzel/pffi/shared/struct.scm

@@ -21,7 +21,7 @@
                 (c-type-string (if (string? c-type) c-type (symbol->string c-type))))
            (struct-make c-type-string size pointer offsets)))))))
 
-(define pffi-struct-dereference
+#;(define pffi-struct-dereference
   (lambda (struct)
     (let ((pointer (pffi-pointer-allocate (pffi-struct-size struct)))
           (offset 0))

tests/compliance.scm

@@ -468,12 +468,30 @@
 
 (print-header 'pffi-pointer-allocate)
 
+(pffi-define-function test-passing-pointer-address
+                      c-testlib
+                      'test_passing_pointer_address
+                      'int
+                      '(pointer pointer))
+(pffi-define-function pa c-testlib 'pa 'pointer '(pointer))
+(pffi-define-function printa c-testlib 'printa 'void '(pointer))
+
 (define test-pointer1 (pffi-pointer-allocate 100))
 (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)
+
+(define input-pointer (pffi-pointer-allocate (pffi-size-of 'int)))
+(pffi-pointer-set! input-pointer 'int 0 100)
+(define input-pointer-address (pffi-pointer-address input-pointer))
+(debug input-pointer-address)
+(test-passing-pointer-address input-pointer input-pointer-address)
+(debug input-pointer)
+(debug input-pointer-address)
+(debug (pffi-pointer-get input-pointer 'int 0))
+;(assert equal? (pffi-pointer? input-pointer-address) #t)
+;(assert equal? (= (pffi-pointer-get input-pointer 'int 0) 42) #t)
 ;(assert equal? (> (pffi-pointer-address test-pointer1) 0) #t)
 
 ;; pffi-pointer?