diff --git a/README.md b/README.md index 862fcd5..07d81d7 100644 --- a/README.md +++ b/README.md @@ -25,6 +25,7 @@ conforming to some specification. - [Non Goals](#non-goals) - [Status](#status) - [Current caveats](#current-caveats) +- [Roadmap](#roadmap) - [Implementation table](#implementation-table) - [Beta](#beta) - [Alpha](#alpha) @@ -101,13 +102,20 @@ changing anymore and some implementations are in **beta**. - Always pass arguments to pffi functions/macros as (list 1 2 3) and not '(1 2 3) - Always pass pffi-define-callback procedure as lambda on place +## Roadmap + +For roadmap to 1.0.0 see [issues](https://todo.sr.ht/~retropikzel/r7rs-pffi?search=status%3Aopen%20label%3A%221.0.0%22) + ## Implementation table +### Released + + + ### 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 | X | | diff --git a/retropikzel/pffi.sld b/retropikzel/pffi.sld index 8e75ba7..b7878ab 100644 --- a/retropikzel/pffi.sld +++ b/retropikzel/pffi.sld @@ -461,6 +461,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/chibi.scm b/retropikzel/pffi/chibi.scm index 2c88779..9a015ed 100644 --- a/retropikzel/pffi/chibi.scm +++ b/retropikzel/pffi/chibi.scm @@ -102,11 +102,11 @@ ((equal? type 'void) (pointer-ref-c-pointer pointer offset)) ((equal? type 'pointer) (pointer-ref-c-pointer pointer offset))))) -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) (string-to-pointer string-content))) -(define pffi-pointer->string +#;(define pffi-pointer->string (lambda (pointer) (pointer-to-string pointer))) diff --git a/retropikzel/pffi/chicken5.scm b/retropikzel/pffi/chicken5.scm index fc4b7d2..6d18f1d 100644 --- a/retropikzel/pffi/chicken5.scm +++ b/retropikzel/pffi/chicken5.scm @@ -153,11 +153,11 @@ (lambda () (address->pointer 0))) -(pffi-define strncpy-ps #f 'strncpy 'pointer (list 'pointer 'pointer 'int)) -(pffi-define puts #f 'puts 'int (list 'pointer)) -(pffi-define memset #f 'memset 'void (list 'pointer 'int 'int)) +;(pffi-define strncpy-ps #f 'strncpy 'pointer (list 'pointer 'pointer 'int)) +;(pffi-define puts #f 'puts 'int (list 'pointer)) +;(pffi-define memset #f 'memset 'void (list 'pointer 'int 'int)) -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) (let* ((size (string-length string-content)) (pointer (pffi-pointer-allocate (+ size 1)))) @@ -175,7 +175,7 @@ ;(pffi-define strncpy-pp #f 'strncpy 'pointer (list 'pointer 'pointer 'int)) ;(pffi-define strlen #f 'strlen 'int (list 'pointer)) -(define pffi-pointer->string +#;(define pffi-pointer->string (foreign-lambda* c-string ((c-pointer p)) "C_return((char*)p);")) diff --git a/retropikzel/pffi/cyclone.scm b/retropikzel/pffi/cyclone.scm index f2063f8..83824ee 100644 --- a/retropikzel/pffi/cyclone.scm +++ b/retropikzel/pffi/cyclone.scm @@ -102,12 +102,12 @@ (lambda () (make-opaque))) -(define-c pffi-string->pointer +#;(define-c pffi-string->pointer "(void *data, int argc, closure _, object k, object s)" "make_c_opaque(opq, string_str(s)); return_closcall1(data, k, &opq);") -(define-c pffi-pointer->string +#;(define-c pffi-pointer->string "(void *data, int argc, closure _, object k, object p)" "make_string(s, opaque_ptr(p)); return_closcall1(data, k, &s);") diff --git a/retropikzel/pffi/gerbil.scm b/retropikzel/pffi/gerbil.scm index 4c32e13..4b046f7 100644 --- a/retropikzel/pffi/gerbil.scm +++ b/retropikzel/pffi/gerbil.scm @@ -23,11 +23,11 @@ (lambda () (error "Not defined"))) -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) (error "Not defined"))) -(define pffi-pointer->string +#;(define pffi-pointer->string (lambda (pointer) pointer)) diff --git a/retropikzel/pffi/guile.scm b/retropikzel/pffi/guile.scm index a4df807..68eb76c 100644 --- a/retropikzel/pffi/guile.scm +++ b/retropikzel/pffi/guile.scm @@ -65,11 +65,11 @@ (lambda () (make-pointer 0))) -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) (string->pointer string-content))) -(define pffi-pointer->string +#;(define pffi-pointer->string (lambda (pointer) (pointer->string pointer))) diff --git a/retropikzel/pffi/kawa.scm b/retropikzel/pffi/kawa.scm index af4cb72..ba4561b 100644 --- a/retropikzel/pffi/kawa.scm +++ b/retropikzel/pffi/kawa.scm @@ -143,13 +143,13 @@ (lambda () (static-field java.lang.foreign.MemorySegment 'NULL))) -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) (let ((size (+ (invoke string-content 'length) 1))) (invoke (invoke arena 'allocateFrom (invoke string-content 'toString)) 'reinterpret size)))) -(define pffi-pointer->string +#;(define pffi-pointer->string (lambda (pointer) (invoke (invoke pointer 'reinterpret (static-field java.lang.Integer 'MAX_VALUE)) 'getString 0))) diff --git a/retropikzel/pffi/mosh.scm b/retropikzel/pffi/mosh.scm index 637d1c9..24abf27 100644 --- a/retropikzel/pffi/mosh.scm +++ b/retropikzel/pffi/mosh.scm @@ -92,7 +92,7 @@ ((equal? type 'void) (pointer-ref-c-pointer pointer offset)) ((equal? type 'pointer) (pointer-ref-c-pointer pointer offset))))) -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) (let ((pointer (pffi-pointer-allocate (+ (string-length string-content) 1))) (index 0)) @@ -104,10 +104,15 @@ (pffi-pointer-set! pointer 'char (* index (size-of-type 'char)) #\null) pointer))) -(define pffi-pointer->string +#;(define pffi-pointer->string (lambda (pointer) (pointer->string pointer))) +;; FIXME +(define pffi-pointer-address + (lambda (pointer) + 0)) + (define pffi-type->native-type (lambda (type) (cond ((equal? type 'int8) 'int8_t) diff --git a/retropikzel/pffi/racket.scm b/retropikzel/pffi/racket.scm index a3c538f..e4c837d 100644 --- a/retropikzel/pffi/racket.scm +++ b/retropikzel/pffi/racket.scm @@ -65,14 +65,14 @@ (lambda () #f )) ; #f is the null pointer on racket -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) (let* ((size (string-length string-content)) (pointer (pffi-pointer-allocate (+ size 1)))) (memmove pointer (cast (string-append string-content "") _string _pointer) (+ size 1)) pointer))) -(define pffi-pointer->string +#;(define pffi-pointer->string (lambda (pointer) (when (pffi-pointer-null? pointer) (error "Can not make string from null pointer" pointer)) diff --git a/retropikzel/pffi/sagittarius.scm b/retropikzel/pffi/sagittarius.scm index 0bcb8ac..cd35e9c 100644 --- a/retropikzel/pffi/sagittarius.scm +++ b/retropikzel/pffi/sagittarius.scm @@ -85,7 +85,7 @@ (lambda () (empty-pointer))) -(define (string->c-string s) +#;(define (string->c-string s) (let* ((bv (string->utf8 s)) (p (allocate-pointer (+ (bytevector-length bv) 1)))) (do ((i 0 (+ i 1))) @@ -93,11 +93,11 @@ (pointer-set-c-uint8! p i (bytevector-u8-ref bv i))) p)) -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) (string->c-string string-content))) -(define pffi-pointer->string +#;(define pffi-pointer->string (lambda (pointer) (pointer->string pointer))) diff --git a/retropikzel/pffi/shared/main.scm b/retropikzel/pffi/shared/main.scm index e35407e..42c080f 100644 --- a/retropikzel/pffi/shared/main.scm +++ b/retropikzel/pffi/shared/main.scm @@ -27,6 +27,31 @@ ((pffi-type? object) (size-of-type object)) (else (error "Not pffi-struct, pffi-enum of pffi-type" object))))) +(define pffi-string->pointer + (lambda (str) + (letrec* ((str-length (string-length str)) + (pointer (pffi-pointer-allocate (+ str-length 1))) + (looper (lambda (index) + (when (< index str-length) + (pffi-pointer-set! pointer + 'char + index + (string-ref str index)) + (looper (+ index 1)))))) + (looper 0) + (pffi-pointer-set! pointer 'char str-length #\null) + pointer))) + +(define pffi-pointer->string + (lambda (pointer) + (letrec* ((looper (lambda (index str) + (let ((c (pffi-pointer-get pointer 'char index))) + (if (char=? c #\null) + str + (looper (+ index 1) (cons c str))))))) + (list->string (reverse (looper 0 (list))))))) + + (define pffi-types '(int8 uint8 diff --git a/retropikzel/pffi/stklos.scm b/retropikzel/pffi/stklos.scm index a77af1c..54e23db 100644 --- a/retropikzel/pffi/stklos.scm +++ b/retropikzel/pffi/stklos.scm @@ -72,17 +72,22 @@ (lambda (size) (allocate-bytes size))) +;; FIXME +(define pffi-pointer-address + (lambda (pointer) + 0)) + (define pffi-pointer-null (lambda () (let ((p (allocate-bytes 0))) (free-bytes p) p))) -(define pffi-string->pointer +#;(define pffi-string->pointer (lambda (string-content) string-content)) -(define pffi-pointer->string +#;(define pffi-pointer->string (lambda (pointer) (if (string? pointer) pointer @@ -108,8 +113,3 @@ (define pffi-pointer-get (lambda (pointer type offset) (error "Not implemented"))) - -(define pffi-pointer-address - (lambda (pointer) - (error "Not implemented"))) - diff --git a/src/chibi/pffi.stub b/src/chibi/pffi.stub index f784611..69eb1ce 100644 --- a/src/chibi/pffi.stub +++ b/src/chibi/pffi.stub @@ -179,12 +179,12 @@ (define-c (maybe-null pointer void*) (pointer-ref-c-pointer pointer_ref_c_pointer) ((pointer void*) int)) ;; pffi-string->pointer -(c-declare "void* string_to_pointer(char* string) { return (void*)string; }") -(define-c (maybe-null pointer void*) (string-to-pointer string_to_pointer) (string)) +;(c-declare "void* string_to_pointer(char* string) { return (void*)string; }") +;(define-c (maybe-null pointer void*) (string-to-pointer string_to_pointer) (string)) ;; pffi-pointer->string -(c-declare "char* pointer_to_string(void* pointer) { return (char*)pointer; }") -(define-c string (pointer-to-string pointer_to_string) ((maybe-null pointer void*))) +;(c-declare "char* pointer_to_string(void* pointer) { return (char*)pointer; }") +;(define-c string (pointer-to-string pointer_to_string) ((maybe-null pointer void*))) ;; pffi-define