Commit f0016946 authored by Jean-Claude Beaudoin's avatar Jean-Claude Beaudoin
Browse files

Initial commit of the new C99-complete ffi. First clean compile, not operational yet.

parent 1a024146
......@@ -762,13 +762,14 @@ mkcl_alloc_raw_condition_variable(MKCL)
}
mkcl_object
mkcl_alloc_raw_foreign(MKCL)
mkcl_alloc_raw_foreign(MKCL, size_t size)
{
mkcl_object s;
COLLECT_STATS(env, foreign);
s = MKCL_GC_MALLOC(env, sizeof(struct mkcl_foreign));
s = MKCL_GC_MALLOC(env, sizeof(struct mkcl_foreign) + size);
s->foreign.t = mkcl_t_foreign;
s->foreign.size = size;
return s;
}
......
......@@ -514,7 +514,7 @@ mkcl_long_double_dynamic_callback_execute(long x0, long x1, long x2, long x3,
void *
mkcl_dynamic_callback_make(MKCL, mkcl_object data, enum mkcl_ffi_calling_convention cc_type)
mkcl_dynamic_callback_make(MKCL, mkcl_object data)
{
unsigned char * buf = mkcl_alloc_callback_block(env);
unsigned char * ip = buf; /* the instruction pointer (ip) */
......
......@@ -470,7 +470,7 @@ mkcl_long_double_dynamic_callback_execute(long a1, long a2, long a3, long a4,
void *
mkcl_dynamic_callback_make(MKCL, mkcl_object data, enum mkcl_ffi_calling_convention cc_type)
mkcl_dynamic_callback_make(MKCL, mkcl_object data)
{
unsigned char * buf = mkcl_alloc_callback_block(env);
unsigned char * ip = buf; /* the instruction pointer (ip) */
......
......@@ -299,8 +299,9 @@ mkcl_dynamic_callback_execute(mkcl_object cbk_info, char *arg_buffer)
}
#if MKCL_WINDOWS
void *
mkcl_dynamic_callback_make(MKCL, mkcl_object data, enum mkcl_ffi_calling_convention cc_type)
mkcl_stdcall_dynamic_callback_make(MKCL, mkcl_object data)
{
unsigned char * buf = mkcl_alloc_callback_block(env);
unsigned char * ip = buf; /* the instruction pointer (ip) */
......@@ -321,12 +322,8 @@ mkcl_dynamic_callback_make(MKCL, mkcl_object data, enum mkcl_ffi_calling_convent
/* call *%eax */ i(0xff); i(0xd0); /* call mkcl_dynamic_callback_execute() */
/* addl $16, %esp */ i(0x83); i(0xc4); i(0x10); /* cleanup arg list of previous call, 16 bytes. */
/* leave */ i(0xc9); /* undo stack frame */
#if MKCL_UNIX
/* ret */ i(0xc3); /* return */
#elif MKCL_WINDOWS
if (cc_type == MKCL_FFI_CC_CDECL) {
/* ret */ i(0xc3); /* return */
} else { /* This would be MKCL_FFI_CC_STDCALL. JCB */
{ /* This would be MKCL_FFI_CC_STDCALL. JCB */
mkcl_object arg_types = MKCL_CADDR(data);
unsigned long arg_list_byte_size = 0;
const unsigned long mask = 3;
......@@ -348,9 +345,53 @@ mkcl_dynamic_callback_make(MKCL, mkcl_object data, enum mkcl_ffi_calling_convent
/* ret <immed16> */ i(0xc2); immed16(arg_list_byte_size); /* return and pop byte_size bytes. */
}
}
#else
# error Incomplete mkcl_dynamic_callback_make().
/* nop */ i(0x90); /* Fill with nop until end of I-cache line (multiple of 16 bytes). */
/* nop */ i(0x90);
/* nop */ i(0x90);
/* nop */ i(0x90);
/* nop */ i(0x90);
/* nop */ i(0x90);
{ /* By default on Win64 data is PAGE_READWRITE only and we would get
an ACCESS_VIOLATION if we didn't set it to EXECUTE. */
/* Not really needed on Win32 but we do it for uniformity with other platforms. */
DWORD old_protection_flags;
BOOL ok = VirtualProtect(buf, mkcl_core.pagesize, PAGE_EXECUTE_READ, &old_protection_flags);
if (!ok)
mkcl_FEwin32_error(env, "mkcl_dynamic_callback_make() failed on VirtualProtect()", 0);
}
#if 0
printf("\nIn mkcl_stdcall_dynamic_callback_make(), returning %p.\n", buf); fflush(NULL); /* debug JCB */
#endif
return buf;
}
#endif
void *
mkcl_dynamic_callback_make(MKCL, mkcl_object data)
{
unsigned char * buf = mkcl_alloc_callback_block(env);
unsigned char * ip = buf; /* the instruction pointer (ip) */
union { unsigned char b[4]; void * p; unsigned long l; unsigned short s; } imm; /* a staging buffer for immediate data */
#define i(byte) *(ip++) = (byte)
#define immed_ptr(val_ptr) imm.p = (val_ptr); i(imm.b[0]); i(imm.b[1]); i(imm.b[2]); i(imm.b[3]);
#define immed16(val_short) imm.s = (val_short); i(imm.b[0]); i(imm.b[1]);
#define immed32(val_long) imm.l = (val_long); i(imm.b[0]); i(imm.b[1]); i(imm.b[2]); i(imm.b[3]);
/* pushl %ebp */ i(0x55); /* build stack frame, step 1 of 2 */
/* movl %esp, %ebp */ i(0x89); i(0xe5); /* build stack frame, step 2 of 2 */
/* pushl %esp */ i(0x54); /* push arg_list pointer */
/* movl <addr32>, %eax */ i(0xb8); immed_ptr(data);
/* pushl %eax */ i(0x50); /* push data */
/* movl <addr32>, %eax */ i(0xb8); immed_ptr(mkcl_dynamic_callback_execute);
/* call *%eax */ i(0xff); i(0xd0); /* call mkcl_dynamic_callback_execute() */
/* addl $16, %esp */ i(0x83); i(0xc4); i(0x10); /* cleanup arg list of previous call, 16 bytes. */
/* leave */ i(0xc9); /* undo stack frame */
/* ret */ i(0xc3); /* return */
/* nop */ i(0x90); /* Fill with nop until end of I-cache line (multiple of 16 bytes). */
/* nop */ i(0x90);
/* nop */ i(0x90);
......
......@@ -355,7 +355,7 @@ mkcl_dynamic_callback_execute(long i1, long i2, long i3, long i4, long i5, long
void *
mkcl_dynamic_callback_make(MKCL, mkcl_object data, enum mkcl_ffi_calling_convention cc_type)
mkcl_dynamic_callback_make(MKCL, mkcl_object data)
{
unsigned char * buf = mkcl_alloc_callback_block(env);
unsigned char * ip = buf; /* the instruction pointer (ip) */
......
......@@ -339,7 +339,7 @@ mkcl_dynamic_callback_execute(int64_t i1, int64_t i2, int64_t i3, int64_t i4,
void*
mkcl_dynamic_callback_make(MKCL, mkcl_object data, enum mkcl_ffi_calling_convention cc_type)
mkcl_dynamic_callback_make(MKCL, mkcl_object data)
{
unsigned char * buf = mkcl_alloc_callback_block(env);
unsigned char * ip = buf; /* the instruction pointer (ip) */
......
......@@ -84,11 +84,13 @@ static unsigned int const mkcl_foreign_type_size[] = {
0 /* sizeof(void) */
};
#if 0
/* This array must match content of enum mkcl_ffi_calling_convention. */
static const mkcl_object mkcl_foreign_cc_table[] = {
@':cdecl',
@':stdcall'
};
#endif
mkcl_object
......@@ -104,32 +106,20 @@ mkcl_object mk_si_foreignp(MKCL, mkcl_object x)
}
mkcl_object
mkcl_make_foreign(MKCL, mkcl_object type_tag, mkcl_index data_size, void * foreign_data_pointer)
mkcl_make_foreign(MKCL, mkcl_object C_type, mkcl_index data_size)
{
mkcl_object output = mkcl_alloc_raw_foreign(env);
output->foreign.tag = (type_tag == mk_cl_Cnil) ? @':void' : type_tag;
output->foreign.size = data_size;
output->foreign.data = foreign_data_pointer;
mkcl_object output = mkcl_alloc_raw_foreign(env, data_size);
output->foreign.C_type = C_type;
return output;
}
mkcl_object
mkcl_allocate_foreign_data(MKCL, mkcl_object tag, mkcl_index size)
mkcl_allocate_foreign_data(MKCL, mkcl_object C_type, mkcl_index size)
{
mkcl_object output = mkcl_alloc_raw_foreign(env);
output->foreign.tag = tag;
output->foreign.size = size;
output->foreign.data = mkcl_alloc_uncollectable(env, size);
#if 0 /* do we need this? */
/* The use of finalizer would require the introduction of a concept of "foreign data ownership"
since not all "foreign" own the data they point to, be they displaced, wrappers or clones. */
/* Currently we can hardly do any better than simply enjoy the memory leaks. JCB */
mk_si_set_finalizer(env, output, @+'si::free-foreign-data');
#endif
mkcl_object output = mkcl_alloc_raw_foreign(env, size);
output->foreign.C_type = C_type;
return output;
}
......@@ -138,7 +128,7 @@ mkcl_foreign_raw_pointer(MKCL, mkcl_object f)
{
if (mkcl_type_of(f) != mkcl_t_foreign)
mkcl_FEwrong_type_argument(env, @'si::foreign', f);
return f->foreign.data;
return ((void **) f->foreign.data)[0];
}
char *
......@@ -180,14 +170,14 @@ mkcl_object
mk_si_make_foreign_null_pointer(MKCL)
{
mkcl_call_stack_check(env);
mkcl_object output = mkcl_alloc_raw_foreign(env);
mkcl_object output = mkcl_alloc_raw_foreign(env, sizeof(void *));
output->foreign.tag = @':void';
output->foreign.size = 0;
output->foreign.data = NULL;
output->foreign.C_type = mkcl_cons(env, @'*', mkcl_cons(env, @':void', mk_cl_Cnil));
*((void **) output->foreign.data) = NULL;
@(return output);
}
#if 0
mkcl_object
mk_si_free_foreign_data(MKCL, mkcl_object f)
{
......@@ -203,32 +193,39 @@ mk_si_free_foreign_data(MKCL, mkcl_object f)
f->foreign.data = NULL;
@(return );
}
#endif
mkcl_object
mk_si_make_foreign_data_from_array(MKCL, mkcl_object array)
{
mkcl_object tag = mk_cl_Cnil;
mkcl_object elem_type = mk_cl_Cnil;
mkcl_call_stack_check(env);
if (mkcl_type_of(array) != mkcl_t_array && mkcl_type_of(array) != mkcl_t_vector) {
mkcl_FEwrong_type_argument(env, @'array', array);
}
switch (array->array.elttype) {
case mkcl_aet_sf: tag = @':float'; break;
case mkcl_aet_df: tag = @':double'; break;
case mkcl_aet_sf: elem_type = @':float'; break;
case mkcl_aet_df: elem_type = @':double'; break;
#if MKCL_WORD_BITS > MKCL_LONG_BITS
case mkcl_aet_word: tag = @':long-long'; break;
case mkcl_aet_index: tag = @':unsigned-long-long'; break;
case mkcl_aet_word: elem_type = @':long-long'; break;
case mkcl_aet_index: elem_type = @':unsigned-long-long'; break;
#else
case mkcl_aet_word: tag = @':long'; break;
case mkcl_aet_index: tag = @':unsigned-long'; break;
case mkcl_aet_word: elem_type = @':long'; break;
case mkcl_aet_index: elem_type = @':unsigned-long'; break;
#endif
/* Why not permit other element types? JCB */
default:
mkcl_FEerror(env, "Cannot make foreign object from array with element type ~S.",
1, mkcl_elttype_to_symbol(env, array->array.elttype));
break;
}
@(return mkcl_make_foreign(env, tag, 0, array->array.self.bc));
mkcl_object C_type = mkcl_cons(env, @'*', mkcl_cons(env, elem_type, mk_cl_Cnil));
mkcl_object obj = mkcl_make_foreign(env, C_type, sizeof(void *));
*((char **) obj->foreign.data) = array->array.self.bc;
@(return obj);
}
mkcl_object
......@@ -241,6 +238,7 @@ mk_si_foreign_address(MKCL, mkcl_object f)
@(return mkcl_make_unsigned_integer(env, (mkcl_index)f->foreign.data));
}
#if 0
mkcl_object
mk_si_foreign_tag(MKCL, mkcl_object f)
{
......@@ -250,7 +248,9 @@ mk_si_foreign_tag(MKCL, mkcl_object f)
}
@(return f->foreign.tag);
}
#endif
#if 0 /* redundant with mk_si_foreign_ref(). */
mkcl_object
mk_si_foreign_indexed(MKCL, mkcl_object f, mkcl_object andx, mkcl_object asize, mkcl_object tag)
{
......@@ -265,15 +265,16 @@ mk_si_foreign_indexed(MKCL, mkcl_object f, mkcl_object andx, mkcl_object asize,
if (ndx >= f->foreign.size || (f->foreign.size - ndx) < size) {
mkcl_FEerror(env, "Out of bounds reference into foreign data type ~A.", 1, f);
}
output = mkcl_alloc_raw_foreign(env);
output = mkcl_alloc_raw_foreign(env, size);
output->foreign.tag = tag;
output->foreign.size = size;
output->foreign.data = f->foreign.data + ndx;
@(return output);
}
#endif
mkcl_object
mk_si_foreign_ref(MKCL, mkcl_object f, mkcl_object andx, mkcl_object asize, mkcl_object tag)
mk_si_foreign_ref(MKCL, mkcl_object f, mkcl_object andx, mkcl_object asize)
{
mkcl_call_stack_check(env);
mkcl_index ndx = mkcl_integer_to_index(env, andx);
......@@ -286,7 +287,10 @@ mk_si_foreign_ref(MKCL, mkcl_object f, mkcl_object andx, mkcl_object asize, mkcl
if (ndx >= f->foreign.size || (f->foreign.size - ndx) < size) {
mkcl_FEerror(env, "Out of bounds reference into foreign data type ~A.", 1, f);
}
output = mkcl_make_foreign(env, tag, size, f->foreign.data + ndx);
mkcl_object C_type = mkcl_cons(env, @'*', f->foreign.C_type);
output = mkcl_make_foreign(env, C_type, sizeof(void *));
*((char **) output->foreign.data) = f->foreign.data + ndx;
@(return output);
}
......@@ -324,6 +328,7 @@ mkcl_foreign_type_code(MKCL, mkcl_object type)
return MKCL_FFI_VOID;
}
#if 0
enum mkcl_ffi_calling_convention
mkcl_foreign_cc_code(MKCL, mkcl_object cc)
{
......@@ -335,6 +340,7 @@ mkcl_foreign_cc_code(MKCL, mkcl_object cc)
mkcl_FEerror(env, "~A does no denote a valid calling convention.", 1, cc);
return MKCL_FFI_CC_CDECL;
}
#endif
mkcl_object
mkcl_foreign_ref_elt(MKCL, void *p, enum mkcl_ffi_tag tag)
......@@ -365,7 +371,12 @@ mkcl_foreign_ref_elt(MKCL, void *p, enum mkcl_ffi_tag tag)
case MKCL_FFI_UNSIGNED_LONG:
return mkcl_make_unsigned_integer(env, *(unsigned long *)p);
case MKCL_FFI_POINTER_VOID:
return mkcl_make_foreign(env, @':void', 0, *(void **)p);
{
mkcl_object C_type = mk_cl_list(env, 2, @'*', @':void');
mkcl_object obj = mkcl_make_foreign(env, C_type, sizeof(void *));
*((void **) obj->foreign.data) = *(void **)p;
return obj;
}
case MKCL_FFI_CSTRING:
return *(char **)p ? mkcl_make_simple_base_string(env, *(char **)p) : mk_cl_Cnil; /* external-format needed? JCB */
case MKCL_FFI_OBJECT:
......@@ -507,13 +518,13 @@ mk_si_null_pointer_p(MKCL, mkcl_object f)
}
mkcl_object
mk_si_foreign_recast(MKCL, mkcl_object f, mkcl_object size, mkcl_object tag)
mk_si_foreign_recast(MKCL, mkcl_object f, mkcl_object size, mkcl_object C_type)
{
mkcl_call_stack_check(env);
if (mkcl_type_of(f) != mkcl_t_foreign)
mkcl_FEwrong_type_argument(env, @'si::foreign', f);
f->foreign.size = mkcl_integer_to_index(env, size);
f->foreign.tag = tag;
f->foreign.C_type = C_type;
@(return f);
}
......@@ -589,7 +600,7 @@ mk_si_unload_foreign_module(MKCL, mkcl_object module)
}
mkcl_object
mk_si_find_foreign_symbol(MKCL, mkcl_object var, mkcl_object module, mkcl_object type, mkcl_object size)
mk_si_find_foreign_symbol(MKCL, mkcl_object var, mkcl_object module, mkcl_object C_type, mkcl_object size)
{
mkcl_call_stack_check(env);
volatile mkcl_object locked = mk_cl_Cnil;
......@@ -610,7 +621,11 @@ mk_si_find_foreign_symbol(MKCL, mkcl_object var, mkcl_object module, mkcl_object
} MKCL_UNWIND_PROTECT_END;
if (sym != NULL)
output = mkcl_make_foreign(env, type, mkcl_integer_to_index(env, size), sym);
{
output = mkcl_make_foreign(env, C_type, sizeof(void *));
/* *((void **) output->foreign.data) = sym; */
((void **) output->foreign.data)[0] = sym;
}
if (mkcl_type_of(output) != mkcl_t_foreign)
mkcl_FEerror(env, "FIND-FOREIGN-SYMBOL: Could not load foreign symbol ~S from module ~S (Error: ~S)", 3, var, module, output);
......@@ -676,14 +691,14 @@ mkcl_fficall_prepare(MKCL, mkcl_object return_type, mkcl_object arg_type, mkcl_o
fficall->buffer_sp = fficall->buffer;
fficall->registers = NULL;
fficall->output.pc = NULL;
fficall->cc = MKCL_FFI_CC_CDECL;
/* fficall->cc = MKCL_FFI_CC_CDECL; */
/* fficall->cstring = mk_cl_Cnil; */
}
else
fficall->buffer_sp = fficall->buffer;
/* fficall->buffer_size = 0; */
/* fficall->cstring = mk_cl_Cnil; */
fficall->cc = mkcl_foreign_cc_code(env, cc_type);
/* fficall->cc = mkcl_foreign_cc_code(env, cc_type); */
fficall->registers = mkcl_fficall_prepare_extra(env, fficall->registers);
return fficall;
}
......@@ -761,12 +776,17 @@ void mkcl_fficall_align16(MKCL)
@)
@(defun si::make-dynamic-callback (fun sym rtype argtypes &optional (cctype @':cdecl'))
mkcl_object data;
mkcl_object cbk;
@
data = mk_cl_list(env, 3, fun, rtype, argtypes);
cbk = mkcl_make_foreign(env, @':void', 0, mkcl_dynamic_callback_make(env, data, mkcl_foreign_cc_code(env, cctype)));
mkcl_object data = mk_cl_list(env, 3, fun, rtype, argtypes);
#if 0
void * ptr = mkcl_dynamic_callback_make(env, data, mkcl_foreign_cc_code(env, cctype));
#else
void * ptr = mkcl_dynamic_callback_make(env, data);
#endif
mkcl_object C_type = mk_cl_list(env, 2, @'*', @':void');
mkcl_object cbk = mkcl_make_foreign(env, C_type, sizeof(void *));
*((void **) cbk->foreign.data) = ptr;
mk_si_put_sysprop(env, sym, @':callback', MKCL_CONS(env, cbk, data));
@(return cbk);
@)
......
......@@ -1208,7 +1208,7 @@ mkcl_hash_table_iterate(MKCL, mkcl_narg narg)
for (; e != NULL; e = e->next)
if (e->key != MKCL_OBJNULL) { /* next in bucket. Pop and return it. */
/* bucket_index has not changed. */
next_wrapper->foreign.data = (void *) e->next;
*((void **) next_wrapper->foreign.data) = (void *) e->next;
@(return mk_cl_Ct e->key e->value);
}
}
......@@ -1224,14 +1224,14 @@ mkcl_hash_table_iterate(MKCL, mkcl_narg narg)
if (e->key != MKCL_OBJNULL) {
const mkcl_object _bucket_index = MKCL_MAKE_FIXNUM(bucket_index);
closure_display->display.level[0]->lblock.var[2] = _bucket_index;
next_wrapper->foreign.data = (void *) e->next;
*((void **) next_wrapper->foreign.data) = (void *) e->next;
@(return mk_cl_Ct e->key e->value);
}
}
}
/* If we reach here then the iteration is complete. */
closure_display->display.level[0]->lblock.var[2] = MKCL_MAKE_FIXNUM(bucket_index);
next_wrapper->foreign.data = NULL;
*((void **) next_wrapper->foreign.data) = NULL;
@(return mk_cl_Cnil mk_cl_Cnil mk_cl_Cnil);
}
......@@ -1244,12 +1244,12 @@ mk_si_hash_table_iterator(MKCL, mkcl_object ht)
{
mkcl_object closure_block = mkcl_alloc_clevel_block(env, mk_cl_Cnil, mk_cl_Cnil, 3);
mkcl_object closure_syms_block = mkcl_alloc_clevel_block(env, mk_cl_Cnil, mk_cl_Cnil, 3);
mkcl_object it = mkcl_make_foreign(env, mk_cl_list(env, 2, @'*', @':void'), sizeof(void *));
*((void **) it->foreign.data) = ht->hash.data[0];
closure_block->lblock.producer = mk_cl_Cnil;
closure_block->lblock.var[0] = ht;
closure_block->lblock.var[1] = mkcl_make_foreign(env, mk_cl_Cnil,
sizeof(struct mkcl_hashtable_entry),
ht->hash.data[0]);
closure_block->lblock.var[1] = it;
closure_block->lblock.var[2] = MKCL_MAKE_FIXNUM(0);
closure_syms_block->lblock.producer = mk_cl_Cnil;
......
......@@ -312,7 +312,7 @@ extern "C" {
extern MKCL_API mkcl_object mkcl_alloc_raw_rwlock(MKCL);
extern MKCL_API mkcl_object mkcl_alloc_raw_semaphore(MKCL);
extern MKCL_API mkcl_object mkcl_alloc_raw_condition_variable(MKCL);
extern MKCL_API mkcl_object mkcl_alloc_raw_foreign(MKCL);
extern MKCL_API mkcl_object mkcl_alloc_raw_foreign(MKCL, size_t);
extern MKCL_API mkcl_object mkcl_alloc_raw_stream(MKCL);
extern MKCL_API mkcl_object mkcl_alloc_raw_process(MKCL);
extern MKCL_API mkcl_object mkcl_alloc_utf_8(MKCL, mkcl_index length);
......@@ -820,12 +820,16 @@ extern "C" {
extern MKCL_API mkcl_object mk_si_allocate_foreign_data(MKCL, mkcl_object tag, mkcl_object size);
extern MKCL_API mkcl_object mk_si_make_foreign_null_pointer(MKCL);
extern MKCL_API mkcl_object mk_si_foreign_address(MKCL, mkcl_object f);
#if 0
extern MKCL_API mkcl_object mk_si_foreign_indexed(MKCL, mkcl_object f, mkcl_object ndx, mkcl_object size, mkcl_object tag);
extern MKCL_API mkcl_object mk_si_foreign_ref(MKCL, mkcl_object f, mkcl_object ndx, mkcl_object size, mkcl_object tag);
#endif
extern MKCL_API mkcl_object mk_si_foreign_ref(MKCL, mkcl_object f, mkcl_object ndx, mkcl_object size);
extern MKCL_API mkcl_object mk_si_foreign_ref_elt(MKCL, mkcl_object f, mkcl_object ndx, mkcl_object tag);
extern MKCL_API mkcl_object mk_si_foreign_set(MKCL, mkcl_object f, mkcl_object ndx, mkcl_object value);
extern MKCL_API mkcl_object mk_si_foreign_set_elt(MKCL, mkcl_object f, mkcl_object ndx, mkcl_object tag, mkcl_object value);
#if 0
extern MKCL_API mkcl_object mk_si_foreign_tag(MKCL, mkcl_object x);
#endif
extern MKCL_API mkcl_object mk_si_foreign_recast(MKCL, mkcl_object f, mkcl_object size, mkcl_object tag);
extern MKCL_API mkcl_object mk_si_free_foreign_data(MKCL, mkcl_object x);
extern MKCL_API mkcl_object mk_si_make_foreign_data_from_array(MKCL, mkcl_object x);
......@@ -840,19 +844,6 @@ extern "C" {
extern MKCL_API mkcl_object mk_si_release_ffi_area(MKCL);
extern MKCL_API mkcl_object mk_si_pointer(MKCL, mkcl_object x);
extern MKCL_API mkcl_object mkcl_make_foreign(MKCL, mkcl_object type_tag, mkcl_index data_size, void * foreign_data_pointer);
extern MKCL_API mkcl_object mkcl_allocate_foreign_data(MKCL, mkcl_object tag, mkcl_index size);
extern MKCL_API void * mkcl_foreign_raw_pointer(MKCL, mkcl_object f);
extern MKCL_API char * mkcl_base_string_raw_pointer(MKCL, mkcl_object f);
extern MKCL_API mkcl_object mkcl_null_terminated_base_string(MKCL, mkcl_object s);
extern MKCL_API mkcl_object mkcl_foreign_ref_elt(MKCL, void *p, enum mkcl_ffi_tag type);
extern MKCL_API void mkcl_foreign_set_elt(MKCL, void *p, enum mkcl_ffi_tag type, mkcl_object value);
static inline bool mkcl_foreignp(MKCL, mkcl_object x)
{
mkcl_type t = mkcl_type_of(x);
return (t == mkcl_t_foreign);
}
/* file.c */
......
......@@ -209,6 +209,55 @@ extern "C" {
/* ffi.d */
enum mkcl_ffi_tag {
MKCL_FFI_CHAR = 0,
MKCL_FFI_UNSIGNED_CHAR,
MKCL_FFI_BYTE,
MKCL_FFI_UNSIGNED_BYTE,
MKCL_FFI_SHORT,
MKCL_FFI_UNSIGNED_SHORT,
MKCL_FFI_INT,
MKCL_FFI_UNSIGNED_INT,
MKCL_FFI_LONG,
MKCL_FFI_UNSIGNED_LONG,
MKCL_FFI_LONG_LONG,
MKCL_FFI_UNSIGNED_LONG_LONG,
MKCL_FFI_POINTER_VOID,
MKCL_FFI_CSTRING,
MKCL_FFI_OBJECT, /* This tag must be the last one of the "integral" types. */
MKCL_FFI_FLOAT,
MKCL_FFI_DOUBLE,
MKCL_FFI_LONG_DOUBLE,
#if 0
/* The other C99 types. */
MKCL_FFI_FLOAT_COMPLEX,
MKCL_FFI_DOUBLE_COMPLEX,
MKCL_FFI_LONG_DOUBLE_COMPLEX,
MKCL_FFI_FLOAT_IMAGINARY,
MKCL_FFI_DOUBLE_IMAGINARY,
MKCL_FFI_LONG_DOUBLE_IMAGINARY,
#endif
MKCL_FFI_VOID,
MKCL_FFI_INT8_T = MKCL_FFI_BYTE,
MKCL_FFI_UINT8_T = MKCL_FFI_UNSIGNED_BYTE,
MKCL_FFI_INT16_T = MKCL_FFI_SHORT,
MKCL_FFI_UINT16_T = MKCL_FFI_UNSIGNED_SHORT,
MKCL_FFI_INT32_T = MKCL_FFI_INT,
MKCL_FFI_UINT32_T = MKCL_FFI_UNSIGNED_INT,
#if MKCL_LONG_BITS == 64
MKCL_FFI_INT64_T = MKCL_FFI_LONG,
MKCL_FFI_UINT64_T = MKCL_FFI_UNSIGNED_LONG
#else
MKCL_FFI_INT64_T = MKCL_FFI_LONG_LONG,
MKCL_FFI_UINT64_T = MKCL_FFI_UNSIGNED_LONG_LONG
#endif
};
/* enum MKCL_FFI_VOID is used as a limit marker in a number of locations, beware!
Note also that the order of enums declared in enum mkcl_ffi_tag must
carefully match the content of mkcl_foreign_type_table[] and mkcl_foreign_type_size[].
JCB
*/
/* These two fficall parameters are in bytes and should be multiples of 16. */
#define MKCL_FFICALL_ARGS_STAGING_AREA_INITIAL_SIZE 32
......@@ -243,6 +292,7 @@ extern "C" {
long double ld;
};
#if 0
enum mkcl_ffi_calling_convention {
MKCL_FFI_CC_CDECL = 0,
MKCL_FFI_CC_STDCALL
......@@ -250,12 +300,15 @@ extern "C" {
/* Note that the order of enums declared in enum mkcl_ffi_calling_convention must
carefully match the content of mkcl_foreign_cc_table[]. JCB
*/
#endif
struct mkcl_fficall {
char *buffer_sp;
size_t buffer_size;
union mkcl_ffi_values output;
#if 0
enum mkcl_ffi_calling_convention cc;
#endif
struct mkcl_fficall_reg *registers;
char * buffer;
/* mkcl_object cstring; */
......@@ -273,7 +326,24 @@ extern "C" {
extern struct mkcl_fficall_reg *mkcl_fficall_prepare_extra(MKCL, struct mkcl_fficall_reg *registers);
extern void mkcl_fficall_push_arg(MKCL, union mkcl_ffi_values *data, enum mkcl_ffi_tag type);
extern void mkcl_fficall_execute(MKCL, void *f_ptr, struct mkcl_fficall *fficall, enum mkcl_ffi_tag return_type);
extern void* mkcl_dynamic_callback_make(MKCL, mkcl_object data, enum mkcl_ffi_calling_convention cc_type);
extern mkcl_object mkcl_make_foreign(MKCL, mkcl_object C_type, mkcl_index data_size);
extern MKCL_API mkcl_object mkcl_allocate_foreign_data(MKCL, mkcl_object tag, mkcl_index size);
extern MKCL_API char * mkcl_base_string_raw_pointer(MKCL, mkcl_object f);
extern void* mkcl_dynamic_callback_make(MKCL, mkcl_object data);
#if MKCL_WINDOWS /* should be on Win32 only. JCB */
extern void* mkcl_stdcall_dynamic_callback_make(MKCL, mkcl_object data);
#endif
extern mkcl_object mkcl_foreign_ref_elt(MKCL, void *p, enum mkcl_ffi_tag type);
extern void mkcl_foreign_set_elt(MKCL, void *p, enum mkcl_ffi_tag type, mkcl_object value);
extern void * mkcl_foreign_raw_pointer(MKCL, mkcl_object f);
extern mkcl_object mkcl_null_terminated_base_string(MKCL, mkcl_object s);
static inline bool mkcl_foreignp(MKCL, mkcl_object x)
{
mkcl_type t = mkcl_type_of(x);
return (t == mkcl_t_foreign);
}
/* load.d */
......
......@@ -850,64 +850,24 @@ extern "C" {
};