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

855 lines
32 KiB
C
Raw Permalink Blame History

/* Automatically generated by chibi-ffi; version: 0.5 */
#include <chibi/eval.h>
#include <stdint.h>
#include <dlfcn.h>
#include <stdio.h>
#include <ffi.h>
void* make_c_null() { return NULL; }
sexp is_null(void* pointer) { if(pointer == NULL) { return SEXP_TRUE; } else { return SEXP_FALSE; } }
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*); }
int align_of_int8_t() { return _Alignof(int8_t); }
int align_of_uint8_t() { return _Alignof(uint8_t); }
int align_of_int16_t() { return _Alignof(int16_t); }
int align_of_uint16_t() { return _Alignof(uint16_t); }
int align_of_int32_t() { return _Alignof(int32_t); }
int align_of_uint32_t() { return _Alignof(uint32_t); }
int align_of_int64_t() { return _Alignof(int64_t); }
int align_of_uint64_t() { return _Alignof(uint64_t); }
int align_of_char() { return _Alignof(char); }
int align_of_unsigned_char() { return _Alignof(unsigned char); }
int align_of_short() { return _Alignof(short); }
int align_of_unsigned_short() { return _Alignof(unsigned short); }
int align_of_int() { return _Alignof(int); }
int align_of_unsigned_int() { return _Alignof(unsigned int); }
int align_of_long() { return _Alignof(long); }
int align_of_unsigned_long() { return _Alignof(unsigned long); }
int align_of_float() { return _Alignof(float); }
int align_of_double() { return _Alignof(double); }
int align_of_pointer() { return _Alignof(void*); }
sexp is_pointer(struct sexp_struct* object) { if(sexp_cpointerp(object)) { return SEXP_TRUE; } else { return SEXP_FALSE; } }
void c_bytevector_u8_set(void* pointer, int offset, uint8_t value) { *(uint8_t*)((uint8_t*)pointer + offset) = value; }
uint8_t c_bytevector_u8_ref (void* pointer, int offset) { return *(uint8_t*)((uint8_t*)pointer + offset); }
void c_bytevector_pointer_set (void* pointer, int offset, void* value) { char* p = (char*)pointer + offset; *(char**)p = value; }
void* c_bytevector_pointer_ref (void* pointer, int offset) { char* p = (char*)pointer + offset; return (void*)*(char**)p;}
ffi_cif cif;
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];
//printf("nargs: %i\n", nargs);
for(int i = 0; i < nargs; i++) {
//printf("i: %i\n", 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]);
c_avalues[i] = &vals17[i];
break;
case 18:
c_atypes[i] = &ffi_type_double;
vals18[i] = (double)sexp_flonum_value(avalues[i]);
c_avalues[i] = &vals18[i];
break;
case 19:
c_atypes[i] = &ffi_type_void;
arg = NULL;
c_avalues[i] = NULL;
break;
case 20:
c_atypes[i] = &ffi_type_pointer;
if(sexp_cpointerp(avalues[i])) {
vals20[i] = sexp_cpointer_value(avalues[i]);
} else {
vals20[i] = NULL;
}
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;
}
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;
}
/*
types: ()
enums: ()
*/
sexp sexp_scheme_procedure_to_pointer_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
res = sexp_make_cpointer(ctx, SEXP_CPOINTER, scheme_procedure_to_pointer(arg0), SEXP_FALSE, 0);
return res;
}
sexp sexp_internal_ffi_call_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2, sexp arg3, sexp arg4, sexp arg5) {
int i = 0;
void* *tmp;
unsigned int *tmp2;
sexp *tmp5;
sexp res;
if (! sexp_exact_integerp(arg0))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
for (res=arg2; sexp_pairp(res); res=sexp_cdr(res))
if (! sexp_exact_integerp(sexp_car(res)))
return sexp_xtype_exception(ctx, self, "not a list of integers", arg2);
if (! sexp_nullp(res))
return sexp_xtype_exception(ctx, self, "not a list of integers", arg2);
if (! ((sexp_pointerp(arg3) && (sexp_pointer_tag(arg3) == SEXP_CPOINTER)) || sexp_not(arg3)))
return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg3);
if (! sexp_exact_integerp(arg4))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg4);
for (res=arg5; sexp_pairp(res); res=sexp_cdr(res))
if (! 1)
return sexp_xtype_exception(ctx, self, "not a list of sexps", arg5);
if (! sexp_nullp(res))
return sexp_xtype_exception(ctx, self, "not a list of sexps", arg5);
tmp2 = (unsigned int*) calloc((sexp_unbox_fixnum(sexp_length(ctx, arg2))+1), sizeof(tmp2[0]));
for (i=0, res=arg2; sexp_pairp(res); res=sexp_cdr(res), i++) {
tmp2[i] = sexp_uint_value(sexp_car(res));
}
tmp2[i] = 0;
tmp5 = (sexp*) calloc((sexp_unbox_fixnum(sexp_length(ctx, arg5))+1), sizeof(tmp5[0]));
for (i=0, res=arg5; sexp_pairp(res); res=sexp_cdr(res), i++) {
tmp5[i] = sexp_car(res);
}
tmp5[i] = 0;
res = sexp_make_cpointer(ctx, SEXP_CPOINTER, internal_ffi_call(sexp_uint_value(arg0), sexp_uint_value(arg1), tmp2, (void**)sexp_cpointer_maybe_null_value(arg3), sexp_uint_value(arg4), tmp5), SEXP_FALSE, 0);
free(tmp2);
free(tmp5);
return res;
}
sexp sexp_dlsym_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
void* *tmp;
sexp res;
if (! ((sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)) || sexp_not(arg0)))
return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
if (! sexp_stringp(arg1))
return sexp_type_exception(ctx, self, SEXP_STRING, arg1);
res = sexp_make_cpointer(ctx, SEXP_CPOINTER, dlsym((void**)sexp_cpointer_maybe_null_value(arg0), sexp_string_data(arg1)), SEXP_FALSE, 0);
return res;
}
sexp sexp_c_bytevector_pointer_ref_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
void* *tmp;
sexp res;
if (! ((sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)) || sexp_not(arg0)))
return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
res = sexp_make_cpointer(ctx, SEXP_CPOINTER, c_bytevector_pointer_ref((void**)sexp_cpointer_maybe_null_value(arg0), sexp_sint_value(arg1)), SEXP_FALSE, 0);
return res;
}
sexp sexp_c_bytevector_pointer_set_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
sexp res;
if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)))
return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
if (! ((sexp_pointerp(arg2) && (sexp_pointer_tag(arg2) == SEXP_CPOINTER)) || sexp_not(arg2)))
return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg2);
res = ((c_bytevector_pointer_set((void**)sexp_cpointer_value(arg0), sexp_sint_value(arg1), (void**)sexp_cpointer_maybe_null_value(arg2))), SEXP_VOID);
return res;
}
sexp sexp_c_bytevector_u8_ref_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
sexp res;
if (! ((sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)) || sexp_not(arg0)))
return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
res = sexp_make_unsigned_integer(ctx, c_bytevector_u8_ref((void**)sexp_cpointer_maybe_null_value(arg0), sexp_sint_value(arg1)));
return res;
}
sexp sexp_c_bytevector_u8_set_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
sexp res;
if (! ((sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)) || sexp_not(arg0)))
return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
if (! sexp_exact_integerp(arg2))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
res = ((c_bytevector_u8_set((void**)sexp_cpointer_maybe_null_value(arg0), sexp_sint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
return res;
}
sexp sexp_pointer_p_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
res = is_pointer(arg0);
return res;
}
sexp sexp_dlerror_stub (sexp ctx, sexp self, sexp_sint_t n) {
void* *tmp;
sexp res;
res = sexp_make_cpointer(ctx, SEXP_CPOINTER, dlerror(), SEXP_FALSE, 0);
return res;
}
sexp sexp_dlopen_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
void* *tmp;
sexp res;
if (! sexp_stringp(arg0))
return sexp_type_exception(ctx, self, SEXP_STRING, arg0);
if (! sexp_exact_integerp(arg1))
return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
res = sexp_make_cpointer(ctx, SEXP_CPOINTER, dlopen(sexp_string_data(arg0), sexp_sint_value(arg1)), SEXP_FALSE, 0);
return res;
}
sexp sexp_align_of_pointer_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_pointer());
return res;
}
sexp sexp_align_of_double_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_double());
return res;
}
sexp sexp_align_of_float_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_float());
return res;
}
sexp sexp_align_of_unsigned_long_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_unsigned_long());
return res;
}
sexp sexp_align_of_long_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_long());
return res;
}
sexp sexp_align_of_unsigned_int_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_unsigned_int());
return res;
}
sexp sexp_align_of_int_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_int());
return res;
}
sexp sexp_align_of_unsigned_short_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_unsigned_short());
return res;
}
sexp sexp_align_of_short_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_short());
return res;
}
sexp sexp_align_of_unsigned_char_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_unsigned_char());
return res;
}
sexp sexp_align_of_char_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_char());
return res;
}
sexp sexp_align_of_uint64_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_uint64_t());
return res;
}
sexp sexp_align_of_int64_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_int64_t());
return res;
}
sexp sexp_align_of_uint32_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_uint32_t());
return res;
}
sexp sexp_align_of_int32_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_int32_t());
return res;
}
sexp sexp_align_of_uint16_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_uint16_t());
return res;
}
sexp sexp_align_of_int16_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_int16_t());
return res;
}
sexp sexp_align_of_uint8_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_uint8_t());
return res;
}
sexp sexp_align_of_int8_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, align_of_int8_t());
return res;
}
sexp sexp_size_of_pointer_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_pointer());
return res;
}
sexp sexp_size_of_double_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_double());
return res;
}
sexp sexp_size_of_float_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_float());
return res;
}
sexp sexp_size_of_unsigned_long_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_unsigned_long());
return res;
}
sexp sexp_size_of_long_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_long());
return res;
}
sexp sexp_size_of_unsigned_int_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_unsigned_int());
return res;
}
sexp sexp_size_of_int_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_int());
return res;
}
sexp sexp_size_of_unsigned_short_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_unsigned_short());
return res;
}
sexp sexp_size_of_short_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_short());
return res;
}
sexp sexp_size_of_unsigned_char_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_unsigned_char());
return res;
}
sexp sexp_size_of_char_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_char());
return res;
}
sexp sexp_size_of_uint64_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_uint64_t());
return res;
}
sexp sexp_size_of_int64_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_int64_t());
return res;
}
sexp sexp_size_of_uint32_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_uint32_t());
return res;
}
sexp sexp_size_of_int32_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_int32_t());
return res;
}
sexp sexp_size_of_uint16_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_uint16_t());
return res;
}
sexp sexp_size_of_int16_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_int16_t());
return res;
}
sexp sexp_size_of_uint8_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_uint8_t());
return res;
}
sexp sexp_size_of_int8_t_stub (sexp ctx, sexp self, sexp_sint_t n) {
sexp res;
res = sexp_make_integer(ctx, size_of_int8_t());
return res;
}
sexp sexp_c_null_p_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
sexp res;
if (! ((sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == SEXP_CPOINTER)) || sexp_not(arg0)))
return sexp_type_exception(ctx, self, SEXP_CPOINTER, arg0);
res = is_null((void**)sexp_cpointer_maybe_null_value(arg0));
return res;
}
sexp sexp_make_c_null_stub (sexp ctx, sexp self, sexp_sint_t n) {
void* *tmp;
sexp res;
res = sexp_make_cpointer(ctx, SEXP_CPOINTER, make_c_null(), SEXP_FALSE, 0);
return res;
}
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) {
sexp_gc_var3(name, tmp, op);
if (!(sexp_version_compatible(ctx, version, sexp_version)
&& sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
return SEXP_ABI_ERROR;
sexp_gc_preserve3(ctx, name, tmp, op);
name = sexp_intern(ctx, "FFI-OK", 6);
sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, FFI_OK));
name = sexp_intern(ctx, "RTLD-NOW", 8);
sexp_env_define(ctx, env, name, tmp=sexp_make_integer(ctx, RTLD_NOW));
op = sexp_define_foreign(ctx, env, "scheme-procedure-to-pointer", 1, sexp_scheme_procedure_to_pointer_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
}
op = sexp_define_foreign(ctx, env, "internal-ffi-call", 6, sexp_internal_ffi_call_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
sexp_opcode_argn_type(op) = sexp_make_vector(ctx, SEXP_THREE, sexp_make_fixnum(SEXP_OBJECT));
sexp_vector_set(sexp_opcode_argn_type(op), SEXP_ZERO, sexp_make_fixnum(SEXP_CPOINTER));
sexp_vector_set(sexp_opcode_argn_type(op), SEXP_ONE, sexp_make_fixnum(SEXP_FIXNUM));
}
op = sexp_define_foreign(ctx, env, "dlsym", 2, sexp_dlsym_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_STRING);
}
op = sexp_define_foreign(ctx, env, "c-bytevector-pointer-ref", 2, sexp_c_bytevector_pointer_ref_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "c-bytevector-pointer-set!", 3, sexp_c_bytevector_pointer_set_x_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = SEXP_VOID;
sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
}
op = sexp_define_foreign(ctx, env, "c-bytevector-u8-ref", 2, sexp_c_bytevector_u8_ref_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "c-bytevector-u8-set!", 3, sexp_c_bytevector_u8_set_x_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = SEXP_VOID;
sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
sexp_opcode_arg3_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "pointer?", 1, sexp_pointer_p_stub);
op = sexp_define_foreign(ctx, env, "dlerror", 0, sexp_dlerror_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
}
op = sexp_define_foreign(ctx, env, "dlopen", 2, sexp_dlopen_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_STRING);
sexp_opcode_arg2_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-pointer", 0, sexp_align_of_pointer_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-double", 0, sexp_align_of_double_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-float", 0, sexp_align_of_float_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-unsigned-long", 0, sexp_align_of_unsigned_long_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-long", 0, sexp_align_of_long_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-unsigned-int", 0, sexp_align_of_unsigned_int_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-int", 0, sexp_align_of_int_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-unsigned-short", 0, sexp_align_of_unsigned_short_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-short", 0, sexp_align_of_short_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-unsigned-char", 0, sexp_align_of_unsigned_char_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-char", 0, sexp_align_of_char_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-uint64_t", 0, sexp_align_of_uint64_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-int64_t", 0, sexp_align_of_int64_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-uint32_t", 0, sexp_align_of_uint32_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-int32_t", 0, sexp_align_of_int32_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-uint16_t", 0, sexp_align_of_uint16_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-int16_t", 0, sexp_align_of_int16_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-uint8_t", 0, sexp_align_of_uint8_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "align-of-int8_t", 0, sexp_align_of_int8_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-pointer", 0, sexp_size_of_pointer_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-double", 0, sexp_size_of_double_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-float", 0, sexp_size_of_float_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-unsigned-long", 0, sexp_size_of_unsigned_long_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-long", 0, sexp_size_of_long_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-unsigned-int", 0, sexp_size_of_unsigned_int_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-int", 0, sexp_size_of_int_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-unsigned-short", 0, sexp_size_of_unsigned_short_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-short", 0, sexp_size_of_short_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-unsigned-char", 0, sexp_size_of_unsigned_char_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-char", 0, sexp_size_of_char_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-uint64_t", 0, sexp_size_of_uint64_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-int64_t", 0, sexp_size_of_int64_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-uint32_t", 0, sexp_size_of_uint32_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-int32_t", 0, sexp_size_of_int32_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-uint16_t", 0, sexp_size_of_uint16_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-int16_t", 0, sexp_size_of_int16_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-uint8_t", 0, sexp_size_of_uint8_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "size-of-int8_t", 0, sexp_size_of_int8_t_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_FIXNUM);
}
op = sexp_define_foreign(ctx, env, "c-null?", 1, sexp_c_null_p_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT);
sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
}
op = sexp_define_foreign(ctx, env, "make-c-null", 0, sexp_make_c_null_stub);
if (sexp_opcodep(op)) {
sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_CPOINTER);
}
sexp_gc_release3(ctx);
return SEXP_VOID;
}
Reference in New Issue View Git Blame Copy Permalink