Merge remote-tracking branch 'origin/master' into ypsilon

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
 <a name="implementation-table"></a>
 
+### Released
+<a name="released"></a>
+
+
 ### Beta
 <a name="beta"></a>
 
-
 |              | 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           |                      |

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!

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)))
 

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);"))

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);")

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))
 

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)))
 

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)))
 

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)

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))

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)))
 

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

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")))
-

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