Switch to shared allocate and free functions

retropikzel/pffi.sld

@@ -31,7 +31,7 @@
               pffi-struct-set!
               pffi-define
               pffi-define-callback
-              scheme-procedure-to-pointer
+              ;scheme-procedure-to-pointer
               )
       (include-shared "pffi/chibi-pffi"))
     (chicken-5
@@ -66,8 +66,7 @@
               pffi-struct-get
               pffi-struct-set!
               pffi-define
-              ;pffi-define-callback
+              pffi-define-callback))
-              ))
     (chicken6
       (import (scheme base)
               (scheme write)
@@ -404,8 +403,7 @@
               pffi-struct-get
               pffi-struct-set!
               pffi-define
-              ;pffi-define-callback
+              pffi-define-callback))
-              ))
     (skint
       (import (scheme base)
               (scheme write)
@@ -544,5 +542,7 @@
     (tr7 (include "pffi/tr7.scm"))
     (ypsilon (include "pffi/ypsilon.scm")))
   ;(include "pffi/shared/union.scm")
+  (include "pffi/shared/main.scm")
+  (include "pffi/shared/pointer.scm")
   (include "pffi/shared/struct.scm")
-  (include "pffi/shared/main.scm"))
+  )

retropikzel/pffi/chibi.scm

@@ -46,7 +46,7 @@
     (or (equal? object #f) ; False can be null pointer
     (pointer? object))))
 
-(define pffi-pointer-allocate
+#;(define pffi-pointer-allocate
   (lambda (size)
     (pointer-allocate size)))
 
@@ -54,7 +54,7 @@
   (lambda (pointer)
     (pointer-address pointer)))
 
-(define pffi-pointer-free
+#;(define pffi-pointer-free
   (lambda (pointer)
     (pointer-free pointer)))
 

retropikzel/pffi/chibi/pffi.stub

@@ -272,8 +272,9 @@
 (c-declare
   "void* scheme_procedure_to_pointer(sexp proc) {
     if(sexp_procedurep(proc) == 1) {
-      sexp debug1 = sexp_procedure_code(proc);
+      return 0;  //&sexp_unbox_fixnum(proc);
-      printf(\"HERE: %u\\n\", sexp_bytecode_length(debug1));
+    } else {
+      printf(\"NOT A FUNCTION\\n\");
     }
     return (void*)proc;
   }")

retropikzel/pffi/chicken5.scm

@@ -67,14 +67,10 @@
           `(define ,scheme-name
              (foreign-safe-lambda ,return-type ,c-name ,@ argument-types)))))))
 
-#;(define-syntax pffi-define-callback
+(define-syntax pffi-define-callback
   (er-macro-transformer
     (lambda (expr rename compare)
-      (let* ((debug (begin
+      (let* ((pffi-type->native-type ; Chicken has this procedure in three places
-                      (write (list-ref expr 4))
-                      (newline)
-                      ))
-             (pffi-type->native-type ; Chicken has this procedure in three places
                (lambda (type)
                  (cond ((equal? type 'int8) 'byte)
                        ((equal? type 'uint8) 'unsigned-byte)
@@ -107,7 +103,7 @@
                           (lambda (name type)
                             `(,name ,type))
                           argument-types argument-names))
-             (procedure-body (cadr (cdr (list-ref expr 4)))))
+             (procedure-body (cdr (cdr (list-ref expr 4)))))
         `(begin (define-external ,(cons 'external_123456789 arguments)
                                  ,return-type
                                  (begin ,@ procedure-body))
@@ -137,7 +133,7 @@
           ((equal? type 'string) (foreign-value "sizeof(void*)" int))
           ((equal? type 'callback) (foreign-value "sizeof(void*)" int)))))
 
-(define pffi-pointer-allocate
+#;(define pffi-pointer-allocate
   (lambda (size)
     (allocate size)))
 
@@ -186,7 +182,7 @@
                   `(foreign-declare ,(string-append "#include <" header ">")))
                 headers))))))
 
-(define pffi-pointer-free
+#;(define pffi-pointer-free
   (lambda (pointer)
     (if (not (pointer? pointer))
       (error "pffi-pointer-free -- Argument is not pointer" pointer))

retropikzel/pffi/cyclone.scm

@@ -93,7 +93,7 @@
           ((equal? type 'double) (c-value "sizeof(double)" int))
           ((equal? type 'pointer) (c-value "sizeof(void*)" int)))))
 
-(define-c pffi-pointer-allocate
+#;(define-c pffi-pointer-allocate
           "(void *data, int argc, closure _, object k, object size)"
           "make_c_opaque(opq, malloc(obj_obj2int(size)));
           return_closcall1(data, k, &opq);")
@@ -121,7 +121,7 @@
                 `(include-c-header ,(string-append "<" header ">")))
               (cdr (car (cdr expr))))))))
 
-(define-c pffi-pointer-free
+#;(define-c pffi-pointer-free
           "(void *data, int argc, closure _, object k, object pointer)"
           "free(opaque_ptr(pointer));
           return_closcall1(data, k, make_boolean(boolean_t));")

retropikzel/pffi/gambit.scm

@@ -58,7 +58,7 @@
                              (map
                                (lambda (header)
                                  (string-append "#include <" header ">" (string #\newline)))
-                               (cdr headers))))))
+                               header-list)))))
 
 (define pointer? (c-lambda ((pointer void)) bool  "___return(1);"))
 (define pffi-pointer?
@@ -77,11 +77,11 @@
     (and (pffi-pointer? pointer)
          (pointer-null? pointer))))
 
-(define pffi-pointer-allocate (c-lambda (int) (pointer void) "void* p = malloc(___arg1); ___return(p);"))
+;(define pffi-pointer-allocate (c-lambda (int) (pointer void) "void* p = malloc(___arg1); ___return(p);"))
 
 (define pffi-pointer-address (c-lambda ((pointer void)) ptrdiff_t "void* p = ___arg1; ___return((intptr_t)&p);"))
 
-(define pffi-pointer-free (c-lambda ((pointer void)) void "free(___arg1);"))
+;(define pffi-pointer-free (c-lambda ((pointer void)) void "free(___arg1);"))
 
 (define pointer-set-c-int8_t! (c-lambda ((pointer void) int int8) void "*(int8_t*)((char*)___arg1 + ___arg2) = ___arg3;"))
 (define pointer-set-c-uint8_t! (c-lambda ((pointer void) int unsigned-int8) void "*(uint8_t*)((char*)___arg1 + ___arg2) = ___arg3;"))

retropikzel/pffi/gauche.scm

@@ -113,14 +113,6 @@
           ((equal? type 'void) (pointer-get-pointer pointer offset))
           ((equal? type 'pointer) (pointer-get-pointer pointer offset)))))
 
-#;(define pffi-string->pointer
-  (lambda (string-content)
-    (string->pointer string-content)))
-
-#;(define pffi-pointer->string
-  (lambda (pointer)
-    (pointer->string pointer)))
-
 (define pffi-type->libffi-type
   (lambda (type)
     (cond ((equal? type 'int8) (get-ffi-type-int8))
@@ -185,3 +177,12 @@
                         return-type
                         argument-types)))))
 
+(define make-c-callback
+  (lambda (return-type argument-types procedure)
+    (scheme-procedure-to-pointer procedure)))
+
+(define-syntax pffi-define-callback
+  (syntax-rules ()
+    ((pffi-define scheme-name return-type argument-types procedure)
+     (define scheme-name
+       (make-c-callback return-type 'argument-types procedure)))))

retropikzel/pffi/gauche/gauchelib.scm

@@ -96,4 +96,5 @@
  (define-cproc get-ffi-type-float () get_ffi_type_float)
  (define-cproc get-ffi-type-double () get_ffi_type_double)
  (define-cproc get-ffi-type-pointer () get_ffi_type_pointer)
- )
+
+ (define-cproc procedure-to-pointer (procedure) procedure_to_pointer))

retropikzel/pffi/kawa.scm

@@ -131,7 +131,7 @@
         (invoke native-type 'byteAlignment)
         #f))))
 
-(define pffi-pointer-allocate
+#;(define pffi-pointer-allocate
   (lambda (size)
     (invoke (invoke arena 'allocate size 1) 'reinterpret size)))
 
@@ -154,7 +154,7 @@
     (invoke (invoke pointer 'reinterpret (static-field java.lang.Integer 'MAX_VALUE)) 'getString 0)))
 
 (define pffi-shared-object-load
-  (lambda (header path . options)
+  (lambda (path options)
     (let* ((library-file (make java.io.File path))
            (file-name (invoke library-file 'getName))
            (library-parent-folder (make java.io.File (invoke library-file 'getParent)))
@@ -169,7 +169,7 @@
       (list (cons 'linker linker)
             (cons 'lookup lookup)))))
 
-(define pffi-pointer-free
+#;(define pffi-pointer-free
   (lambda (pointer)
     #t))
 

retropikzel/pffi/larceny-util.scm

@@ -0,0 +1,88 @@
+;; Copied from Larceny source
+;; Copyright 1998 Lars T Hansen.
+;; Copied code begins
+
+(define %set32u)
+
+; %peek* and %poke*: convenient access to values in memory.
+
+(define (%peek8 addr)
+  (let ((x (make-bytevector 1)))
+    (peek-bytes addr x 1)
+    (let ((v (bytevector-ref x 0)))
+      (if (> v 127)
+        (- (- 256 v))
+        v))))
+
+(define (%peek16 addr)
+  (let ((x (make-bytevector 2)))
+    (peek-bytes addr x 2)
+    (%get16 x 0)))
+
+(define (%peek32 addr)
+  (let ((x (make-bytevector 4)))
+    (peek-bytes addr x 4)
+    (%get32 x 0)))
+
+(define (%peek8u addr)
+  (let ((x (make-bytevector 1)))
+    (peek-bytes addr x 1)
+    (bytevector-ref x 0)))
+
+(define (%peek16u addr)
+  (let ((x (make-bytevector 2)))
+    (peek-bytes addr x 2)
+    (%get16u x 0)))
+
+(define (%peek32u addr)
+  (let ((x (make-bytevector 4)))
+    (peek-bytes addr x 4)
+    (%get32u x 0)))
+
+(define (%poke8 addr val)
+  (let ((x (make-bytevector 1)))
+    (if (< val 0)
+      (bytevector-set! x 0 (+ 256 val))
+      (bytevector-set! x 0 val))
+    (poke-bytes addr x 1)))
+
+(define (%poke16 addr val)
+  (let ((x (make-bytevector 2)))
+    (%set16 x 0 val)
+    (poke-bytes addr x 2)))
+
+(define (%poke32 addr val)
+  (let ((x (make-bytevector 4)))
+    (%set32 x 0 val)
+    (poke-bytes addr x 4)))
+
+(define (%poke8u addr val)
+  (let ((x (make-bytevector 1)))
+    (bytevector-set! x 0 val)
+    (poke-bytes addr x 1)))
+
+(define (%poke16u addr val)
+  (let ((x (make-bytevector 2)))
+    (%set16u x 0 val)
+    (poke-bytes addr x 2)))
+
+(define (%poke32u addr val)
+  (let ((x (make-bytevector 4)))
+    (%set32u x 0 val)
+    (poke-bytes addr x 4)))
+
+(define %peek-int %peek32)
+(define %peek-long %peek32)
+(define %peek-uint %peek32u)
+(define %peek-ulong %peek32u)
+(define %peek-short %peek16)
+(define %peek-ushort %peek16u)
+(define %peek-pointer %peek32u)
+
+(define %poke-int %poke32)
+(define %poke-long %poke32)
+(define %poke-uint %poke32u)
+(define %poke-ulong %poke32u)
+(define %poke-short %poke16)
+(define %poke-ushort %poke16u)
+(define %poke-pointer %poke32u)

retropikzel/pffi/larceny.scm

@@ -1,4 +1,6 @@
 (require 'std-ffi)
+;(require "Standard/foreign-stdlib")
+;(require "Lib/Common/system-interface")
 
 ;; FIXME
 (define size-of-type
@@ -23,3 +25,115 @@
           ((eq? type 'double) 8)
           ((eq? type 'pointer) 4)
           (else (error "Can not get size of unknown type" type)))))
+
+(define c-malloc (foreign-procedure "malloc" '(int) 'void*))
+;(define c-malloc (stdlib/malloc rtd-void*))
+#;(define pffi-pointer-allocate
+  (lambda (size)
+    (c-malloc size)))
+
+#;(define c-free (foreign-procedure "free" '(void*) 'int))
+;(define c-malloc (stdlib/malloc rtd-void*))
+#;(define pffi-pointer-free
+  (lambda (pointer)
+    (c-free pointer)))
+
+(define pffi-pointer-null (lambda () 0))
+
+(define pffi-pointer-null?
+  (lambda (object)
+    (and (number? object)
+         (= object 0))))
+
+(define pffi-pointer?
+  (lambda (object)
+    ;(void*? object)
+    (number? object)
+    ))
+
+(define pffi-pointer-address
+  (lambda (pointer)
+    ;(void*->address pointer)
+    pointer
+    ))
+
+(define pffi-pointer->string
+  (lambda (pointer)
+    ;(char*->string pointer)
+    pointer
+    ))
+
+(define pffi-string->pointer
+  (lambda (string-content)
+    ;(string->char* string-content)
+    string-content
+    ))
+
+(define pffi-shared-object-load
+  (lambda (headers path . options)
+    (foreign-file path)))
+
+
+(define pffi-pointer-set!
+  (lambda (pointer type offset value)
+    0
+    #;(cond ((equal? type 'int8) (%poke8 (+ pointer offset) value))
+          ((equal? type 'uint8) (%poke8u (+ pointer offset) value))
+          ((equal? type 'int16) (%poke16 (+ pointer offset) value))
+          ((equal? type 'uint16) (%poke16u (+ pointer offset) value))
+          ((equal? type 'int32) (%poke32 (+ pointer offset) value))
+          ((equal? type 'uint32) (%poke32u (+ pointer offset) value))
+          ;((equal? type 'int64) (%poke64 (+ pointer offset) value))
+          ;((equal? type 'uint64) (%poke64u (+ pointer offset) value))
+          ((equal? type 'char) (%poke8 (+ pointer offset) value))
+          ((equal? type 'short) (%poke-short (+ pointer offset) value))
+          ((equal? type 'unsigned-short) (%poke-ushort (+ pointer offset) value))
+          ((equal? type 'int) (%poke-int (+ pointer offset) value))
+          ((equal? type 'unsigned-int) (%poke-uint (+ pointer offset) value))
+          ((equal? type 'long) (%poke-long (+ pointer offset) value))
+          ((equal? type 'unsigned-long) (%poke-ulong (+ pointer offset) value))
+          ;((equal? type 'float) (%poke-ulong (+ pointer offset) value))
+          ;((equal? type 'double) (pointer-set-c-double! pointer offset value))
+          ((equal? type 'void) (%poke-pointer (+ pointer offset) value))
+          ((equal? type 'pointer) (%poke-pointer (+ pointer offset) value)))))
+
+(define pffi-pointer-get
+  (lambda (pointer type offset)
+    0
+    #;(cond ((equal? type 'int8) (%peek8 (+ pointer offset)))
+          ((equal? type 'uint8) (%peek8u (+ pointer offset)))
+          ((equal? type 'int16) (%peek16 (+ pointer offset)))
+          ((equal? type 'uint16) (%peek16u (+ pointer offset)))
+          ((equal? type 'int32) (%peek32 (+ pointer offset)))
+          ((equal? type 'uint32) (%peek32u (+ pointer offset)))
+          ;((equal? type 'int64) (%peek64 (+ pointer offset)))
+          ;((equal? type 'uint64) (%peek64u (+ pointer offset)))
+          ((equal? type 'char) (%peek8 (+ pointer offset)))
+          ((equal? type 'short) (%peek-short (+ pointer offset)))
+          ((equal? type 'unsigned-short) (%peek-ushort (+ pointer offset)))
+          ((equal? type 'int) (%peek-int (+ pointer offset)))
+          ((equal? type 'unsigned-int) (%peek-uint (+ pointer offset)))
+          ((equal? type 'long) (%peek-long (+ pointer offset)))
+          ((equal? type 'unsigned-long) (%peek-ulong (+ pointer offset)))
+          ;((equal? type 'float) (%peek-ulong (+ pointer offset)))
+          ;((equal? type 'double) (pointer-set-c-double! pointer offset))
+          ((equal? type 'void) (%peek-pointer (+ pointer offset)))
+          ((equal? type 'pointer) (%peek-pointer (+ pointer offset))))))
+
+(define-syntax pffi-define
+  (syntax-rules ()
+    ((pffi-define scheme-name shared-object c-name return-type argument-types)
+     (define scheme-name
+       0
+
+       #;(make-c-function shared-object
+                        (symbol->string c-name)
+                        return-type
+                        argument-types)))))
+
+(define-syntax pffi-define-callback
+  (syntax-rules ()
+    ((pffi-define scheme-name return-type argument-types procedure)
+     (define scheme-name
+       0
+       #;(make-c-callback return-type argument-types procedure)))))

retropikzel/pffi/mosh.scm

@@ -25,7 +25,7 @@
           (else #f))))
 
 (define pffi-shared-object-load
-  (lambda (header path . options)
+  (lambda (path . options)
     (open-shared-library path)))
 
 (define pffi-pointer-null
@@ -36,7 +36,7 @@
   (lambda (pointer)
     (pointer-null? pointer)))
 
-(define pffi-pointer-allocate
+#;(define pffi-pointer-allocate
   (lambda (size)
     (malloc size)))
 
@@ -48,7 +48,7 @@
   (lambda (object)
     (pointer? object)))
 
-(define pffi-pointer-free
+#;(define pffi-pointer-free
   (lambda (pointer)
     (free pointer)))
 

retropikzel/pffi/racket.scm

@@ -53,7 +53,7 @@
         (ctype-sizeof native-type)
         #f))))
 
-(define pffi-pointer-allocate
+#;(define pffi-pointer-allocate
   (lambda (size)
     (malloc 'raw size)))
 
@@ -87,7 +87,7 @@
                                          (list #f))))
       (ffi-lib path))))
 
-(define pffi-pointer-free
+#;(define pffi-pointer-free
   (lambda (pointer)
     (free pointer)))
 

retropikzel/pffi/sagittarius.scm

@@ -39,7 +39,7 @@
                         c-name
                         (map pffi-type->native-type argument-types))))))
 
-#;(define-syntax pffi-define-callback
+(define-syntax pffi-define-callback
   (syntax-rules ()
     ((_ scheme-name return-type argument-types procedure)
      (define scheme-name
@@ -73,15 +73,15 @@
           ((eq? type 'callback) size-of-void*)
           (else #f))))
 
-(define pffi-pointer-allocate
+#;(define pffi-pointer-allocate
   (lambda (size)
     (c-malloc size)))
 
 (define pffi-pointer-address
   (lambda (pointer)
-    (pointer-address pointer)))
+    (address pointer 0)))
 
-(define pffi-pointer-null
+#;(define pffi-pointer-null
   (lambda ()
     (empty-pointer)))
 
@@ -105,7 +105,7 @@
   (lambda (path options)
     (open-shared-library path)))
 
-(define pffi-pointer-free
+#;(define pffi-pointer-free
   (lambda (pointer)
     (when (pointer? pointer)
       (c-free pointer))))

retropikzel/pffi/shared/pointer.scm

@@ -0,0 +1,19 @@
+(cond-expand
+  ;(kawa #t) ; JVM
+  (windows (pffi-define-library pffi-libc-stdlib
+                                '("stdlib.h")
+                                "ucrtbase"
+                                '((additional-versions ("0" "6")))))
+  (else (pffi-define-library pffi-libc-stdlib
+                             '("stdlib.h")
+                             "c"
+                             '((additional-versions ("0" "6"))))))
+
+(pffi-define pffi-pointer-allocate pffi-libc-stdlib 'malloc 'pointer '(int))
+;(pffi-define pffi-pointer-allocate-aligned pffi-libc-stdlib 'aligned_alloc 'pointer '(int int))
+(pffi-define pffi-pointer-free pffi-libc-stdlib 'free 'void '(pointer))
+
+#;(define pffi-pointer-null
+  (lambda ()
+    ; Make aligned_alloc fail and return us a null pointer
+    (pffi-pointer-allocate-aligned -1 -1)))

retropikzel/pffi/shared/struct.scm

@@ -62,7 +62,7 @@
          (size (cdr (assoc 'size size-and-offsets)))
          (offsets (cdr (assoc 'offsets size-and-offsets)))
          (pointer (if (null? pointer) (pffi-pointer-allocate size) (car pointer)))
-         (c-typr (if (string? c-type) c-type (symbol->string c-type))))
+         (c-type (if (string? c-type) c-type (symbol->string c-type))))
     (struct-make c-type size pointer offsets))))
 
 (define (pffi-struct-offset-get struct member-name)

retropikzel/pffi/stklos.scm

@@ -99,7 +99,7 @@
 
       )))
 
-(define pffi-pointer-allocate
+#;(define pffi-pointer-allocate
   (lambda (size)
     (allocate-bytes size)))
 
@@ -108,13 +108,14 @@
   (lambda (pointer)
     0))
 
+;; FIXME
 (define pffi-pointer-null
   (lambda ()
     (let ((p (allocate-bytes 0)))
       (free-bytes p)
       p)))
 
-(define pffi-pointer-free
+#;(define pffi-pointer-free
   (lambda (pointer)
     (free-bytes pointer)))
 

retropikzel/pffi/ypsilon.scm

@@ -28,7 +28,7 @@
 (define c-malloc (c-function void* malloc (size_t)))
 (define c-free (c-function int free (void*)))
 
-(define pffi-pointer-allocate
+#;(define pffi-pointer-allocate
   (lambda (size)
     (c-malloc size)))
 
@@ -40,7 +40,7 @@
   (lambda (object)
     (number? object)))
 
-(define pffi-pointer-free
+#;(define pffi-pointer-free
   (lambda (pointer)
     (c-free pointer)))
 
@@ -118,31 +118,30 @@
   (lambda (headers path options)
     (load-shared-object path)))
 
-(define pffi-type->native-type
+(define-macro (pffi-type->native-type type)
-  (lambda (type)
+    `(cond ((equal? ,type int8) int8_t)
-    (cond ((equal? type '(quote int8)) 'int8_t)
+          ((equal? ,type uint8) uint8_t)
-          ((equal? type '(quote uint8)) 'uint8_t)
+          ((equal? ,type int16) int16_t)
-          ((equal? type '(quote int16)) 'int16_t)
+          ((equal? ,type uint16) uint16_t)
-          ((equal? type '(quote uint16)) 'uint16_t)
+          ((equal? ,type int32) int32_t)
-          ((equal? type '(quote int32)) 'int32_t)
+          ((equal? ,type uint32) uint32_t)
-          ((equal? type '(quote uint32)) 'uint32_t)
+          ((equal? ,type int64) int64_t)
-          ((equal? type '(quote int64)) 'int64_t)
+          ((equal? ,type uint64) uint64_t)
-          ((equal? type '(quote uint64)) 'uint64_t)
+          ((equal? ,type char) char)
-          ((equal? type '(quote char)) 'char)
+          ((equal? ,type unsigned-char) char)
-          ((equal? type '(quote unsigned-char)) 'char)
+          ((equal? ,type short) short)
-          ((equal? type '(quote short)) 'short)
+          ((equal? ,type unsigned-short) unsigned-short)
-          ((equal? type '(quote unsigned-short)) 'unsigned-short)
+          ((equal? ,type int) int)
-          ((equal? type '(quote int)) 'int)
+          ((equal? ,type unsigned-int) unsigned-int)
-          ((equal? type '(quote unsigned-int)) 'unsigned-int)
+          ((equal? ,type long) long)
-          ((equal? type '(quote long)) 'long)
+          ((equal? ,type unsigned-long) unsigned-long)
-          ((equal? type '(quote unsigned-long)) 'unsigned-long)
+          ((equal? ,type float) float)
-          ((equal? type '(quote float)) 'float)
+          ((equal? ,type double) double)
-          ((equal? type '(quote double)) 'double)
+          ((equal? ,type pointer) void*)
-          ((equal? type '(quote pointer)) 'void*)
+          ((equal? ,type string) void*)
-          ((equal? type '(quote string)) 'void*)
+          ((equal? ,type void) void)
-          ((equal? type '(quote void)) 'void)
+          ((equal? ,type callback) void*)
-          ((equal? type '(quote callback)) 'void*)
+          (else (error "pffi-type->native-type -- No such pffi type" ,type))))
-          (else (error "pffi-type->native-type -- No such pffi type" type)))))
 
 (define-macro
   (pffi-define scheme-name shared-object c-name return-type argument-types)

tests/compliance.scm

@@ -887,7 +887,7 @@
 ;; pffi-struct-dereference
 
 ;(print-header "pffi-struct-dereference 1")
-;(pffi-define c-color-check-by-value c-testlib 'color_check_by_value 'int '(struct))
+;(pffi-define c-color-check-by-value c-testlib 'color_check_by_value 'int '(uint32))
 #;(define struct-color (pffi-struct-make 'color '((int8 . r)
                                                 (int8 . g)
                                                 (int8 . b)
@@ -896,11 +896,11 @@
 ;(debug (pffi-struct-set! struct-color 'g 101))
 ;(debug (pffi-struct-set! struct-color 'b 102))
 ;(debug (pffi-struct-set! struct-color 'a 103))
-;(assert = (c-color-check-by-value (pffi-struct-dereference struct-color)) 0)
+;(assert = (c-color-check-by-value (pffi-pointer-address (pffi-struct-pointer struct-color))) 0)
 
 ;(print-header "pffi-struct-dereference 2")
 
-;(pffi-define c-test-check-by-value c-testlib 'test_check_by_value 'int '(struct))
+;(pffi-define c-test-check-by-value c-testlib 'test_check_by_value 'int '(int))
 #;(define struct-test3 (pffi-struct-make 'test
                                           '((int8 . a)
                                             (char . b)
@@ -944,7 +944,7 @@
 ;(debug (pffi-struct-get struct-test3 'l))
 ;(debug (pffi-struct-get struct-test3 'm))
 ;(debug (pffi-struct-get struct-test3 'n))
-;(c-test-check-by-value (pffi-struct-dereference struct-test3))
+;(c-test-check-by-value (pffi-pointer-address (pffi-struct-pointer struct-test3)))
 
 ;; pffi-define-callback