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

Fixing stklos

This commit is contained in:
retropikzel 2025-08-05 09:34:30 +03:00
parent a08a9dbd6d
commit a67e43cd26
2 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
foreign/c.sld
View File

@ -147,6 +147,7 @@
cpointer-data-set!
cpointer-set!
cpointer-ref
c-size-of
void?))
(export ; calculate-struct-size-and-offsets
;struct-make

24
foreign/c/primitives/stklos.scm
View File

@ -72,7 +72,7 @@
(type->native-type return-type))))))
; FIXME
(define size-of-type
#;(define size-of-type
(lambda (type)
(cond ((equal? type 'int8) 1)
((equal? type 'uint8) 1)
@ -94,6 +94,28 @@
((equal? type 'double) 8)
((equal? type 'pointer) 8))))
(define size-of-type
(lambda (type)
(cond ((equal? type 'int8) (c-size-of :int8))
((equal? type 'uint8) (c-size-of :uint8))
((equal? type 'int16) (c-size-of :int16))
((equal? type 'uint16) (c-size-of :uint16))
((equal? type 'int32) (c-size-of :int32))
((equal? type 'uint32) (c-size-of :uint32))
((equal? type 'int64) (c-size-of :int64))
((equal? type 'uint64) (c-size-of :uint64))
((equal? type 'char) (c-size-of :char))
((equal? type 'unsigned-char) (c-size-of :uchar))
((equal? type 'short) (c-size-of :short))
((equal? type 'unsigned-short) (c-size-of :ushort))
((equal? type 'int) (c-size-of :int))
((equal? type 'unsigned-int) (c-size-of :uint))
((equal? type 'long) (c-size-of :long))
((equal? type 'unsigned-long) (c-size-of :ulong))
((equal? type 'float) (c-size-of :float))
((equal? type 'double) (c-size-of :double))
((equal? type 'pointer) (c-size-of :pointer)))))
(define c-bytevector-u8-set!
(lambda (pointer offset value)
(cpointer-set! pointer :uint8 value offset)))