442 lines
22 KiB
Scheme
442 lines
22 KiB
Scheme
; vim: ft=scheme
|
|
|
|
(c-system-include "stdint.h")
|
|
(c-system-include "dlfcn.h")
|
|
(c-system-include "stdio.h")
|
|
(c-system-include "ffi.h")
|
|
|
|
;; c-size-of
|
|
(c-declare "
|
|
int size_of_int8_t() { return sizeof(int8_t); }
|
|
int size_of_uint8_t() { return sizeof(uint8_t); }
|
|
int size_of_int16_t() { return sizeof(int16_t); }
|
|
int size_of_uint16_t() { return sizeof(uint16_t); }
|
|
int size_of_int32_t() { return sizeof(int32_t); }
|
|
int size_of_uint32_t() { return sizeof(uint32_t); }
|
|
int size_of_int64_t() { return sizeof(int64_t); }
|
|
int size_of_uint64_t() { return sizeof(uint64_t); }
|
|
int size_of_char() { return sizeof(char); }
|
|
int size_of_unsigned_char() { return sizeof(unsigned char); }
|
|
int size_of_short() { return sizeof(short); }
|
|
int size_of_unsigned_short() { return sizeof(unsigned short); }
|
|
int size_of_int() { return sizeof(int); }
|
|
int size_of_unsigned_int() { return sizeof(unsigned int); }
|
|
int size_of_long() { return sizeof(long); }
|
|
int size_of_unsigned_long() { return sizeof(unsigned long); }
|
|
int size_of_float() { return sizeof(float); }
|
|
int size_of_double() { return sizeof(double); }
|
|
int size_of_pointer() { return sizeof(void*); }
|
|
")
|
|
|
|
(define-c int (size-of-int8_t size_of_int8_t) ())
|
|
(define-c int (size-of-uint8_t size_of_uint8_t) ())
|
|
(define-c int (size-of-int16_t size_of_int16_t) ())
|
|
(define-c int (size-of-uint16_t size_of_uint16_t) ())
|
|
(define-c int (size-of-int32_t size_of_int32_t) ())
|
|
(define-c int (size-of-uint32_t size_of_uint32_t) ())
|
|
(define-c int (size-of-int64_t size_of_int64_t) ())
|
|
(define-c int (size-of-uint64_t size_of_uint64_t) ())
|
|
(define-c int (size-of-char size_of_char) ())
|
|
(define-c int (size-of-unsigned-char size_of_unsigned_char) ())
|
|
(define-c int (size-of-short size_of_short) ())
|
|
(define-c int (size-of-unsigned-short size_of_unsigned_short) ())
|
|
(define-c int (size-of-int size_of_int) ())
|
|
(define-c int (size-of-unsigned-int size_of_unsigned_int) ())
|
|
(define-c int (size-of-long size_of_long) ())
|
|
(define-c int (size-of-unsigned-long size_of_unsigned_long) ())
|
|
(define-c int (size-of-float size_of_float) ())
|
|
(define-c int (size-of-double size_of_double) ())
|
|
(define-c int (size-of-pointer size_of_pointer) ())
|
|
|
|
;; shared-object-load
|
|
(define-c-const int (RTLD-NOW "RTLD_NOW"))
|
|
(define-c (maybe-null pointer void*) dlopen (string int))
|
|
(define-c (maybe-null pointer void*) dlerror ())
|
|
|
|
;(c-declare "void* pointer_null() { return NULL; }")
|
|
;(define-c (pointer void*) (pointer-null pointer_null) ())
|
|
|
|
;(c-declare "int is_pointer_null(void* pointer) { if(pointer == NULL) { return 1; } else { return 0; }; }")
|
|
;(define-c bool (is-pointer-null is_pointer_null) ((maybe-null pointer void*)))
|
|
|
|
;(c-declare "void* pointer_allocate(int size) { return malloc(size); }")
|
|
;(define-c (maybe-null pointer void*) (pointer-allocate pointer_allocate) (int))
|
|
|
|
(c-declare "sexp is_pointer(struct sexp_struct* object) { if(sexp_cpointerp(object)) { return SEXP_TRUE; } else { return SEXP_FALSE; } }")
|
|
(define-c sexp (pointer? is_pointer) (sexp))
|
|
|
|
(c-declare "void c_bytevector_u8_set(void* pointer, int offset, uint8_t value) { *(uint8_t*)((char*)pointer + offset) = value; }")
|
|
(define-c void (c-bytevector-u8-set! c_bytevector_u8_set) ((pointer void*) int uint8_t))
|
|
|
|
(c-declare "int8_t c_bytevector_u8_ref (void* pointer, int offset) { return *(int8_t*)((char*)pointer + offset); }")
|
|
(define-c int8_t (c-bytevector-u8-ref c_bytevector_u8_ref) ((pointer void*) int))
|
|
|
|
(c-declare "void c_bytevector_pointer_set (void* pointer, int offset, void* value) { char* p = (char*)pointer + offset; *(char**)p = value; }")
|
|
(define-c void (c-bytevector-pointer-set! c_bytevector_pointer_set) ((pointer void*) int (maybe-null pointer void*)))
|
|
|
|
(c-declare "void* c_bytevector_pointer_ref (void* pointer, int offset) { char* p = (char*)pointer + offset; return *(char**)p; }")
|
|
(define-c (maybe-null pointer void*) (c-bytevector-pointer-ref c_bytevector_pointer_ref) ((pointer void*) int))
|
|
|
|
#;(c-declare "void* pointer_address(struct sexp_struct* pointer) {
|
|
return &sexp_cpointer_value(pointer);
|
|
}")
|
|
;(define-c (maybe-null pointer void*) (pointer-address pointer_address) (sexp))
|
|
|
|
;(c-declare "void pointer_free(void* pointer) { free(pointer); }")
|
|
;(define-c void (pointer-free pointer_free) ((maybe-null pointer void*)))
|
|
|
|
;; pointer-set!
|
|
;(c-declare "void pointer_set_c_int8_t(void* pointer, int offset, int8_t value) { *(int8_t*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-int8_t! pointer_set_c_int8_t) ((pointer void*) int int8_t))
|
|
;(c-declare "void pointer_set_c_uint8_t(void* pointer, int offset, uint8_t value) { *(uint8_t*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-uint8_t! pointer_set_c_uint8_t) ((pointer void*) int uint8_t))
|
|
;
|
|
;(c-declare "void pointer_set_c_int16_t(void* pointer, int offset, int16_t value) { *(int16_t*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-int16_t! pointer_set_c_int16_t) ((pointer void*) int int16_t))
|
|
;(c-declare "void pointer_set_c_uint16_t(void* pointer, int offset, uint16_t value) { *(uint16_t*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-uint16_t! pointer_set_c_uint16_t) ((pointer void*) int uint16_t))
|
|
;
|
|
;(c-declare "void pointer_set_c_int32_t(void* pointer, int offset, int32_t value) { *(int32_t*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-int32_t! pointer_set_c_int32_t) ((pointer void*) int int32_t))
|
|
;(c-declare "void pointer_set_c_uint32_t(void* pointer, int offset, uint32_t value) { *(uint32_t*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-uint32_t! pointer_set_c_uint32_t) ((pointer void*) int uint32_t))
|
|
;
|
|
;(c-declare "void pointer_set_c_int64_t(void* pointer, int offset, int64_t value) { *(int64_t*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-int64_t! pointer_set_c_int64_t) ((pointer void*) int int64_t))
|
|
;(c-declare "void pointer_set_c_uint64_t(void* pointer, int offset, uint64_t value) { *(uint64_t*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-uint64_t! pointer_set_c_uint64_t) ((pointer void*) int uint64_t))
|
|
;
|
|
;(c-declare "void pointer_set_c_char(void* pointer, int offset, int8_t value) { *((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-char! pointer_set_c_char) ((pointer void*) int int8_t))
|
|
;(c-declare "void pointer_set_c_unsigned_char(void* pointer, int offset, unsigned char value) { *(unsigned char*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-unsigned-char! pointer_set_c_unsigned_char) ((pointer void*) int unsigned-char))
|
|
;
|
|
;(c-declare "void pointer_set_c_short(void* pointer, int offset, short value) { *(short*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-short! pointer_set_c_short) ((pointer void*) int short))
|
|
;(c-declare "void pointer_set_c_unsigned_short(void* pointer, int offset, unsigned short value) { *(unsigned short*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-unsigned-short! pointer_set_c_unsigned_short) ((pointer void*) int unsigned-short))
|
|
;
|
|
;(c-declare "void pointer_set_c_int(void* pointer, int offset, int value) { *(int*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-int! pointer_set_c_int) ((pointer void*) int int))
|
|
;(c-declare "void pointer_set_c_unsigned_int(void* pointer, int offset, unsigned int value) { *(unsigned int*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-unsigned-int! pointer_set_c_unsigned_int) ((pointer void*) int unsigned-int))
|
|
;
|
|
;(c-declare "void pointer_set_c_long(void* pointer, int offset, long value) { *(long*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-long! pointer_set_c_long) ((pointer void*) int long))
|
|
;(c-declare "void pointer_set_c_unsigned_long(void* pointer, int offset, unsigned long value) { *(unsigned long*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-unsigned-long! pointer_set_c_unsigned_long) ((pointer void*) int unsigned-long))
|
|
;
|
|
;(c-declare "void pointer_set_c_float(void* pointer, int offset, float value) { *(float*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-float! pointer_set_c_float) ((pointer void*) int float))
|
|
;
|
|
;(c-declare "void pointer_set_c_double(void* pointer, int offset, double value) { *(double*)((char*)pointer + offset) = value; }")
|
|
;(define-c void (pointer-set-c-double! pointer_set_c_double) ((pointer void*) int double))
|
|
;
|
|
;(c-declare "void pointer_set_c_pointer(void* pointer, int offset, void* value) { char* p = (char*)pointer + offset; *(char**)p = value; }")
|
|
;(define-c void (pointer-set-c-pointer! pointer_set_c_pointer) ((pointer void*) int (maybe-null pointer void*)))
|
|
;
|
|
;;; pointer-get
|
|
;(c-declare "int8_t pointer_ref_c_int8_t(void* pointer, int offset) { return *(int8_t*)((char*)pointer + offset); }")
|
|
;(define-c int8_t (pointer-ref-c-int8_t pointer_ref_c_int8_t) ((pointer void*) int))
|
|
;(c-declare "uint8_t pointer_ref_c_uint8_t(void* pointer, int offset) { return *(uint8_t*)((char*)pointer + offset); }")
|
|
;(define-c uint8_t (pointer-ref-c-uint8_t pointer_ref_c_uint8_t) ((pointer void*) int))
|
|
;
|
|
;(c-declare "int16_t pointer_ref_c_int16_t(void* pointer, int offset) { return *(int16_t*)((char*)pointer + offset); }")
|
|
;(define-c int16_t (pointer-ref-c-int16_t pointer_ref_c_int16_t) ((pointer void*) int))
|
|
;(c-declare "uint16_t pointer_ref_c_uint16_t(void* pointer, int offset) { return *(uint16_t*)((char*)pointer + offset); }")
|
|
;(define-c uint16_t (pointer-ref-c-uint16_t pointer_ref_c_uint16_t) ((pointer void*) int))
|
|
;
|
|
;(c-declare "int32_t pointer_ref_c_int32_t(void* pointer, int offset) { return *(int32_t*)((char*)pointer + offset); }")
|
|
;(define-c int32_t (pointer-ref-c-int32_t pointer_ref_c_int32_t) ((pointer void*) int))
|
|
;(c-declare "uint32_t pointer_ref_c_uint32_t(void* pointer, int offset) { return *(uint32_t*)((char*)pointer + offset); }")
|
|
;(define-c uint32_t (pointer-ref-c-uint32_t pointer_ref_c_uint32_t) ((pointer void*) int))
|
|
;
|
|
;(c-declare "int64_t pointer_ref_c_int64_t(void* pointer, int offset) { return *(int64_t*)((char*)pointer + offset); }")
|
|
;(define-c int64_t (pointer-ref-c-int64_t pointer_ref_c_int64_t) ((pointer void*) int))
|
|
;(c-declare "uint64_t pointer_ref_c_uint64_t(void* pointer, int offset) { return *(uint64_t*)((char*)pointer + offset); }")
|
|
;(define-c uint64_t (pointer-ref-c-uint64_t pointer_ref_c_uint64_t) ((pointer void*) int))
|
|
;
|
|
;(c-declare "int8_t pointer_ref_c_char(void* pointer, int offset) { return *(char*)((char*)pointer + offset); }")
|
|
;(define-c int8_t (pointer-ref-c-char pointer_ref_c_char) ((pointer void*) int))
|
|
;(c-declare "unsigned char pointer_ref_c_unsigned_char(void* pointer, int offset) { return *(unsigned char*)((char*)pointer + offset); }")
|
|
;(define-c unsigned-char (pointer-ref-c-unsigned-char pointer_ref_c_unsigned_char) ((pointer void*) int))
|
|
;
|
|
;(c-declare "short pointer_ref_c_short(void* pointer, int offset) { return *(short*)((char*)pointer + offset); }")
|
|
;(define-c short (pointer-ref-c-short pointer_ref_c_short) ((pointer void*) int))
|
|
;(c-declare "unsigned short pointer_ref_c_unsigned_short(void* pointer, int offset) { return *(unsigned short*)((char*)pointer + offset); }")
|
|
;(define-c unsigned-short (pointer-ref-c-unsigned-short pointer_ref_c_unsigned_short) ((pointer void*) int))
|
|
;
|
|
;(c-declare "int pointer_ref_c_int(void* pointer, int offset) { return *(int*)((char*)pointer + offset); }")
|
|
;(define-c int (pointer-ref-c-int pointer_ref_c_int) ((pointer void*) int))
|
|
;(c-declare "unsigned int pointer_ref_c_unsigned_int(void* pointer, int offset) { return *(unsigned int*)((char*)pointer + offset); }")
|
|
;(define-c unsigned-int (pointer-ref-c-unsigned-int pointer_ref_c_unsigned_int) ((pointer void*) int))
|
|
;
|
|
;(c-declare "long pointer_ref_c_long(void* pointer, int offset) { return *(long*)((char*)pointer + offset); }")
|
|
;(define-c long (pointer-ref-c-long pointer_ref_c_long) ((pointer void*) long))
|
|
;(c-declare "unsigned long pointer_ref_c_unsigned_long(void* pointer, int offset) { return *(unsigned long*)((char*)pointer + offset); }")
|
|
;(define-c unsigned-long (pointer-ref-c-unsigned-long pointer_ref_c_unsigned_long) ((pointer void*) int))
|
|
;
|
|
;(c-declare "float pointer_ref_c_float(void* pointer, int offset) { return *(float*)((char*)pointer + offset); }")
|
|
;(define-c float (pointer-ref-c-float pointer_ref_c_float) ((pointer void*) int))
|
|
;
|
|
;(c-declare "double pointer_ref_c_double(void* pointer, int offset) { return *(double*)((char*)pointer + offset); }")
|
|
;(define-c double (pointer-ref-c-double pointer_ref_c_double) ((pointer void*) int))
|
|
;
|
|
;(c-declare "void* pointer_ref_c_pointer(void* pointer, int offset) { char* p = (char*)pointer + offset; return *(char**)p; }")
|
|
;(define-c (maybe-null pointer void*) (pointer-ref-c-pointer pointer_ref_c_pointer) ((pointer void*) int))
|
|
|
|
;; define-c-procedure
|
|
|
|
(c-declare "ffi_cif cif;")
|
|
(define-c (pointer void*) dlsym ((maybe-null pointer void*) string))
|
|
|
|
;(c-declare "void* get_ffi_type_int8() { return &ffi_type_sint8; }")
|
|
;(define-c (pointer void*) (get-ffi-type-int8 get_ffi_type_int8) ())
|
|
;(c-declare "void* get_ffi_type_uint8() { return &ffi_type_uint8; }")
|
|
;(define-c (pointer void*) (get-ffi-type-uint8 get_ffi_type_uint8) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_int16() { return &ffi_type_sint16; }")
|
|
;(define-c (pointer void*) (get-ffi-type-int16 get_ffi_type_int16) ())
|
|
;(c-declare "void* get_ffi_type_uint16() { return &ffi_type_uint16; }")
|
|
;(define-c (pointer void*) (get-ffi-type-uint16 get_ffi_type_uint16) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_int32() { return &ffi_type_sint32; }")
|
|
;(define-c (pointer void*) (get-ffi-type-int32 get_ffi_type_int32) ())
|
|
;(c-declare "void* get_ffi_type_uint32() { return &ffi_type_uint32; }")
|
|
;(define-c (pointer void*) (get-ffi-type-uint32 get_ffi_type_uint32) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_int64() { return &ffi_type_sint64; }")
|
|
;(define-c (pointer void*) (get-ffi-type-int64 get_ffi_type_int64) ())
|
|
;(c-declare "void* get_ffi_type_uint64() { return &ffi_type_uint64; }")
|
|
;(define-c (pointer void*) (get-ffi-type-uint64 get_ffi_type_uint64) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_char() { return &ffi_type_schar; }")
|
|
;(define-c (pointer void*) (get-ffi-type-char get_ffi_type_char) ())
|
|
;(c-declare "void* get_ffi_type_uchar() { return &ffi_type_uchar; }")
|
|
;(define-c (pointer void*) (get-ffi-type-uchar get_ffi_type_uchar) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_short() { return &ffi_type_sshort; }")
|
|
;(define-c (pointer void*) (get-ffi-type-short get_ffi_type_short) ())
|
|
;(c-declare "void* get_ffi_type_ushort() { return &ffi_type_ushort; }")
|
|
;(define-c (pointer void*) (get-ffi-type-ushort get_ffi_type_ushort) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_int() { return &ffi_type_sint; }")
|
|
;(define-c (pointer void*) (get-ffi-type-int get_ffi_type_int) ())
|
|
;(c-declare "void* get_ffi_type_uint() { return &ffi_type_uint; }")
|
|
;(define-c (pointer void*) (get-ffi-type-uint get_ffi_type_uint) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_long() { return &ffi_type_slong; }")
|
|
;(define-c (pointer void*) (get-ffi-type-long get_ffi_type_long) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_ulong() { return &ffi_type_ulong; }")
|
|
;(define-c (pointer void*) (get-ffi-type-ulong get_ffi_type_ulong) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_float() { return &ffi_type_float; }")
|
|
;(define-c (pointer void*) (get-ffi-type-float get_ffi_type_float) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_double() { return &ffi_type_double; }")
|
|
;(define-c (pointer void*) (get-ffi-type-double get_ffi_type_double) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_void() { return &ffi_type_void; }")
|
|
;(define-c (pointer void*) (get-ffi-type-void get_ffi_type_void) ())
|
|
;
|
|
;(c-declare "void* get_ffi_type_pointer() { return &ffi_type_pointer; }")
|
|
;(define-c (pointer void*) (get-ffi-type-pointer get_ffi_type_pointer) ())
|
|
|
|
(define-c-const int (FFI-OK "FFI_OK"))
|
|
#;(c-declare
|
|
"int internal_ffi_prep_cif(unsigned int nargs, void* rtype, void* atypes[]) {
|
|
printf(\"A1: %u, A2: %u, nargs: %u\\n\", &ffi_type_pointer, atypes[0], nargs);
|
|
return ffi_prep_cif(&cif, FFI_DEFAULT_ABI, nargs, (ffi_type*)rtype, (ffi_type**)atypes);
|
|
}")
|
|
;(define-c int (internal-ffi-prep-cif internal_ffi_prep_cif) (unsigned-int (pointer void*) (array void*)))
|
|
(c-declare
|
|
"void* internal_ffi_call(
|
|
unsigned int nargs,
|
|
unsigned int rtype,
|
|
unsigned int atypes[],
|
|
void* fn,
|
|
unsigned int rvalue_size,
|
|
struct sexp_struct* avalues[])
|
|
{
|
|
ffi_type* c_atypes[nargs];
|
|
void* c_avalues[nargs];
|
|
|
|
int8_t vals1[nargs];
|
|
uint8_t vals2[nargs];
|
|
int16_t vals3[nargs];
|
|
uint16_t vals4[nargs];
|
|
int32_t vals5[nargs];
|
|
uint32_t vals6[nargs];
|
|
int64_t vals7[nargs];
|
|
uint64_t vals8[nargs];
|
|
char vals9[nargs];
|
|
unsigned char vals10[nargs];
|
|
short vals11[nargs];
|
|
unsigned short vals12[nargs];
|
|
int vals13[nargs];
|
|
unsigned int vals14[nargs];
|
|
long vals15[nargs];
|
|
unsigned long vals16[nargs];
|
|
float vals17[nargs];
|
|
double vals18[nargs];
|
|
void* vals20[nargs];
|
|
|
|
for(int i = 0; i < nargs; i++) {
|
|
void* arg = NULL;
|
|
switch(atypes[i]) {
|
|
case 1:
|
|
c_atypes[i] = &ffi_type_sint8;
|
|
vals1[i] = (int8_t)sexp_sint_value(avalues[i]);
|
|
c_avalues[i] = &vals1[i];
|
|
break;
|
|
case 2:
|
|
c_atypes[i] = &ffi_type_uint8;
|
|
vals2[i] = (uint8_t)sexp_uint_value(avalues[i]);
|
|
c_avalues[i] = &vals2[i];
|
|
break;
|
|
case 3:
|
|
c_atypes[i] = &ffi_type_sint16;
|
|
vals3[i] = (int16_t)sexp_sint_value(avalues[i]);
|
|
c_avalues[i] = &vals3[i];
|
|
break;
|
|
case 4:
|
|
c_atypes[i] = &ffi_type_uint16;
|
|
vals4[i] = (uint16_t)sexp_uint_value(avalues[i]);
|
|
c_avalues[i] = &vals4[i];
|
|
break;
|
|
case 5:
|
|
c_atypes[i] = &ffi_type_sint32;
|
|
vals5[i] = (int32_t)sexp_sint_value(avalues[i]);
|
|
c_avalues[i] = &vals5[i];
|
|
break;
|
|
case 6:
|
|
c_atypes[i] = &ffi_type_uint32;
|
|
vals6[i] = (int64_t)sexp_uint_value(avalues[i]);
|
|
c_avalues[i] = &vals6[i];
|
|
break;
|
|
case 7:
|
|
c_atypes[i] = &ffi_type_sint64;
|
|
vals7[i] = (int64_t) sexp_sint_value(avalues[i]);
|
|
c_avalues[i] = &vals7[i];
|
|
break;
|
|
case 8:
|
|
c_atypes[i] = &ffi_type_uint64;
|
|
vals8[i] = (uint64_t)sexp_uint_value(avalues[i]);
|
|
c_avalues[i] = &vals8[i];
|
|
break;
|
|
case 9:
|
|
c_atypes[i] = &ffi_type_schar;
|
|
vals9[i] = (char)sexp_sint_value(avalues[i]);
|
|
c_avalues[i] = &vals9[i];
|
|
break;
|
|
case 10:
|
|
c_atypes[i] = &ffi_type_uchar;
|
|
vals10[i] = (unsigned char)sexp_uint_value(avalues[i]);
|
|
break;
|
|
case 11:
|
|
c_atypes[i] = &ffi_type_sshort;
|
|
vals11[i] = (short)sexp_sint_value(avalues[i]);
|
|
break;
|
|
case 12:
|
|
c_atypes[i] = &ffi_type_ushort;
|
|
vals12[i] = (unsigned short)sexp_uint_value(avalues[i]);
|
|
break;
|
|
case 13:
|
|
c_atypes[i] = &ffi_type_sint;
|
|
vals13[i] = (int)sexp_sint_value(avalues[i]);
|
|
c_avalues[i] = &vals13[i];
|
|
break;
|
|
case 14:
|
|
c_atypes[i] = &ffi_type_uint;
|
|
vals14[i] = (unsigned int)sexp_uint_value(avalues[i]);
|
|
c_avalues[i] = &vals14[i];
|
|
break;
|
|
case 15:
|
|
c_atypes[i] = &ffi_type_slong;
|
|
vals15[i] = (long)sexp_sint_value(avalues[i]);
|
|
c_avalues[i] = &vals15[i];
|
|
break;
|
|
case 16:
|
|
c_atypes[i] = &ffi_type_ulong;
|
|
vals16[i] = (unsigned long)sexp_uint_value(avalues[i]);
|
|
c_avalues[i] = &vals16[i];
|
|
break;
|
|
case 17:
|
|
c_atypes[i] = &ffi_type_float;
|
|
vals17[i] = (float)sexp_flonum_value(avalues[i]);
|
|
break;
|
|
case 18:
|
|
c_atypes[i] = &ffi_type_double;
|
|
vals18[i] = (double)sexp_flonum_value(avalues[i]);
|
|
break;
|
|
case 19:
|
|
c_atypes[i] = &ffi_type_void;
|
|
arg = NULL;
|
|
break;
|
|
case 20:
|
|
c_atypes[i] = &ffi_type_pointer;
|
|
vals20[i] = sexp_cpointer_value(avalues[i]);
|
|
c_avalues[i] = &vals20[i];
|
|
break;
|
|
default:
|
|
printf(\"Undefined argument type integer: %i, index: %i\\n\", atypes[i], i);
|
|
//c_avalues[i] = sexp_cpointer_value(avalues[i]);
|
|
break;
|
|
}
|
|
}
|
|
|
|
ffi_type* c_rtype = &ffi_type_void;
|
|
switch(rtype) {
|
|
case 1: c_rtype = &ffi_type_sint8; break;
|
|
case 2: c_rtype = &ffi_type_uint8; break;
|
|
case 3: c_rtype = &ffi_type_sint16; break;
|
|
case 4: c_rtype = &ffi_type_uint16; break;
|
|
case 5: c_rtype = &ffi_type_sint32; break;
|
|
case 6: c_rtype = &ffi_type_uint32; break;
|
|
case 7: c_rtype = &ffi_type_sint64; break;
|
|
case 8: c_rtype = &ffi_type_uint64; break;
|
|
case 9: c_rtype = &ffi_type_schar; break;
|
|
case 10: c_rtype = &ffi_type_uchar; break;
|
|
case 11: c_rtype = &ffi_type_sshort; break;
|
|
case 12: c_rtype = &ffi_type_ushort; break;
|
|
case 13: c_rtype = &ffi_type_sint; break;
|
|
case 14: c_rtype = &ffi_type_uint; break;
|
|
case 15: c_rtype = &ffi_type_slong; break;
|
|
case 16: c_rtype = &ffi_type_ulong; break;
|
|
case 17: c_rtype = &ffi_type_float; break;
|
|
case 18: c_rtype = &ffi_type_double; break;
|
|
case 19: c_rtype = &ffi_type_void; break;
|
|
case 20: c_rtype = &ffi_type_pointer; break;
|
|
default:
|
|
printf(\"Undefined return type: %i\\n\", rtype);
|
|
c_rtype = &ffi_type_pointer;
|
|
break;
|
|
}
|
|
|
|
int r = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, nargs, c_rtype, c_atypes);
|
|
|
|
void* rvalue = malloc(rvalue_size);
|
|
ffi_call(&cif, FFI_FN(fn), rvalue, c_avalues);
|
|
return rvalue;
|
|
}")
|
|
(define-c (maybe-null pointer void*)
|
|
(internal-ffi-call internal_ffi_call)
|
|
(unsigned-int
|
|
unsigned-int
|
|
(array unsigned-int)
|
|
(pointer void*)
|
|
unsigned-int
|
|
(array sexp)))
|
|
|
|
(c-declare
|
|
"void* scheme_procedure_to_pointer(sexp proc) {
|
|
if(sexp_procedurep(proc) == 1) {
|
|
return 0; //&sexp_unbox_fixnum(proc);
|
|
} else {
|
|
printf(\"NOT A FUNCTION\\n\");
|
|
}
|
|
return (void*)proc;
|
|
}")
|
|
(define-c void* (scheme-procedure-to-pointer scheme_procedure_to_pointer) (sexp))
|