Retropikzel
/
foreign-c
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Clean up type related code

This commit is contained in:
retropikzel 2024-05-18 20:23:06 +03:00
parent 069ffadaad
commit 888a66eaee
6 changed files with 29 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
retropikzel/pffi/v0-1-0/guile.scm
View File

@ -32,7 +32,6 @@
((equal? type 'uint32) uint32) ((equal? type 'uint32) uint32)
((equal? type 'int64) int64) ((equal? type 'int64) int64)
((equal? type 'uint64) uint64) ((equal? type 'uint64) uint64)
;((equal? type 'char) char)
((equal? type 'char) int) ((equal? type 'char) int)
((equal? type 'unsigned-char) int) ((equal? type 'unsigned-char) int)
((equal? type 'short) short) ((equal? type 'short) short)
@ -107,17 +106,16 @@
((equal? native-type uint32) (bytevector-u32-set! p offset value (native-endianness))) ((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 int64) (bytevector-s64-set! p offset value (native-endianness)))
((equal? native-type uint64) (bytevector-u64-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 char) (bytevector-u8-set! p offset value))
;((equal? native-type 'short) (pointer-set-c-short p offset value)) ((equal? native-type short) (bytevector-s8-set! p offset value))
;((equal? native-type 'unsigned-short) (pointer-ref-c-unsigned-short p offset)) ((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 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 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 long) (bytevector-s64-set! p offset value (native-endianness)))
;((equal? native-type 'unsigned-long) (pointer-ref-c-unsigned-long p offset)) ((equal? native-type unsigned-long) (bytevector-u64-set! p offset value (native-endianness)))
;((equal? native-type 'float) (pointer-ref-c-float p offset)) ((equal? native-type float) (bytevector-u64-set! p offset value (native-endianness)))
;((equal? native-type 'double) (pointer-ref-c-double p offset)) ((equal? native-type double) (bytevector-u64-set! p offset value (native-endianness)))
;((equal? native-type '*) (pointer-ref-c-void* p offset)) ((equal? native-type '*) (bytevector-sint-set! p offset value (native-endianness) (pffi-size-of type)))))))
))))
(define pffi-pointer-get (define pffi-pointer-get
(lambda (pointer type offset) (lambda (pointer type offset)
@ -131,18 +129,16 @@
((equal? native-type uint32) (bytevector-u32-ref p offset (native-endianness))) ((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 int64) (bytevector-s64-ref p offset (native-endianness)))
((equal? native-type uint64) (bytevector-u64-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 char) (bytevector-u8-ref p offset value))
;((equal? native-type 'short) (pointer-set-c-short p offset value)) ((equal? native-type short) (bytevector-s8-ref p offset value))
;((equal? native-type 'unsigned-short) (pointer-ref-c-unsigned-short p offset)) ((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 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 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 long) (bytevector-s64-ref p offset value (native-endianness)))
;((equal? native-type 'unsigned-long) (pointer-ref-c-unsigned-long p offset)) ((equal? native-type unsigned-long) (bytevector-u64-ref p offset value (native-endianness)))
;((equal? native-type 'float) (pointer-ref-c-float p offset)) ((equal? native-type float) (bytevector-u64-ref p offset value (native-endianness)))
;((equal? native-type 'double) (pointer-ref-c-double p offset)) ((equal? native-type double) (bytevector-u64-ref p offset value (native-endianness)))
;((equal? native-type '*) (pointer-ref-c-void* p offset)) ((equal? native-type '*) (bytevector-sint-ref p offset value (native-endianness) (pffi-size-of type)))))))))))
))
))
(define pffi-pointer-deref (define pffi-pointer-deref
(lambda (pointer) (lambda (pointer)

24
retropikzel/pffi/v0-1-0/kawa.scm
View File

@ -20,41 +20,17 @@
(else value)))) (else value))))
(define pffi-type->native-type (define pffi-type->native-type
(lambda (type) (lambda (type)
(cond (cond
((equal? type 'int8) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 1)) ((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) (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) (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) (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) (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) (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) (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) (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 'char) (static-field java.lang.foreign.ValueLayout 'JAVA_CHAR))
((equal? type 'unsigned-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)) ((equal? type 'short) (static-field java.lang.foreign.ValueLayout 'JAVA_SHORT))

7
retropikzel/pffi/v0-1-0/main.scm
View File

@ -77,6 +77,7 @@
pffi-pointer-get pffi-pointer-get
pffi-pointer-deref) pffi-pointer-deref)
(begin (begin
(define library-version "v0-1-0") (define library-version "v0-1-0")
(define platform-file-extension (define platform-file-extension
@ -106,8 +107,6 @@
uint32 uint32
int64 int64
uint64 uint64
intptr
uintptr
char char
unsigned-char unsigned-char
short short
@ -118,7 +117,9 @@
unsigned-long unsigned-long
float float
double double
pointer)) string
pointer
void))
(define string-split (define string-split
(lambda (str mark) (lambda (str mark)

4
retropikzel/pffi/v0-1-0/main.sld
View File

@ -77,6 +77,7 @@
pffi-pointer-get pffi-pointer-get
pffi-pointer-deref) pffi-pointer-deref)
(begin (begin
(define library-version "v0-1-0") (define library-version "v0-1-0")
(define platform-file-extension (define platform-file-extension
@ -117,7 +118,8 @@
float float
double double
string string
pointer)) pointer
void))
(define string-split (define string-split
(lambda (str mark) (lambda (str mark)

4
retropikzel/pffi/v0-1-0/racket.rkt
View File

@ -106,6 +106,4 @@
(define pffi-pointer-deref (define pffi-pointer-deref
(lambda (pointer) (lambda (pointer)
pointer pointer))))
;#f ; TODO FIX
))))

14
retropikzel/pffi/v0-1-0/stklos.scm
View File

@ -62,8 +62,7 @@
(define pffi-size-of (define pffi-size-of
(lambda (type) (lambda (type)
4 ; TODO FIX (error "Not implemented")))
))
(define pffi-pointer-allocate (define pffi-pointer-allocate
(lambda (size) (lambda (size)
@ -83,7 +82,7 @@
(define pffi-shared-object-load (define pffi-shared-object-load
(lambda (header path) (lambda (header path)
path )) path))
(define pffi-pointer-free (define pffi-pointer-free
(lambda (pointer) (lambda (pointer)
@ -95,15 +94,12 @@
(define pffi-pointer-set! (define pffi-pointer-set!
(lambda (pointer type offset value) (lambda (pointer type offset value)
#f ; TODO FIX (error "Not implemented")))
))
(define pffi-pointer-get (define pffi-pointer-get
(lambda (pointer type offset) (lambda (pointer type offset)
#f ; TODO FIX (error "Not implemented")))
))
(define pffi-pointer-deref (define pffi-pointer-deref
(lambda (pointer) (lambda (pointer)
#f ; TODO FIX (error "Not implemented")))))
))))