From b26893f7dafc51e284177dc9b0529f650265693e Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 11 Jul 2025 13:06:55 +0300 Subject: [PATCH] Update dependencies --- snow/foreign/c.sld | 52 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 1 deletion(-) diff --git a/snow/foreign/c.sld b/snow/foreign/c.sld index 121c725..655a8a2 100644 --- a/snow/foreign/c.sld +++ b/snow/foreign/c.sld @@ -300,7 +300,57 @@ ;; c-variable ;define-c-variable (?) ) - (cond-expand + (begin + (define type->libffi-type-number + (lambda (type) + (cond ((equal? type 'int8) 1) + ((equal? type 'uint8) 2) + ((equal? type 'int16) 3) + ((equal? type 'uint16) 4) + ((equal? type 'int32) 5) + ((equal? type 'uint32) 6) + ((equal? type 'int64) 7) + ((equal? type 'uint64) 8) + ((equal? type 'char) 9) + ((equal? type 'unsigned-char) 10) + ((equal? type 'short) 11) + ((equal? type 'unsigned-short) 12) + ((equal? type 'int) 13) + ((equal? type 'unsigned-int) 14) + ((equal? type 'long) 15) + ((equal? type 'unsigned-long) 16) + ((equal? type 'float) 17) + ((equal? type 'double) 18) + ((equal? type 'void) 19) + ((equal? type 'pointer) 20) + ((equal? type 'pointer-address) 21) + ((equal? type 'callback) 22) + (else (error "Undefined type" type))))) + (define c-bytevector-get + (lambda (pointer type offset) + (cond ((equal? type 'int8) (c-bytevector-s8-ref pointer offset)) + ((equal? type 'uint8) (c-bytevector-u8-ref pointer offset)) + ((equal? type 'int16) (c-bytevector-s16-ref pointer offset)) + ((equal? type 'uint16) (c-bytevector-u16-ref pointer offset)) + ((equal? type 'int32) (c-bytevector-s32-ref pointer offset)) + ((equal? type 'uint32) (c-bytevector-u32-ref pointer offset)) + ((equal? type 'int64) (c-bytevector-s64-ref pointer offset)) + ((equal? type 'uint64) (c-bytevector-u64-ref pointer offset)) + ((equal? type 'char) (integer->char (c-bytevector-s8-ref pointer offset))) + ((equal? type 'unsigned-char) (integer->char (c-bytevector-u8-ref pointer offset))) + ((equal? type 'short) (c-bytevector-sint-ref pointer offset (native-endianness) (c-type-size 'short))) + ((equal? type 'unsigned-short) (c-bytevector-sint-ref pointer offset (native-endianness) (c-type-size 'unsigned-short))) + ((equal? type 'int) (c-bytevector-sint-ref pointer offset (native-endianness) (c-type-size 'int))) + ((equal? type 'unsigned-int) (c-bytevector-sint-ref pointer offset (native-endianness) (c-type-size 'unsigned-int))) + ((equal? type 'long) (c-bytevector-sint-ref pointer offset (native-endianness) (c-type-size 'long))) + ((equal? type 'unsigned-long) (c-bytevector-sint-ref pointer offset (native-endianness) (c-type-size 'unsigned-long))) + ((equal? type 'float) (c-bytevector-ieee-single-native-ref pointer offset)) + ((equal? type 'double) (c-bytevector-ieee-double-native-ref pointer offset)) + ((equal? type 'pointer) (c-bytevector-pointer-ref pointer offset)) + ((not (equal? type 'void)) (error "No such foreign type" type)) + ;; Return unspecified on purpose if type is void + )))) + #;(cond-expand (chicken-6 (include-relative "c/internal.scm")) (else (include "c/internal.scm"))) (cond-expand