sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cleanup: remove obsolete dffi code

Browse source 
ECL uses libffi for a long time and these code isn't even
compiled. ECL_DYNAMIC_FFI supported only limited number of x86 and
x86_64 bit platforms (transcended by libffi) and was basically dead. Not
sure if it would even compile even fater changing the scripts.

This changes were pretty straightforward, since the code was nicely
isolated with the appropriate ifdefs, but some testing is necessary
here.
This commit is contained in:
Daniel Kochmański 2016-03-01 12:27:03 +01:00
parent 0188c6bbe8
commit 10bd3b613f
12 changed files with 9 additions and 1105 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/c/Makefile.in
View file

@ -96,16 +96,6 @@ apply_x86.c: $(srcdir)/arch/apply_x86.d $(DPP) $(HFILES)
../CROSS-DPP $(srcdir)/arch/apply_x86.d $@ ; \
else $(DPP) $(srcdir)/arch/apply_x86.d $@ ; \
fi
ffi_x86.c: $(srcdir)/arch/ffi_x86.d $(DPP) $(HFILES)
if test -f ../CROSS-DPP ; then \
../CROSS-DPP $(srcdir)/arch/ffi_x86.d $@ ; \
else $(DPP) $(srcdir)/arch/ffi_x86.d $@ ; \
fi
ffi_x86_64.c: $(srcdir)/arch/ffi_x86_64.d $(DPP) $(HFILES)
if test -f ../CROSS-DPP ; then \
../CROSS-DPP $(srcdir)/arch/ffi_x86_64.d $@ ; \
else $(DPP) $(srcdir)/arch/ffi_x86_64.d $@ ; \
fi
../libeclmin.a: $(OBJS) all_symbols.o all_symbols2.o
$(RM) $@

215
src/c/arch/ffi_ppc32.d
View file

@ -1,215 +0,0 @@
/* -*- Mode: C; c-basic-offset: 8; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=8 shiftwidth=4 expandtab: */
/*
ffi_x86.c -- Nonportable component of the FFI
*/
/*
Copyright (c) 2005, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <string.h>
#include <ecl/internal.h>
#error "This file is a placeholder for current development"
/*
* Calling conventions for OS X under PowerPC/32bit architecture. The rules are
* as follows:
*
* - Registers GPR3-GPR10 are used to pass 32-bit arguments. This includes
* integers and composed data structures which fit in the registers.
* - Registers FPR1-FPR13 are used to pass float and double arguments.
* - For each argument passed in a register, the same amount of memory is
* reserved in the stack.
* - When the amount of registers is exhausted, the remaining arguments are
* passed in the stack.
* - There is a difference between functions whose signature is known and those
* whose is not. In the second case, when passing float/double arguments,
* they are passed redundantly using a GPR, a FPR and the stack. In the
* former case, only the FPR or the stack is used.
* - Since we do not allow functions with varargs (i.e "..." in C parlance), we
* do not care about the last case.
*
* Since we do not allow passing or receiving structures, we need not care
* about it and the only rule is:
*
* - Returns arguments <= 32 bits are stored in GPR3
* - Returns arguments <= 64 bits are shared between GPR3 and GPR4, for high
* and low bits, respectively.
* - Floating point values are returned in FPR1.
*
* This information appears in "Mac OS X ABI Function Call Guide", from Apple
* Developer's Documentation (April 2006).
*/
#define MAX_INT_REGISTERS 8
#define MAX_FP_REGISTERS 13
struct ecl_fficall_reg {
long int registers[MAX_INT_REGISTERS];
int int_registers_size;
double fp_registers[MAX_FP_REGISTERS];
int fp_registers_size;
};
struct ecl_fficall_reg *
ecl_fficall_prepare_extra(struct ecl_fficall_reg *registers)
{
if (registers == 0) {
registers = (struct ecl_fficall_reg *)cl_alloc_atomic(sizeof(*registers));
}
registers->int_registers_size = 0;
registers->fp_registers_size = 0;
}
void
ecl_fficall_push_arg(union ecl_ffi_values *data, enum ecl_ffi_tag type)
{
long i;
struct ecl_fficall *fficall = cl_env.fficall;
struct ecl_fficall_reg *registers = cl_env.fficall->registers;
switch (type) {
case ECL_FFI_CHAR: i = data->c; goto INT;
case ECL_FFI_UNSIGNED_CHAR: i = data->uc; goto INT;
case ECL_FFI_BYTE: i = data->b; goto INT;
case ECL_FFI_UNSIGNED_BYTE: i = data->ub; goto INT;
case ECL_FFI_SHORT: i = data->s; goto INT;
case ECL_FFI_UNSIGNED_SHORT: i = data->us; goto INT;
case ECL_FFI_INT: i = data->i; goto INT;
case ECL_FFI_UNSIGNED_INT: i = data->ui; goto INT;
case ECL_FFI_LONG:
case ECL_FFI_UNSIGNED_LONG:
case ECL_FFI_POINTER_VOID:
case ECL_FFI_CSTRING:
case ECL_FFI_OBJECT:
i = data->l;
INT:
if (registers->int_registers_size < MAX_INT_REGISTERS) {
registers->registers[registers->int_registers_size++] = i;
}
ecl_fficall_align(sizeof(long));
ecl_fficall_push_bytes(&i, sizeof(long));
break;
case ECL_FFI_DOUBLE:
if (registers->fp_registers_size < MAX_FP_REGISTERS) {
registers->fp_registers[registers->fp_registers_size++] = data->d;
registers->int_registers_size += 2;
}
ecl_fficall_align(sizeof(long));
ecl_fficall_push_bytes(&data->d, sizeof(double), sizeof(long));
break;
case ECL_FFI_FLOAT:
if (registers->fp_registers_size < MAX_FP_REGISTERS) {
registers->fp_registers[registers->fp_registers_size++] = data->f;
registers->int_registers_size++;
}
ecl_fficall_align(sizeof(long));
ecl_fficall_push_bytes(&data->f, sizeof(float), sizeof(long));
break;
case ECL_FFI_VOID:
FEerror("VOID is not a valid argument type for a C function", 0);
}
}
static void
ecl_fficall_do_execute(cl_index buf_size, void *stack, void *gpr, void *gpfr, void *f)
{
}
void
ecl_fficall_execute(void *_f_ptr, struct ecl_fficall *fficall, enum ecl_ffi_tag return_type)
{
struct ecl_fficall_reg *registers = fficall->registers;
long bufsize = fficall->buffer_size;
char* buf = fficall->buffer;
asm volatile (
"mr r5,%[bufsize]\n\t" /* r5 = size of stack */
"mr r6,%[buf]\n\t" /* r6 = origin of stack data */
"mr r17,%[registers]\n\t" /* r17 = origin of integer registers */
"mr r16,%[fp_registers]\n\t"/* r16 = origin of fp registers */
"mr r15,%[fptr]\n\t" /* r15 = _f_ptr */
"mr r29, r1\n\t" /* r29 saves r1 */
"subf r13,r5,r1\n\t"
"stwu r13,-80(r13)\n\t" /* r13 <- r1 - r5 - 80 */
"mflr r0\n\t"
"stw r0,8(r1)\n\t"
"mr r1,r13\n\t" /* r1 <- r13 */
"stwu r14,24(r1)\n\t" /* r14 <- begin of parameters */
"cmpwi cr0,r5,0\n\t" /* copy r5 bytes from (r6) to (r14) */
"ble cr0,L3\n\t"
"mtctr r5\n"
"LX: lbz r0,0(r6)\n\t"
"addi r6,r6,1\n\t"
"stb r0,0(r14)\n\t"
"addi r14,r14,1\n"
"L3: lfd f1, 0(r16)\n\t" /* load fp registers from (r16) */
"lfd f2, 8(r16)\n\t"
"lfd f3, 16(r16)\n\t"
"lfd f4, 24(r16)\n\t"
"lfd f5, 32(r16)\n\t"
"lfd f6, 40(r16)\n\t"
"lfd f7, 48(r16)\n\t"
"lfd f8, 56(r16)\n\t"
"lfd f9, 64(r16)\n\t"
"lfd f10, 72(r16)\n\t"
"lfd f11, 80(r16)\n\t"
"lfd f12, 88(r16)\n\t"
"lfd f13, 96(r16)\n\t"
"lwz r6, 16(r17)\n\t" /* load int registers from (r17) */
"lwz r7, 20(r17)\n\t"
"lwz r8, 24(r17)\n\t"
"lwz r9, 28(r17)\n\t"
"lwz r10, 32(r17)\n\t"
"lwz r5, 8(r17)\n\t"
"lwz r4, 4(r17)\n\t"
"lwz r3, 0(r17)\n\t"
"mtctr r15\n\t" /* call the function stored in r15 */
"bctrl \n\t"
"mr r1,r29\n\t" /* restore stack and return pointer */
"lwz r0,8(r1)\n\t"
"mtlr r0\n\t"
"stw r3,0(r17)\n\t" /* store function's output */
"stw r4,4(r17)\n\t"
"stfd f1,0(r16)\n\t"
:: [bufsize] "r" (bufsize), [buf] "r" (buf), [registers] "r" (registers->registers),
[fp_registers] "r" (registers->fp_registers), [fptr] "r" (_f_ptr)
: "r5","r6","r17","r16","r29","r13","r14");
void *data = registers->registers;
if (return_type <= ECL_FFI_UNSIGNED_LONG) {
fficall->output.i = *((unsigned long *)data);
} else if (return_type == ECL_FFI_POINTER_VOID) {
fficall->output.pv = *((void **)data);
} else if (return_type == ECL_FFI_CSTRING) {
fficall->output.pc = *((char *)data);
} else if (return_type == ECL_FFI_OBJECT) {
fficall->output.o = *((cl_object *)data);
} else if (return_type == ECL_FFI_FLOAT) {
fficall->output.f = registers->fp_registers[0];
} else if (return_type == ECL_FFI_DOUBLE) {
fficall->output.d = registers->fp_registers[0];
}
}
void*
ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_convention cc_type)
{
exit(0);
}

342
src/c/arch/ffi_x86.d
View file

@ -1,342 +0,0 @@
/* -*- Mode: C; c-basic-offset: 8; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=8 shiftwidth=4 expandtab: */
/*
ffi_x86.c -- Nonportable component of the FFI
*/
/*
Copyright (c) 2005, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <string.h>
#include <ecl/internal.h>
#if !defined(HAVE_LIBFFI)
struct ecl_fficall_reg *
ecl_fficall_prepare_extra(struct ecl_fficall_reg *registers)
{
/* No need to prepare registers */
return 0;
}
void
ecl_fficall_push_arg(union ecl_ffi_values *data, enum ecl_ffi_tag type)
{
int i;
switch (type) {
case ECL_FFI_CHAR: i = data->c; goto INT_ECL;
case ECL_FFI_UNSIGNED_CHAR: i = data->uc; goto INT_ECL;
case ECL_FFI_BYTE: i = data->b; goto INT_ECL;
case ECL_FFI_UNSIGNED_BYTE: i = data->ub; goto INT_ECL;
case ECL_FFI_SHORT: i = data->s; goto INT_ECL;
case ECL_FFI_UNSIGNED_SHORT: i = data->us; goto INT_ECL;
#ifdef ecl_uint8_t
case ECL_FFI_INT8_T: i = data->i8; goto INT_ECL;
case ECL_FFI_UINT8_T: i = data->u8; goto INT_ECL;
#endif
#ifdef ecl_uint16_t
case ECL_FFI_INT16_T: i = data->i16; goto INT_ECL;
case ECL_FFI_UINT16_T: i = data->u16; goto INT_ECL;
#endif
case ECL_FFI_INT:
case ECL_FFI_LONG:
case ECL_FFI_UNSIGNED_INT:
case ECL_FFI_UNSIGNED_LONG:
#ifdef ecl_uint32_t
case ECL_FFI_INT32_T:
case ECL_FFI_UINT32_T:
#endif
case ECL_FFI_POINTER_VOID:
case ECL_FFI_CSTRING:
case ECL_FFI_OBJECT:
i = data->i;
INT_ECL:
ecl_fficall_align(sizeof(int));
ecl_fficall_push_int(i);
break;
case ECL_FFI_DOUBLE:
ecl_fficall_align(sizeof(int));
ecl_fficall_push_bytes(&data->d, sizeof(double));
break;
case ECL_FFI_FLOAT:
ecl_fficall_align(sizeof(int));
ecl_fficall_push_bytes(&data->f, sizeof(float));
break;
#ifdef ecl_uint64_t
case ECL_FFI_UINT64_T:
case ECL_FFI_INT64_T:
ecl_fficall_align(sizeof(ecl_uint64_t));
ecl_fficall_push_bytes(&data->ull, sizeof(ecl_uint64_t));
break;
#endif
#ifdef ecl_long_long_t
case ECL_FFI_UNSIGNED_LONG_LONG:
case ECL_FFI_LONG_LONG:
ecl_fficall_align(sizeof(unsigned long));
ecl_fficall_push_bytes(&data->ull, sizeof(unsigned long long));
break;
#endif
case ECL_FFI_VOID:
FEerror("VOID is not a valid argument type for a C function", 0);
}
}
void
ecl_fficall_execute(void *f_ptr, struct ecl_fficall *fficall, enum ecl_ffi_tag return_type)
{
int bufsize = fficall->buffer_size;
char* buf = fficall->buffer;
char* stack_p;
#ifdef _MSC_VER
__asm
{
mov stack_p,esp
sub esp,bufsize
mov esi,buf
mov edi,esp
mov ecx,bufsize
rep movsb
}
#else
asm volatile (
"movl %%esp, %0\n\t"
"subl %1, %%esp\n\t"
"movl %2, %%esi\n\t"
"movl %%esp, %%edi\n\t"
"rep\n\t"
"movsb\n\t"
: "=a" (stack_p) : "c" (bufsize), "d" (buf) : "%edi", "%esi");
#endif
if (return_type <= ECL_FFI_UNSIGNED_LONG) {
fficall->output.i = ((int (*)())f_ptr)();
} else if (return_type == ECL_FFI_POINTER_VOID) {
fficall->output.pv = ((void * (*)())f_ptr)();
} else if (return_type == ECL_FFI_CSTRING) {
fficall->output.pc = ((char * (*)())f_ptr)();
} else if (return_type == ECL_FFI_OBJECT) {
fficall->output.o = ((cl_object (*)())f_ptr)();
} else if (return_type == ECL_FFI_FLOAT) {
fficall->output.f = ((float (*)())f_ptr)();
} else if (return_type == ECL_FFI_DOUBLE) {
fficall->output.d = ((double (*)())f_ptr)();
}
#ifdef ecl_uint8_t
else if (return_type == ECL_FFI_INT8_T) {
fficall->output.i8 = ((ecl_int8_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UINT16_T) {
fficall->output.u8 = ((ecl_uint8_t (*)())f_ptr)();
}
#endif
#ifdef ecl_uint16_t
else if (return_type == ECL_FFI_INT16_T) {
fficall->output.i16 = ((ecl_int16_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UINT16_T) {
fficall->output.u16 = ((ecl_uint16_t (*)())f_ptr)();
}
#endif
#ifdef ecl_uint32_t
else if (return_type == ECL_FFI_INT32_T) {
fficall->output.i32 = ((ecl_int32_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UINT32_T) {
fficall->output.u32 = ((ecl_uint32_t (*)())f_ptr)();
}
#endif
#ifdef ecl_uint64_t
else if (return_type == ECL_FFI_INT64_T) {
fficall->output.i64 = ((ecl_int64_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UINT32_T) {
fficall->output.u64 = ((ecl_uint64_t (*)())f_ptr)();
}
#endif
#ifdef ecl_long_long_t
else if (return_type == ECL_FFI_LONG_LONG) {
fficall->output.ll = ((ecl_long_long_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UNSIGNED_LONG_LONG) {
fficall->output.ull = ((ecl_ulong_long_t (*)())f_ptr)();
}
#endif
else {
((void (*)())f_ptr)();
}
#ifdef _MSC_VER
__asm mov esp,stack_p
#else
asm volatile ("mov %0,%%esp" :: "a" (stack_p));
#endif
}
static void
ecl_dynamic_callback_execute(cl_object cbk_info, char *arg_buffer)
{
cl_object fun, rtype, argtypes;
cl_object result;
cl_index i, size;
union ecl_ffi_values output;
enum ecl_ffi_tag tag;
cl_env_ptr env = ecl_process_env();
ECL_BUILD_STACK_FRAME(env, frame, aux);
fun = CAR(cbk_info);
rtype = CADR(cbk_info);
argtypes = CADDR(cbk_info);
arg_buffer += 4; /* Skip return address */
for (i=0; !ecl_endp(argtypes); argtypes = CDR(argtypes), i++) {
tag = ecl_foreign_type_code(CAR(argtypes));
size = ecl_fixnum(si_size_of_foreign_elt_type(CAR(argtypes)));
result = ecl_foreign_data_ref_elt(arg_buffer, tag);
ecl_stack_frame_push(frame,result);
{
int mask = 3;
int sp = (size + mask) & ~mask;
arg_buffer += (sp);
}
}
result = ecl_apply_from_stack_frame(frame, fun);
ecl_stack_frame_close(frame);
tag = ecl_foreign_type_code(rtype);
memset(&output, 0, sizeof(output));
ecl_foreign_data_set_elt(&output, tag, result);
switch (tag) {
case ECL_FFI_CHAR: i = output.c; goto INT_ECL;
case ECL_FFI_UNSIGNED_CHAR: i = output.uc; goto INT_ECL;
case ECL_FFI_BYTE: i = output.b; goto INT_ECL;
case ECL_FFI_UNSIGNED_BYTE: i = output.ub; goto INT_ECL;
#ifdef ecl_uint8_t
case ECL_FFI_INT8_T: i = output.i8; goto INT_ECL;
case ECL_FFI_UINT8_T: i = output.u8; goto INT_ECL;
#endif
#ifdef ecl_uint16_t
case ECL_FFI_INT16_T:
#endif
case ECL_FFI_SHORT: i = output.s; goto INT_ECL;
#ifdef ecl_uint16_t
case ECL_FFI_UINT16_T:
#endif
case ECL_FFI_UNSIGNED_SHORT: i = output.us; goto INT_ECL;
case ECL_FFI_POINTER_VOID:
case ECL_FFI_OBJECT:
case ECL_FFI_CSTRING:
case ECL_FFI_INT:
case ECL_FFI_UNSIGNED_INT:
#ifdef ecl_uint32_t
case ECL_FFI_INT32_T:
case ECL_FFI_UINT32_T:
#endif
case ECL_FFI_LONG:
case ECL_FFI_UNSIGNED_LONG:
i = output.i;
INT_ECL:
#ifdef _MSC_VER
__asm mov eax,i
#else
{
register int eax asm("eax");
eax = i;
}
#endif
return;
#if defined(ecl_long_long_t) || defined(ecl_uint64_t)
# ifdef ecl_long_long_t
case ECL_FFI_LONG_LONG:
case ECL_FFI_UNSIGNED_LONG_LONG:
# endif
# ifdef ecl_uint64_t
case ECL_FFI_INT64_T:
case ECL_FFI_UINT64_T:
# endif
# ifdef _MSC_VER
__asm mov eax,output.l2[0]
__asm mov edx,output.l2[1]
# else
{
register int eax asm("eax");
register int edx asm("edx");
eax = output.l2[0];
edx = output.l2[1];
}
# endif
return;
#endif /* ecl_long_long_t */
case ECL_FFI_DOUBLE: {
#ifdef _MSC_VER
__asm fld output.d
#else
{
asm("fldl (%0)" :: "a" (&output.d));
}
#endif
return;
}
case ECL_FFI_FLOAT: {
#ifdef _MSC_VER
__asm fld output.f
#else
{
asm("flds (%0)" :: "a" (&output.f));
}
#endif
return;
}
case ECL_FFI_VOID:
return;
}
}
void*
ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_convention cc_type)
{
/*
* push %esp 54
* pushl <data> 68 <addr32>
* call ecl_dynamic_callback_call E8 <disp32>
* [ Here we could use also lea 4(%esp), %esp, but %ecx seems to be free ]
* pop %ecx 59
* pop %ecx 59
* ret c3
* nop 90
* nop 90
*/
char *buf = (char*)ecl_alloc_atomic_align(sizeof(char)*16, 4);
*(char*) (buf+0) = 0x54;
*(char*) (buf+1) = 0x68;
*(long*) (buf+2) = (long)data;
*(unsigned char*) (buf+6) = 0xE8;
*(long*) (buf+7) = (long)ecl_dynamic_callback_execute - (long)(buf+11);
*(char*) (buf+11) = 0x59;
*(char*) (buf+12) = 0x59;
if (cc_type == ECL_FFI_CC_CDECL) {
*(unsigned char*) (buf+13) = 0xc3;
*(unsigned short*)(buf+14) = 0x9090;
} else {
cl_object arg_types = CADDR(data);
int byte_size = 0;
int mask = 3;
while (CONSP(arg_types)) {
int sz = ecl_fixnum(si_size_of_foreign_elt_type(CAR(arg_types)));
byte_size += ((sz+mask)&(~mask));
arg_types = CDR(arg_types);
}
*(unsigned char*) (buf+13) = 0xc2;
*(unsigned short*)(buf+14) = (unsigned short)byte_size;
}
return buf;
}
#endif

370
src/c/arch/ffi_x86_64.d
View file

@ -1,370 +0,0 @@
/* -*- Mode: C; c-basic-offset: 8; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=8 shiftwidth=4 expandtab: */
/*
ffi_x86.c -- Nonportable component of the FFI
*/
/*
Copyright (c) 2005, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <string.h>
#include <ecl/internal.h>
#if !defined(HAVE_LIBFFI)
#define MAX_INT_REGISTERS 6
#define MAX_FP_REGISTERS 8
struct ecl_fficall_reg {
long int_registers[MAX_INT_REGISTERS];
int int_registers_size;
double fp_registers[MAX_FP_REGISTERS];
int fp_registers_size;
};
struct ecl_fficall_reg *
ecl_fficall_prepare_extra(struct ecl_fficall_reg *registers)
{
if (registers == 0) {
registers = ecl_alloc_atomic_align(sizeof(*registers), sizeof(long));
}
registers->int_registers_size = 0;
registers->fp_registers_size = 0;
return registers;
}
void
ecl_fficall_push_arg(union ecl_ffi_values *data, enum ecl_ffi_tag type)
{
long i;
struct ecl_fficall *fficall = cl_env.fficall;
struct ecl_fficall_reg *registers = fficall->registers;
switch (type) {
case ECL_FFI_CHAR: i = data->c; goto INT;
case ECL_FFI_UNSIGNED_CHAR: i = data->uc; goto INT;
#ifdef ecl_uint8_t
case ECL_FFI_INT8_T: i = data->i8; goto INT;
case ECL_FFI_UINT8_T: i = data->u8; goto INT;
#endif
case ECL_FFI_BYTE: i = data->b; goto INT;
case ECL_FFI_UNSIGNED_BYTE: i = data->ub; goto INT;
#ifdef ecl_uint16_t
case ECL_FFI_INT16_T: i = data->i16; goto INT;
case ECL_FFI_UINT16_T: i = data->u16; goto INT;
#endif
case ECL_FFI_SHORT: i = data->s; goto INT;
case ECL_FFI_UNSIGNED_SHORT: i = data->us; goto INT;
#ifdef ecl_uint32_t
case ECL_FFI_INT32_T: i = data->i32; goto INT;
case ECL_FFI_UINT32_T: i = data->u32; goto INT;
#endif
case ECL_FFI_INT: i = data->i; goto INT;
case ECL_FFI_UNSIGNED_INT: i = data->ui; goto INT;
case ECL_FFI_LONG:
case ECL_FFI_UNSIGNED_LONG:
#ifdef ecl_uint64_t
case ECL_FFI_INT64_T:
case ECL_FFI_UINT64_T:
#endif
case ECL_FFI_POINTER_VOID:
case ECL_FFI_CSTRING:
case ECL_FFI_OBJECT:
i = data->l;
INT:
if (registers->int_registers_size < MAX_INT_REGISTERS) {
registers->int_registers[registers->int_registers_size++] = i;
} else {
ecl_fficall_align(sizeof(long));
ecl_fficall_push_bytes(&i, sizeof(long));
}
break;
case ECL_FFI_DOUBLE:
if (registers->fp_registers_size < MAX_FP_REGISTERS) {
registers->fp_registers[registers->fp_registers_size++] = data->d;
} else {
ecl_fficall_align(sizeof(long));
ecl_fficall_push_bytes(&data->d, sizeof(double));
}
break;
case ECL_FFI_FLOAT:
if (registers->fp_registers_size < MAX_FP_REGISTERS) {
memset(&registers->fp_registers[registers->fp_registers_size], 0, sizeof(double));
(*(float*)(&registers->fp_registers[registers->fp_registers_size++])) = (float)data->f;
} else {
i = 0;
ecl_fficall_align(sizeof(long));
ecl_fficall_push_bytes(&data->f, sizeof(float));
ecl_fficall_push_bytes(&i, sizeof(float));
}
break;
case ECL_FFI_VOID:
FEerror("VOID is not a valid argument type for a C function", 0);
}
}
void
ecl_fficall_execute(void *_f_ptr, struct ecl_fficall *fficall, enum ecl_ffi_tag return_type)
{
struct ecl_fficall_reg *registers = fficall->registers;
long bufsize = fficall->buffer_size;
char* buf = fficall->buffer;
char* stack_p;
register void* f_ptr asm("r10");
ecl_fficall_align(16);
bufsize = fficall->buffer_size;
f_ptr = _f_ptr;
asm volatile (
"mov %%rsp, %0\n\t"
"sub %1, %%rsp\n\t"
"mov %2, %%rsi\n\t"
"mov %%rsp, %%rdi\n\t"
"rep\n\t"
"movsb\n\t"
: "=a" (stack_p) : "c" (bufsize), "d" (buf) : "%rdi", "%rsi");
asm volatile (
"mov (%%rax), %%rdi\n\t"
"mov 0x08(%%rax), %%rsi\n\t"
"mov 0x10(%%rax), %%rdx\n\t"
"mov 0x18(%%rax), %%rcx\n\t"
"mov 0x20(%%rax), %%r8\n\t"
"mov 0x28(%%rax), %%r9\n\t"
:: "a" (registers->int_registers));
asm volatile (
"movsd (%%rax), %%xmm0\n\t"
"movsd 0x08(%%rax), %%xmm1\n\t"
"movsd 0x10(%%rax), %%xmm2\n\t"
"movsd 0x18(%%rax), %%xmm3\n\t"
"movsd 0x20(%%rax), %%xmm4\n\t"
"movsd 0x28(%%rax), %%xmm5\n\t"
"movsd 0x30(%%rax), %%xmm6\n\t"
"movsd 0x38(%%rax), %%xmm7\n\t"
:: "a" (registers->fp_registers));
if (return_type <= ECL_FFI_UNSIGNED_LONG) {
fficall->output.ul = ((unsigned long (*)())f_ptr)();
} else if (return_type == ECL_FFI_POINTER_VOID) {
fficall->output.pv = ((void * (*)())f_ptr)();
} else if (return_type == ECL_FFI_CSTRING) {
fficall->output.pc = ((char * (*)())f_ptr)();
} else if (return_type == ECL_FFI_OBJECT) {
fficall->output.o = ((cl_object (*)())f_ptr)();
} else if (return_type == ECL_FFI_FLOAT) {
fficall->output.f = ((float (*)())f_ptr)();
} else if (return_type == ECL_FFI_DOUBLE) {
fficall->output.d = ((double (*)())f_ptr)();
}
#ifdef ecl_uint8_t
else if (return_type == ECL_FFI_INT8_T) {
fficall->output.i8 = ((ecl_int8_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UINT16_T) {
fficall->output.u8 = ((ecl_uint8_t (*)())f_ptr)();
}
#endif
#ifdef ecl_uint16_t
else if (return_type == ECL_FFI_INT16_T) {
fficall->output.i16 = ((ecl_int16_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UINT16_T) {
fficall->output.u16 = ((ecl_uint16_t (*)())f_ptr)();
}
#endif
#ifdef ecl_uint32_t
else if (return_type == ECL_FFI_INT32_T) {
fficall->output.i32 = ((ecl_int32_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UINT32_T) {
fficall->output.u32 = ((ecl_uint32_t (*)())f_ptr)();
}
#endif
#ifdef ecl_uint64_t
else if (return_type == ECL_FFI_INT64_T) {
fficall->output.i64 = ((ecl_int64_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UINT32_T) {
fficall->output.u64 = ((ecl_uint64_t (*)())f_ptr)();
}
#endif
#ifdef ecl_long_long_t
else if (return_type == ECL_FFI_LONG_LONG) {
fficall->output.ll = ((ecl_long_long_t (*)())f_ptr)();
} else if (return_type == ECL_FFI_UNSIGNED_LONG_LONG) {
fficall->output.ull = ((ecl_ulong_long_t (*)())f_ptr)();
}
#endif
else {
((void (*)())f_ptr)();
}
asm volatile ("mov %0,%%rsp" :: "a" (stack_p));
}
static void
ecl_dynamic_callback_execute(long i1, long i2, long i3, long i4, long i5, long i6,
double f1, double f2, double f3, double f4,
double f5, double f6, double f7, double f8,
cl_object cbk_info, char *arg_buffer)
{
cl_object fun, rtype, argtypes;
cl_object result;
cl_index i, size, i_reg_index, f_reg_index;
union ecl_ffi_values output;
enum ecl_ffi_tag tag;
long i_reg[MAX_INT_REGISTERS];
double f_reg[MAX_FP_REGISTERS];
cl_env_ptr env = ecl_process_env();
ECL_BUILD_STACK_FRAME(env, frame, aux);
fun = CAR(cbk_info);
rtype = CADR(cbk_info);
argtypes = CADDR(cbk_info);
i_reg_index = f_reg_index = 0;
i_reg[0] = i1;
i_reg[1] = i2;
i_reg[2] = i3;
i_reg[3] = i4;
i_reg[4] = i5;
i_reg[5] = i6;
f_reg[0] = f1;
f_reg[1] = f2;
f_reg[2] = f3;
f_reg[3] = f4;
f_reg[4] = f5;
f_reg[5] = f6;
f_reg[6] = f7;
f_reg[7] = f8;
arg_buffer += 2*sizeof(void*); /* Skip return address and base pointer */
for (i=0; !ecl_endp(argtypes); argtypes = CDR(argtypes), i++) {
tag = ecl_foreign_type_code(CAR(argtypes));
size = ecl_fixnum(si_size_of_foreign_elt_type(CAR(argtypes)));
if (tag <= ECL_FFI_OBJECT) {
if (i_reg_index < MAX_INT_REGISTERS)
result = ecl_foreign_data_ref_elt(&i_reg[i_reg_index++], tag);
else
goto ARG_FROM_STACK;
} else if (tag <= ECL_FFI_DOUBLE) {
if (f_reg_index < MAX_FP_REGISTERS)
result = ecl_foreign_data_ref_elt(&f_reg[f_reg_index++], tag);
else
goto ARG_FROM_STACK;
} else {
ARG_FROM_STACK:
result = ecl_foreign_data_ref_elt(arg_buffer, tag);
{
int mask = 7;
int sp = (size + mask) & ~mask;
arg_buffer += (sp);
}
}
ecl_stack_frame_push(frame, result);
}
result = ecl_apply_from_stack_frame(frame, fun);
ecl_stack_frame_close(frame);
tag = ecl_foreign_type_code(rtype);
memset(&output, 0, sizeof(output));
ecl_foreign_data_set_elt(&output, tag, result);
switch (tag) {
case ECL_FFI_CHAR: i = output.c; goto INT;
case ECL_FFI_UNSIGNED_CHAR: i = output.uc; goto INT;
case ECL_FFI_BYTE: i = output.b; goto INT;
case ECL_FFI_UNSIGNED_BYTE: i = output.ub; goto INT;
#ifdef ecl_uint8_t
case ECL_FFI_INT8_T: i = output.i8; goto INT;
case ECL_FFI_UINT8_T: i = output.u8; goto INT;
#endif
#ifdef ecl_uint16_t
case ECL_FFI_INT16_T: i = output.i16; goto INT;
case ECL_FFI_UINT16_T: i = output.u16; goto INT;
#endif
case ECL_FFI_SHORT: i = output.s; goto INT;
case ECL_FFI_UNSIGNED_SHORT: i = output.us; goto INT;
#ifdef ecl_uint32_t
case ECL_FFI_INT32_T: i = output.i32; goto INT;
case ECL_FFI_UINT32_T: i = output.u32; goto INT;
#endif
case ECL_FFI_POINTER_VOID:
case ECL_FFI_OBJECT:
case ECL_FFI_CSTRING:
case ECL_FFI_INT:
case ECL_FFI_UNSIGNED_INT:
case ECL_FFI_LONG:
case ECL_FFI_UNSIGNED_LONG:
#ifdef ecl_uint64_t
case ECL_FFI_INT64_T:
case ECL_FFI_UINT64_T:
#endif
i = output.i;
INT:
{
register long eax asm("rax");
eax = i;
}
return;
case ECL_FFI_DOUBLE: {
{
asm("movsd (%0),%%xmm0" :: "a" (&output.d));
}
return;
}
case ECL_FFI_FLOAT: {
{
asm("movss (%0),%%xmm0" :: "a" (&output.f));
}
return;
}
case ECL_FFI_VOID:
return;
}
}
void*
ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_convention cc_type)
{
/*
* push %rbp 55
* push %rsp 54
* mov <addr64>,%rax 48 b8 <addr64>
* push %rax 50
* mov <addr64>,%rax 48 b8 <addr64>
* callq *%rax 48 ff d0
* pop %rcx 59
* pop %rcx 59
* pop %rbp 5d
* ret c3
* nop 90
* nop 90
*/
char *buf = (char*)ecl_alloc_atomic_align(sizeof(char)*32, 8);
*(char*) (buf+0) = 0x55;
*(char*) (buf+1) = 0x54;
*(short*)(buf+2) = 0xb848;
*(long*) (buf+4) = (long)data;
*(char*) (buf+12) = 0x50;
*(short*)(buf+13) = 0xb848;
*(long*) (buf+15) = (long)ecl_dynamic_callback_execute;
*(int*) (buf+23) = (int)0x00d0ff48; /* leading null byte is overwritten */
*(char*) (buf+26) = 0x59;
*(char*) (buf+27) = 0x59;
*(char*) (buf+28) = 0x5d;
*(char*) (buf+29) = 0xc3;
*(short*)(buf+30) = 0x9090;
return buf;
}
#endif

2
src/c/ecl_features.h
View file

@ -74,7 +74,7 @@ ecl_def_string_array(feature_names,static,const) = {
#ifdef ECL_CLOS_STREAMS
ecl_def_string_array_elt("CLOS-STREAMS"),
#endif
#if defined(ECL_DYNAMIC_FFI) || defined(HAVE_LIBFFI)
#if defined(HAVE_LIBFFI)
ecl_def_string_array_elt("DFFI"),
#endif
#ifdef ECL_UNICODE

123
src/c/ffi.d
View file

@ -125,13 +125,6 @@ ecl_foreign_type_table[] = {
{@':void', 0, 0}
};
#ifdef ECL_DYNAMIC_FFI
static const cl_object ecl_foreign_cc_table[] = {
@':cdecl',
@':stdcall'
};
#endif
#ifdef HAVE_LIBFFI
static struct {
const cl_object symbol;
@ -433,20 +426,6 @@ ecl_foreign_cc_code(cl_object cc)
}
#endif
#ifdef ECL_DYNAMIC_FFI
enum ecl_ffi_calling_convention
ecl_foreign_cc_code(cl_object cc)
{
int i;
for (i = 0; i <= ECL_FFI_CC_STDCALL; i++) {
if (cc == ecl_foreign_cc_table[i])
return (enum ecl_ffi_calling_convention)i;
}
FEerror("~A does no denote a valid calling convention.", 1, cc);
return ECL_FFI_CC_CDECL;
}
#endif
static void wrong_ffi_tag(enum ecl_ffi_tag tag) ecl_attr_noreturn;
static void
@ -784,108 +763,6 @@ OUTPUT:
#endif
}
#ifdef ECL_DYNAMIC_FFI
static void
ecl_fficall_overflow()
{
FEerror("Stack overflow on SI:CALL-CFUN", 0);
}
void
ecl_fficall_prepare(cl_object return_type, cl_object arg_type, cl_object cc_type)
{
struct ecl_fficall *fficall = cl_env.fficall;
fficall->buffer_sp = fficall->buffer;
fficall->buffer_size = 0;
fficall->cstring = ECL_NIL;
fficall->cc = ecl_foreign_cc_code(cc_type);
fficall->registers = ecl_fficall_prepare_extra(fficall->registers);
}
void
ecl_fficall_push_bytes(void *data, size_t bytes)
{
struct ecl_fficall *fficall = cl_env.fficall;
fficall->buffer_size += bytes;
if (fficall->buffer_size >= ECL_FFICALL_LIMIT)
ecl_fficall_overflow();
memcpy(fficall->buffer_sp, (char*)data, bytes);
fficall->buffer_sp += bytes;
}
void
ecl_fficall_push_int(int data)
{
ecl_fficall_push_bytes(&data, sizeof(int));
}
void
ecl_fficall_align(int data)
{
struct ecl_fficall *fficall = cl_env.fficall;
if (data == 1)
return;
else {
size_t sp = fficall->buffer_sp - fficall->buffer;
size_t mask = data - 1;
size_t new_sp = (sp + mask) & ~mask;
if (new_sp >= ECL_FFICALL_LIMIT)
ecl_fficall_overflow();
fficall->buffer_sp = fficall->buffer + new_sp;
fficall->buffer_size = new_sp;
}
}
@(defun si::call-cfun (fun return_type arg_types args &optional (cc_type @':cdecl'))
struct ecl_fficall *fficall = cl_env.fficall;
void *cfun = ecl_foreign_data_pointer_safe(fun);
cl_object object;
enum ecl_ffi_tag return_type_tag = ecl_foreign_type_code(return_type);
@
ecl_fficall_prepare(return_type, arg_types, cc_type);
while (CONSP(arg_types)) {
enum ecl_ffi_tag type;
if (!CONSP(args)) {
FEerror("In SI:CALL-CFUN, mismatch between argument types and argument list: ~A vs ~A", 0);
}
type = ecl_foreign_type_code(CAR(arg_types));
if (type == ECL_FFI_CSTRING) {
object = ecl_null_terminated_base_string(CAR(args));
if (CAR(args) != object)
fficall->cstring =
CONS(object, fficall->cstring);
} else {
object = CAR(args);
}
ecl_foreign_data_set_elt(&fficall->output, type, object);
ecl_fficall_push_arg(&fficall->output, type);
arg_types = CDR(arg_types);
args = CDR(args);
}
ecl_fficall_execute(cfun, fficall, return_type_tag);
object = ecl_foreign_data_ref_elt(&fficall->output, return_type_tag);
fficall->buffer_size = 0;
fficall->buffer_sp = fficall->buffer;
fficall->cstring = ECL_NIL;
@(return object)
@)
@(defun si::make-dynamic-callback (fun sym rtype argtypes &optional (cctype @':cdecl'))
cl_object data;
cl_object cbk;
@
data = cl_list(3, fun, rtype, argtypes);
cbk = ecl_make_foreign_data(@':pointer-void', 0, ecl_dynamic_callback_make(data, ecl_foreign_cc_code(cctype)));
si_put_sysprop(sym, @':callback', CONS(cbk, data));
@(return cbk)
@)
#endif /* ECL_DYNAMIC_FFI */
#ifdef HAVE_LIBFFI
static void
resize_call_stack(cl_env_ptr env, cl_index new_size)

4
src/c/main.d
View file

@ -164,10 +164,6 @@ ecl_init_env(cl_env_ptr env)
env->ffi_values = 0;
env->ffi_values_ptrs = 0;
#endif
#ifdef ECL_DYNAMIC_FFI
env->fficall = ecl_alloc(sizeof(struct ecl_fficall));
((struct ecl_fficall*)env->fficall)->registers = 0;
#endif
env->method_cache = ecl_make_cache(64, 4096);
env->slot_cache = ecl_make_cache(3, 4096);

13
src/c/symbols_list.h
View file

@ -71,16 +71,11 @@ typedef struct {
#else
# define IF_SSE2(x) NULL
#endif
#if defined(HAVE_LIBFFI) || defined(ECL_DYNAMIC_FFI)
#if defined(HAVE_LIBFFI)
# define IF_DFFI(x) x
#else
# define IF_DFFI(x) NULL
#endif
#if defined(HAVE_LIBFFI)
# define IF_LIBFFI(x) x
#else
# define IF_LIBFFI(x) NULL
#endif
cl_symbol_initializer
cl_symbols[] = {
@ -1749,12 +1744,12 @@ cl_symbols[] = {
{SYS_ "*CODE-WALKER*", SI_SPECIAL, NULL, -1, OBJNULL},
/* #if defined(HAVE_LIBFFI) || defined(ECL_DYNAMIC_FFI) */
/* #if defined(HAVE_LIBFFI) */
{SYS_ "CALL-CFUN", SI_ORDINARY, IF_DFFI(si_call_cfun), -1, OBJNULL},
{KEY_ "CALLBACK", KEYWORD, NULL, -1, OBJNULL},
{SYS_ "MAKE-DYNAMIC-CALLBACK", SI_ORDINARY, IF_DFFI(si_make_dynamic_callback), -1, OBJNULL},
{SYS_ "FREE-FFI-CLOSURE", SI_ORDINARY, IF_LIBFFI(si_free_ffi_closure), 1, OBJNULL},
/* #endif defined(HAVE_LIBFFI) || defined(ECL_DYNAMIC_FFI) */
{SYS_ "FREE-FFI-CLOSURE", SI_ORDINARY, IF_DFFI(si_free_ffi_closure), 1, OBJNULL},
/* #endif defined(HAVE_LIBFFI) */
{KEY_ "CDECL", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "STDCALL", KEYWORD, NULL, -1, OBJNULL},

13
src/c/symbols_list2.h
View file

@ -71,16 +71,11 @@ typedef struct {
#else
# define IF_SSE2(x) NULL
#endif
#if defined(HAVE_LIBFFI) || defined(ECL_DYNAMIC_FFI)
#if defined(HAVE_LIBFFI)
# define IF_DFFI(x) x
#else
# define IF_DFFI(x) NULL
#endif
#if defined(HAVE_LIBFFI)
# define IF_LIBFFI(x) x
#else
# define IF_LIBFFI(x) NULL
#endif
cl_symbol_initializer
cl_symbols[] = {
@ -1749,12 +1744,12 @@ cl_symbols[] = {
{SYS_ "*CODE-WALKER*",NULL},
/* #if defined(HAVE_LIBFFI) || defined(ECL_DYNAMIC_FFI) */
/* #if defined(HAVE_LIBFFI) */
{SYS_ "CALL-CFUN",IF_DFFI("si_call_cfun")},
{KEY_ "CALLBACK",NULL},
{SYS_ "MAKE-DYNAMIC-CALLBACK",IF_DFFI("si_make_dynamic_callback")},
{SYS_ "FREE-FFI-CLOSURE",IF_LIBFFI("si_free_ffi_closure")},
/* #endif defined(HAVE_LIBFFI) || defined(ECL_DYNAMIC_FFI) */
{SYS_ "FREE-FFI-CLOSURE",IF_DFFI("si_free_ffi_closure")},
/* #endif defined(HAVE_LIBFFI) */
{KEY_ "CDECL",NULL},
{KEY_ "STDCALL",NULL},

6
src/h/config.h.in
View file

@ -115,12 +115,6 @@
/* We have libffi and can use it */
#undef HAVE_LIBFFI
/* We have non-portable implementation of FFI calls */
/* Only used as a last resort, when libffi is missin */
#ifndef HAVE_LIBFFI
#undef ECL_DYNAMIC_FFI
#endif
/* We use hierarchical package names, like in Allegro CL */
#undef ECL_RELATIVE_PACKAGE_NAMES

3
src/h/external.h
View file

@ -121,9 +121,6 @@ struct cl_env_struct {
union ecl_ffi_values *ffi_values;
union ecl_ffi_values **ffi_values_ptrs;
#endif
#ifdef ECL_DYNAMIC_FFI
void *fficall;
#endif
/* Alternative stack for processing signals */
void *altstack;

13
src/h/internal.h
View file

@ -244,19 +244,6 @@ struct ecl_fficall {
};
extern enum ecl_ffi_tag ecl_foreign_type_code(cl_object type);
#ifdef ECL_DYNAMIC_FFI
extern enum ecl_ffi_calling_convention ecl_foreign_cc_code(cl_object cc_type);
extern void ecl_fficall_prepare(cl_object return_type, cl_object arg_types, cl_object cc_type);
extern void ecl_fficall_push_bytes(void *data, size_t bytes);
extern void ecl_fficall_push_int(int word);
extern void ecl_fficall_align(int data);
extern struct ecl_fficall_reg *ecl_fficall_prepare_extra(struct ecl_fficall_reg *registers);
extern void ecl_fficall_push_arg(union ecl_ffi_values *data, enum ecl_ffi_tag type);
extern void ecl_fficall_execute(void *f_ptr, struct ecl_fficall *fficall, enum ecl_ffi_tag return_type);
extern void ecl_dynamic_callback_call(cl_object callback_info, char* buffer);
extern void* ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_convention cc_type);
#endif
/* file.d */