diff --git a/retropikzel/pffi/v0-1-0/guile.scm b/retropikzel/pffi/v0-1-0/guile.scm index dace474..e3aa0bf 100644 --- a/retropikzel/pffi/v0-1-0/guile.scm +++ b/retropikzel/pffi/v0-1-0/guile.scm @@ -32,7 +32,6 @@ ((equal? type 'uint32) uint32) ((equal? type 'int64) int64) ((equal? type 'uint64) uint64) - ;((equal? type 'char) char) ((equal? type 'char) int) ((equal? type 'unsigned-char) int) ((equal? type 'short) short) @@ -107,17 +106,16 @@ ((equal? native-type uint32) (bytevector-u32-set! p offset value (native-endianness))) ((equal? native-type int64) (bytevector-s64-set! p offset value (native-endianness))) ((equal? native-type uint64) (bytevector-u64-set! p offset value (native-endianness))) - ;((equal? native-type char) (string-set! (pointer->string pointer) offset value)) - ;((equal? native-type 'short) (pointer-set-c-short p offset value)) - ;((equal? native-type 'unsigned-short) (pointer-ref-c-unsigned-short p offset)) + ((equal? native-type char) (bytevector-u8-set! p offset value)) + ((equal? native-type short) (bytevector-s8-set! p offset value)) + ((equal? native-type unsigned-short) (bytevector-u8-set! p offset value)) ((equal? native-type int) (bytevector-sint-set! p offset value (native-endianness) (pffi-size-of type))) ((equal? native-type unsigned-int) (bytevector-uint-set! p offset value (native-endianness) (pffi-size-of type))) - ;((equal? native-type 'long) (pointer-ref-c-long p offset)) - ;((equal? native-type 'unsigned-long) (pointer-ref-c-unsigned-long p offset)) - ;((equal? native-type 'float) (pointer-ref-c-float p offset)) - ;((equal? native-type 'double) (pointer-ref-c-double p offset)) - ;((equal? native-type '*) (pointer-ref-c-void* p offset)) - )))) + ((equal? native-type long) (bytevector-s64-set! p offset value (native-endianness))) + ((equal? native-type unsigned-long) (bytevector-u64-set! p offset value (native-endianness))) + ((equal? native-type float) (bytevector-u64-set! p offset value (native-endianness))) + ((equal? native-type double) (bytevector-u64-set! p offset value (native-endianness))) + ((equal? native-type '*) (bytevector-sint-set! p offset value (native-endianness) (pffi-size-of type))))))) (define pffi-pointer-get (lambda (pointer type offset) @@ -131,18 +129,16 @@ ((equal? native-type uint32) (bytevector-u32-ref p offset (native-endianness))) ((equal? native-type int64) (bytevector-s64-ref p offset (native-endianness))) ((equal? native-type uint64) (bytevector-u64-ref p offset (native-endianness))) - ;((equal? native-type char) (string-ref (pointer->string pointer) offset)) - ;((equal? native-type 'short) (pointer-set-c-short p offset value)) - ;((equal? native-type 'unsigned-short) (pointer-ref-c-unsigned-short p offset)) + ((equal? native-type char) (bytevector-u8-ref p offset value)) + ((equal? native-type short) (bytevector-s8-ref p offset value)) + ((equal? native-type unsigned-short) (bytevector-u8-ref p offset value)) ((equal? native-type int) (bytevector-sint-ref p offset (native-endianness) (pffi-size-of type))) ((equal? native-type unsigned-int) (bytevector-uint-ref p offset (native-endianness) (pffi-size-of type))) - ;((equal? native-type 'long) (pointer-ref-c-long p offset)) - ;((equal? native-type 'unsigned-long) (pointer-ref-c-unsigned-long p offset)) - ;((equal? native-type 'float) (pointer-ref-c-float p offset)) - ;((equal? native-type 'double) (pointer-ref-c-double p offset)) - ;((equal? native-type '*) (pointer-ref-c-void* p offset)) - )) - )) + ((equal? native-type long) (bytevector-s64-ref p offset value (native-endianness))) + ((equal? native-type unsigned-long) (bytevector-u64-ref p offset value (native-endianness))) + ((equal? native-type float) (bytevector-u64-ref p offset value (native-endianness))) + ((equal? native-type double) (bytevector-u64-ref p offset value (native-endianness))) + ((equal? native-type '*) (bytevector-sint-ref p offset value (native-endianness) (pffi-size-of type))))))))))) (define pffi-pointer-deref (lambda (pointer) diff --git a/retropikzel/pffi/v0-1-0/kawa.scm b/retropikzel/pffi/v0-1-0/kawa.scm index 68462a7..7b3f5b0 100644 --- a/retropikzel/pffi/v0-1-0/kawa.scm +++ b/retropikzel/pffi/v0-1-0/kawa.scm @@ -20,41 +20,17 @@ (else value)))) - - - - - - - - - - - - - - - - (define pffi-type->native-type (lambda (type) (cond ((equal? type 'int8) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 1)) - ;((equal? type 'int8) (static-field java.lang.foreign.ValueLayout 'JAVA_INT)) ((equal? type 'uint8) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 1)) - ;((equal? type 'uint8) (static-field java.lang.foreign.ValueLayout 'JAVA_INT)) ((equal? type 'int16) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 2)) - ;((equal? type 'int16) (static-field java.lang.foreign.ValueLayout 'JAVA_INT)) ((equal? type 'uint16) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 2)) - ;((equal? type 'uint16) (static-field java.lang.foreign.ValueLayout 'JAVA_INT)) ((equal? type 'int32) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 4)) - ;((equal? type 'int32) (static-field java.lang.foreign.ValueLayout 'JAVA_INT)) ((equal? type 'uint32) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 4)) - ;((equal? type 'uint32) (static-field java.lang.foreign.ValueLayout 'JAVA_INT)) ((equal? type 'int64) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 8)) - ;((equal? type 'int64) (static-field java.lang.foreign.ValueLayout 'JAVA_INT)) ((equal? type 'uint64) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 8)) - ;((equal? type 'uint64) (static-field java.lang.foreign.ValueLayout 'JAVA_INT)) ((equal? type 'char) (static-field java.lang.foreign.ValueLayout 'JAVA_CHAR)) ((equal? type 'unsigned-char) (static-field java.lang.foreign.ValueLayout 'JAVA_CHAR)) ((equal? type 'short) (static-field java.lang.foreign.ValueLayout 'JAVA_SHORT)) diff --git a/retropikzel/pffi/v0-1-0/main.scm b/retropikzel/pffi/v0-1-0/main.scm index c67353a..2935323 100644 --- a/retropikzel/pffi/v0-1-0/main.scm +++ b/retropikzel/pffi/v0-1-0/main.scm @@ -77,6 +77,7 @@ pffi-pointer-get pffi-pointer-deref) (begin + (define library-version "v0-1-0") (define platform-file-extension @@ -106,8 +107,6 @@ uint32 int64 uint64 - intptr - uintptr char unsigned-char short @@ -118,7 +117,9 @@ unsigned-long float double - pointer)) + string + pointer + void)) (define string-split (lambda (str mark) diff --git a/retropikzel/pffi/v0-1-0/main.sld b/retropikzel/pffi/v0-1-0/main.sld index 11d3d2c..2935323 100644 --- a/retropikzel/pffi/v0-1-0/main.sld +++ b/retropikzel/pffi/v0-1-0/main.sld @@ -77,6 +77,7 @@ pffi-pointer-get pffi-pointer-deref) (begin + (define library-version "v0-1-0") (define platform-file-extension @@ -117,7 +118,8 @@ float double string - pointer)) + pointer + void)) (define string-split (lambda (str mark) diff --git a/retropikzel/pffi/v0-1-0/racket.rkt b/retropikzel/pffi/v0-1-0/racket.rkt index ce68c7c..2385743 100644 --- a/retropikzel/pffi/v0-1-0/racket.rkt +++ b/retropikzel/pffi/v0-1-0/racket.rkt @@ -106,6 +106,4 @@ (define pffi-pointer-deref (lambda (pointer) - pointer - ;#f ; TODO FIX - )))) + pointer)))) diff --git a/retropikzel/pffi/v0-1-0/stklos.scm b/retropikzel/pffi/v0-1-0/stklos.scm index cf1675b..c329bc4 100644 --- a/retropikzel/pffi/v0-1-0/stklos.scm +++ b/retropikzel/pffi/v0-1-0/stklos.scm @@ -62,8 +62,7 @@ (define pffi-size-of (lambda (type) - 4 ; TODO FIX - )) + (error "Not implemented"))) (define pffi-pointer-allocate (lambda (size) @@ -83,7 +82,7 @@ (define pffi-shared-object-load (lambda (header path) - path )) + path)) (define pffi-pointer-free (lambda (pointer) @@ -95,15 +94,12 @@ (define pffi-pointer-set! (lambda (pointer type offset value) - #f ; TODO FIX - )) + (error "Not implemented"))) (define pffi-pointer-get (lambda (pointer type offset) - #f ; TODO FIX - )) + (error "Not implemented"))) (define pffi-pointer-deref (lambda (pointer) - #f ; TODO FIX - )))) + (error "Not implemented")))))