diff --git a/README.md b/README.md
index 5dd7b6c..1471e6a 100644
--- a/README.md
+++ b/README.md
@@ -26,11 +26,9 @@ conforming to some specification.
- [Status](#status)
- [Current caveats](#current-caveats)
- [Roadmap](#roadmap)
-- [Implementation table](#implementation-table)
- - [Beta](#beta)
- - [Alpha](#alpha)
- - [Not started](#not-started)
- - [Other](#other)
+- [Feature implementation table](#feature-implementation-table)
+ - [Primitives](#feature-implementation-table-primitives)
+ - [Built upon](#feature-implementation-table-built-upon)
- [Documentation](#documentation)
- [Installation](#installation)
- [Compiling the library](#compiling-the-library)
@@ -93,10 +91,6 @@ conforming to some specification.
Currently the interface of the library is in okay shape. It propably will not change much but no
guarantees are being made just yet.
-Due to supporting many different Scheme implementations, different parts of this software are in
-different stage. As a whole it is still in **alpha** stage. That said the interface should not be
-changing anymore and some implementations are in **beta**.
-
### Current caveats
@@ -112,41 +106,46 @@ changing anymore and some implementations are in **beta**.
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
-
+## Feature mplementation table
+
-### Released
-
+## Primitives
+
+| | pffi-init | pffi-size-of | pffi-define-library | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-address | pffi-pointer? | pffi-pointer-set! | pffi-pointer-get | pffi-define | pffi-define-callback |
+|--------------|:---------:|:------------:|:-------------------:|:-----------------:|:------------------:|:--------------------:|:-------------:|:-----------------:|:----------------:|:-----------:|:--------------------:|
+| Chibi | X | X | X | X | X | X | X | X | X | X | |
+| Chicken-5 | X | X | X | X | X | X | X | X | X | X | X |
+| Cyclone | X | X | X | X | X | | X | X | X | X | |
+| Gambit | X | X | | | | X | | | | | |
+| Gauche | X | X | X | X | X | X | X | X | X | X | |
+| Gerbil | X | | | | | | | | | | |
+| Guile | X | X | X | X | X | X | X | X | X | X | X |
+| Kawa | X | X | X | X | X | X | X | X | X | X | X |
+| Larceny | X | | | | | | | | | | |
+| Mosh | X | X | X | X | X | | X | X | X | X | X |
+| Racket | X | X | X | X | X | X | X | X | X | X | X |
+| Saggittarius | X | X | X | X | X | X | X | X | X | X | X |
+| Skint | X | | | | | | | | | | |
+| Stklos | X | X | X | X | X | | X | | | | |
+| tr7 | | | | | | | | | | | |
+| Ypsilon | X | X | X | X | X | X | X | X | X | X | X |
-### Beta
-
+## Built upon
+
-| | pffi-init | pffi-size-of | pffi-define-library | 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 | |
-| Chicken-5 | X | X | X | X | X | X | X | X | X | X | X | X | 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 | |
-| Guile | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
-| Kawa | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
-| Racket | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
-| Saggittarius | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
+These features are built upon the primitives and if primitives are implemented
+and work, they should work too.
-
-### Alpha
-
-
-| | pffi-init | pffi-size-of | pffi-define-library | 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 |
-|--------------|:---------:|:------------:|:-------------------:|:-----------------:|:------------------:|:---------------------:|:--------------------:|:-------------:|:-----------------:|:-----------------:|:----------------:|:--------------------:|:--------------------:|:----------------:|:-------------------:|:----------------------:|:---------------:|:----------------:|:-----------:|:--------------------:|
-| Cyclone | 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 | X | | |
-| Gerbil | X | | | | | | | | | | | | | X | X | X | X | X | | |
-| Larceny | X | | | | | | | | | | | | | X | X | X | X | X | | |
-| Mosh | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X |
-| Skint | X | | | | | | | | | | | | | X | X | X | X | X | | |
-| Stklos | X | X | X | X | X | X | | X | X | | | | | X | X | X | X | X | | |
-| tr7 | | | | | | | | | | | | | | X | X | X | X | X | | |
-| Ypsilon | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
+- pffi-pointer-allocate
+- pffi-pointer-free
+- pffi-pointer-\>string
+- pffi-string-\>pointer
+- pffi-struct-make
+- pffi-struct-pointer
+- pffi-struct-offset-get
+- pffi-struct-get
+- pffi-struct-set!
### Not started
diff --git a/retropikzel/pffi.sld b/retropikzel/pffi.sld
index de89713..31d29d5 100644
--- a/retropikzel/pffi.sld
+++ b/retropikzel/pffi.sld
@@ -29,6 +29,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback
;scheme-procedure-to-pointer
@@ -65,6 +67,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback))
(chicken6
@@ -97,6 +101,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback))
(cyclone
@@ -126,6 +132,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
;pffi-define-callback
))
@@ -156,6 +164,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
;pffi-define-callback
))
@@ -187,6 +197,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
;pffi-define-callback
))
@@ -215,6 +227,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
;pffi-define
;pffi-define-callback
))
@@ -247,6 +261,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback))
(kawa
@@ -275,6 +291,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback
))
@@ -309,6 +327,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
;pffi-define
;pffi-define-callback
))
@@ -339,6 +359,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback))
(racket
@@ -372,6 +394,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback))
(sagittarius
@@ -402,6 +426,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback))
(skint
@@ -429,6 +455,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
;pffi-define
;pffi-define-callback
))
@@ -459,6 +487,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
;pffi-define-callback
))
@@ -488,6 +518,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
;pffi-define
;pffi-define-callback
))
@@ -520,6 +552,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
+ pffi-list->array
+ pffi-array->list
pffi-define
pffi-define-callback))
(else (error "Unsupported implementation")))
@@ -544,5 +578,6 @@
;(include "pffi/shared/union.scm")
(include "pffi/shared/main.scm")
(include "pffi/shared/pointer.scm")
+ (include "pffi/shared/array.scm")
(include "pffi/shared/struct.scm")
)
diff --git a/retropikzel/pffi/sagittarius.scm b/retropikzel/pffi/sagittarius.scm
index 31bf01e..24692e3 100644
--- a/retropikzel/pffi/sagittarius.scm
+++ b/retropikzel/pffi/sagittarius.scm
@@ -22,7 +22,8 @@
((equal? type 'string) 'void*)
((equal? type 'void) 'void)
((equal? type 'callback) 'callback)
- ((equal? type 'struct) 'char*)
+ ((equal? type 'struct) 'void*)
+ ((list? type) (map pffi-type->native-type type))
(else #f))))
(define pffi-pointer?
@@ -81,7 +82,7 @@
(lambda (pointer)
(address pointer 0)))
-#;(define pffi-pointer-null
+(define pffi-pointer-null
(lambda ()
(empty-pointer)))
diff --git a/retropikzel/pffi/shared/array.scm b/retropikzel/pffi/shared/array.scm
new file mode 100644
index 0000000..42cd32a
--- /dev/null
+++ b/retropikzel/pffi/shared/array.scm
@@ -0,0 +1,22 @@
+(define pffi-list->array
+ (lambda (type list-arg)
+ (let* ((type-size (pffi-size-of type))
+ (array (pffi-pointer-allocate (* type-size (length list-arg))))
+ (offset 0))
+ (for-each
+ (lambda (item)
+ (pffi-pointer-set! array type offset item)
+ (set! offset (+ offset type-size)))
+ list-arg)
+ array)))
+
+(define pffi-array->list
+ (lambda (type array size)
+ (letrec* ((type-size (pffi-size-of type))
+ (max-offset (* type-size size))
+ (looper (lambda (offset result)
+ (if (= offset max-offset)
+ result
+ (looper (+ offset type-size)
+ (append result (list (pffi-pointer-get array type offset))))))))
+ (looper 0 (list)))))
diff --git a/tests/compliance.scm b/tests/compliance.scm
index 6c990e2..f57af13 100755
--- a/tests/compliance.scm
+++ b/tests/compliance.scm
@@ -884,6 +884,26 @@
(debug (pffi-struct-get struct-test2 'n))
(assert = (pffi-struct-get struct-test2 'n) 14.0)
+; Array utilities
+
+(print-header "Array utilities")
+
+(define test-list1 (list 1 2 3))
+(debug test-list1)
+(debug (pffi-list->array 'int test-list1))
+(assert equal? (pffi-array->list 'int (pffi-list->array 'int test-list1) 3) test-list1)
+
+(define test-array1 (pffi-pointer-allocate (* (pffi-size-of 'int) 3)))
+(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 0) 4)
+(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 1) 5)
+(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 2) 6)
+(debug test-array1)
+(debug (pffi-array->list 'int test-array1 3))
+(define check-list1 (list 4 5 6))
+(assert equal? (pffi-array->list 'int test-array1 3) check-list1)
+
+
+
;; pffi-struct-dereference
;(print-header "pffi-struct-dereference 1")