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

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

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

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

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

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

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

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

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

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

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