compile-r7rs/snow/foreign/c/internal.scm

51 lines
2.8 KiB
Scheme

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