mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-14 21:32:49 -08:00
Added support for long long and unsigned long, and [u]intN_t in the FFI.
This commit is contained in:
Juan Jose Garcia Ripoll
parent
fb7ef0c3b4
commit
e282487f0d
11 changed files with 524 additions and 33 deletions
41
src/aclocal.m4
vendored
41
src/aclocal.m4
vendored
|
|
@ -4,18 +4,37 @@ dnl --------------------------------------------------------------
|
|||
dnl http://autoconf-archive.cryp.to/ac_c_long_long_.html
|
||||
dnl Provides a test for the existance of the long long int type and defines HAVE_LONG_LONG if it is found.
|
||||
AC_DEFUN([AC_C_LONG_LONG],
|
||||
[AC_CACHE_CHECK(for long long int, ac_cv_c_long_long,
|
||||
[if test "$GCC" = yes; then
|
||||
[AC_MSG_CHECKING(size of long long)
|
||||
if test "$GCC" = yes; then
|
||||
ac_cv_c_long_long=yes
|
||||
else
|
||||
AC_TRY_COMPILE(,[long long int i;],
|
||||
ac_cv_c_long_long=yes,
|
||||
ac_cv_c_long_long=no)
|
||||
fi])
|
||||
if test $ac_cv_c_long_long = yes; then
|
||||
AC_DEFINE(ecl_long_long_t, long long, [compiler understands long long])
|
||||
AC_DEFINE(ecl_ulong_long_t, unsigned long long, [compiler understands long long])
|
||||
fi
|
||||
else
|
||||
AC_TRY_COMPILE(,[long long int i;],
|
||||
ac_cv_c_long_long=yes,
|
||||
ac_cv_c_long_long=no)
|
||||
fi
|
||||
if test $ac_cv_c_long_long = yes; then
|
||||
AC_RUN_IFELSE([AC_LANG_SOURCE([[#include <stdio.h>
|
||||
int main() {
|
||||
const char *int_type;
|
||||
int bits;
|
||||
unsigned long long x = 1;
|
||||
FILE *f=fopen("conftestval", "w");
|
||||
if (!f) exit(1);
|
||||
for (bits = 0; x; bits++) {
|
||||
x <<= 1;
|
||||
}
|
||||
fprintf(f,"ECL_LONG_LONG_BITS='%d'",bits);
|
||||
exit(0);
|
||||
}]])],[eval "`cat conftestval`"],[],[])
|
||||
fi
|
||||
if test -z "$ECL_LONG_LONG_BITS"; then
|
||||
AC_MSG_RESULT(not available)
|
||||
else
|
||||
AC_MSG_RESULT([$ECL_LONG_LONG_BITS])
|
||||
AC_DEFINE(ecl_long_long_t, long long, [compiler understands long long])
|
||||
AC_DEFINE(ecl_ulong_long_t, unsigned long long, [compiler understands long long])
|
||||
AC_DEFINE_UNQUOTED([ECL_LONG_LONG_BITS],[$ECL_LONG_LONG_BITS])
|
||||
fi
|
||||
])
|
||||
|
||||
dnl --------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -35,10 +35,18 @@ ecl_fficall_push_arg(union ecl_ffi_values *data, enum ecl_ffi_tag type)
|
|||
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;
|
||||
#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_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:
|
||||
|
|
@ -55,6 +63,20 @@ ecl_fficall_push_arg(union ecl_ffi_values *data, enum ecl_ffi_tag type)
|
|||
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);
|
||||
}
|
||||
|
|
@ -98,7 +120,36 @@ ecl_fficall_execute(void *f_ptr, struct ecl_fficall *fficall, enum ecl_ffi_tag r
|
|||
fficall->output.f = ((float (*)())f_ptr)();
|
||||
} else if (return_type == ECL_FFI_DOUBLE) {
|
||||
fficall->output.d = ((double (*)())f_ptr)();
|
||||
} else {
|
||||
}
|
||||
#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
|
||||
|
|
@ -149,13 +200,23 @@ ecl_dynamic_callback_execute(cl_object cbk_info, char *arg_buffer)
|
|||
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_uint32_t
|
||||
case ECL_FFI_INT16_T:
|
||||
#endif
|
||||
case ECL_FFI_SHORT: i = output.s; goto INT;
|
||||
#ifdef ecl_uint32_t
|
||||
case ECL_FFI_UINT16_T:
|
||||
#endif
|
||||
case ECL_FFI_UNSIGNED_SHORT: i = output.us; goto INT;
|
||||
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;
|
||||
|
|
@ -169,6 +230,28 @@ INT:
|
|||
}
|
||||
#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
|
||||
|
|
|
|||
|
|
@ -49,12 +49,24 @@ ecl_fficall_push_arg(union ecl_ffi_values *data, enum ecl_ffi_tag type)
|
|||
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;
|
||||
#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:
|
||||
|
|
@ -145,7 +157,36 @@ ecl_fficall_execute(void *_f_ptr, struct ecl_fficall *fficall, enum ecl_ffi_tag
|
|||
fficall->output.f = ((float (*)())f_ptr)();
|
||||
} else if (return_type == ECL_FFI_DOUBLE) {
|
||||
fficall->output.d = ((double (*)())f_ptr)();
|
||||
} else {
|
||||
}
|
||||
#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)();
|
||||
}
|
||||
|
||||
|
|
@ -227,8 +268,16 @@ ARG_FROM_STACK:
|
|||
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_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:
|
||||
|
|
@ -236,6 +285,10 @@ ARG_FROM_STACK:
|
|||
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:
|
||||
{
|
||||
|
|
|
|||
86
src/c/ffi.d
86
src/c/ffi.d
|
|
@ -28,12 +28,29 @@ static const cl_object ecl_foreign_type_table[] = {
|
|||
@':unsigned-int',
|
||||
@':long',
|
||||
@':unsigned-long',
|
||||
#ifdef ecl_uint16_t
|
||||
@':int16-t',
|
||||
@':uint16-t',
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
@':int64-t',
|
||||
@':uint64-t',
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
@':int64-t',
|
||||
@':uint64-t',
|
||||
#endif
|
||||
#ifdef ecl_long_long_t
|
||||
@':long-long',
|
||||
@':unsigned-long-long',
|
||||
#endif
|
||||
@':pointer-void',
|
||||
@':cstring',
|
||||
@':object',
|
||||
@':float',
|
||||
@':double',
|
||||
@':void'};
|
||||
@':void'
|
||||
};
|
||||
|
||||
static const cl_object ecl_foreign_cc_table[] = {
|
||||
@':cdecl',
|
||||
|
|
@ -51,12 +68,29 @@ static unsigned int ecl_foreign_type_size[] = {
|
|||
sizeof(unsigned int),
|
||||
sizeof(long),
|
||||
sizeof(unsigned long),
|
||||
#ifdef ecl_uint16_t
|
||||
sizeof(ecl_int16_t),
|
||||
sizeof(ecl_uint16_t),
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
sizeof(ecl_int32_t),
|
||||
sizeof(ecl_uint32_t),
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
sizeof(ecl_int64_t),
|
||||
sizeof(ecl_uint64_t),
|
||||
#endif
|
||||
#ifdef ecl_long_long_t
|
||||
sizeof(long long),
|
||||
sizeof(unsigned long long),
|
||||
#endif
|
||||
sizeof(void *),
|
||||
sizeof(char *),
|
||||
sizeof(cl_object),
|
||||
sizeof(float),
|
||||
sizeof(double),
|
||||
0};
|
||||
0
|
||||
};
|
||||
|
||||
cl_object
|
||||
ecl_make_foreign_data(cl_object tag, cl_index size, void *data)
|
||||
|
|
@ -284,6 +318,30 @@ ecl_foreign_data_ref_elt(void *p, enum ecl_ffi_tag tag)
|
|||
return ecl_make_unsigned_integer(*(unsigned int *)p);
|
||||
case ECL_FFI_LONG:
|
||||
return ecl_make_integer(*(long *)p);
|
||||
#ifdef ecl_uint16_t
|
||||
case ECL_FFI_INT16_T:
|
||||
return ecl_make_int16_t(*(ecl_int16_t *)p);
|
||||
case ECL_FFI_UINT16_T:
|
||||
return ecl_make_uint16_t(*(ecl_uint16_t *)p);
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
case ECL_FFI_INT32_T:
|
||||
return ecl_make_int32_t(*(ecl_int32_t *)p);
|
||||
case ECL_FFI_UINT32_T:
|
||||
return ecl_make_uint32_t(*(ecl_uint32_t *)p);
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
case ECL_FFI_INT64_T:
|
||||
return ecl_make_int64_t(*(ecl_int64_t *)p);
|
||||
case ECL_FFI_UINT64_T:
|
||||
return ecl_make_uint64_t(*(ecl_uint64_t *)p);
|
||||
#endif
|
||||
#ifdef ecl_long_long_t
|
||||
case ECL_FFI_LONG_LONG:
|
||||
return ecl_make_long_long(*(ecl_long_long_t *)p);
|
||||
case ECL_FFI_UNSIGNED_LONG_LONG:
|
||||
return ecl_make_unsigned_long_long(*(ecl_ulong_long_t *)p);
|
||||
#endif
|
||||
case ECL_FFI_UNSIGNED_LONG:
|
||||
return ecl_make_unsigned_integer(*(unsigned long *)p);
|
||||
case ECL_FFI_POINTER_VOID:
|
||||
|
|
@ -335,6 +393,30 @@ ecl_foreign_data_set_elt(void *p, enum ecl_ffi_tag tag, cl_object value)
|
|||
case ECL_FFI_UNSIGNED_LONG:
|
||||
*(unsigned long *)p = fixnnint(value);
|
||||
break;
|
||||
#ifdef ecl_uint16_t
|
||||
case ECL_FFI_INT16_T:
|
||||
*(ecl_int16_t *)p = ecl_to_int16_t(value);
|
||||
case ECL_FFI_UINT16_T:
|
||||
*(ecl_uint16_t *)p = ecl_to_uint16_t(value);
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
case ECL_FFI_INT32_T:
|
||||
*(ecl_int32_t *)p = ecl_to_int32_t(value);
|
||||
case ECL_FFI_UINT32_T:
|
||||
*(ecl_uint32_t *)p = ecl_to_uint32_t(value);
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
case ECL_FFI_INT64_T:
|
||||
*(ecl_int64_t *)p = ecl_to_int64_t(value);
|
||||
case ECL_FFI_UINT64_T:
|
||||
*(ecl_uint64_t *)p = ecl_to_uint64_t(value);
|
||||
#endif
|
||||
#ifdef ecl_long_long_t
|
||||
case ECL_FFI_LONG_LONG:
|
||||
*(ecl_long_long_t *)p = ecl_to_long_long(value);
|
||||
case ECL_FFI_UNSIGNED_LONG_LONG:
|
||||
*(ecl_ulong_long_t *)p = ecl_to_unsigned_long_long(value);
|
||||
#endif
|
||||
case ECL_FFI_POINTER_VOID:
|
||||
*(void **)p = ecl_foreign_data_pointer_safe(value);
|
||||
break;
|
||||
|
|
|
|||
132
src/c/number.d
132
src/c/number.d
|
|
@ -301,6 +301,138 @@ ecl_make_int64_t(ecl_int64_t i)
|
|||
# endif /* FIXNUM_BITS < 64 */
|
||||
#endif /* ecl_uint64_t */
|
||||
|
||||
#if defined(ecl_ulong_long_t)
|
||||
# if defined(ecl_uint32_t) && ECL_LONG_LONG_BITS == 32
|
||||
ecl_ulong_long_t
|
||||
ecl_to_unsigned_long_long(cl_object x) {
|
||||
return (ecl_ulong_long_t)ecl_to_uint32_t(x);
|
||||
}
|
||||
|
||||
ecl_long_long_t
|
||||
ecl_to_long_long(cl_object x) {
|
||||
return (ecl_long_long_t)ecl_to_int32_t(x);
|
||||
}
|
||||
cl_object
|
||||
ecl_make_unsigned_long_long(ecl_ulong_long_t i) {
|
||||
return ecl_make_uint32_t(i);
|
||||
}
|
||||
cl_object
|
||||
ecl_make_long_long(ecl_long_long_t i) {
|
||||
return ecl_make_int32_t(i);
|
||||
}
|
||||
# else
|
||||
# if defined(ecl_uint64_t) && ECL_LONG_LONG_BITS == 64
|
||||
ecl_ulong_long_t
|
||||
ecl_to_unsigned_long_long(cl_object x) {
|
||||
return (ecl_ulong_long_t)ecl_to_uint64_t(x);
|
||||
}
|
||||
ecl_long_long_t
|
||||
ecl_to_long_long(cl_object x) {
|
||||
return (ecl_long_long_t)ecl_to_int64_t(x);
|
||||
}
|
||||
cl_object
|
||||
ecl_make_unsigned_long_long(ecl_ulong_long_t i) {
|
||||
return ecl_make_uint64_t(i);
|
||||
}
|
||||
cl_object
|
||||
ecl_make_long_long(ecl_long_long_t i) {
|
||||
return ecl_make_int64_t(i);
|
||||
}
|
||||
# else
|
||||
# if !defined(WITH_GMP)
|
||||
# error "Cannot handle ecl_ulong_long_t without GMP"
|
||||
# endif
|
||||
ecl_ulong_long_t
|
||||
ecl_to_unsigned_long_long(cl_object x) {
|
||||
do {
|
||||
if (!ecl_minusp(x)) {
|
||||
if (FIXNUMP(x)) {
|
||||
return (ecl_ulong_long_t)fix(x);
|
||||
} else if (type_of(x) != t_bignum) {
|
||||
(void)0;
|
||||
} else if (mpz_fits_ulong_p(x->big.big_num)) {
|
||||
return (ecl_ulong_long_t)mpz_get_ui(x->big.big_num);
|
||||
} else {
|
||||
cl_object copy = big_register0_get();
|
||||
int i = ECL_LONG_LONG_BITS - CL_FIXNUM_BITS;
|
||||
mpz_fdiv_q_2exp(copy->bit.big_num, x->big.big_num, i);
|
||||
if (mpz_fits_ulong_p(copy->big.big_num)) {
|
||||
volatile ecl_ulong_long_t output;
|
||||
output = mpz_get_ui(copy->big.big_num);
|
||||
for (i -= CL_FIXNUM_BITS; i; i-= CL_FIXNUM_BITS) {
|
||||
output = (output << CL_FIXNUM_BITS);
|
||||
output += mpz_get_ui(x->big.big_num);
|
||||
}
|
||||
return output;
|
||||
}
|
||||
}
|
||||
}
|
||||
x = ecl_type_error(@'coerce', "variable", x,
|
||||
cl_list(3,@'integer',MAKE_FIXNUM(0),
|
||||
ecl_one_minus(ecl_ash(MAKE_FIXNUM(1),
|
||||
ECL_LONG_LONG_BITS))));
|
||||
} while(1);
|
||||
}
|
||||
|
||||
ecl_long_long_t
|
||||
ecl_to_long_long(cl_object x)
|
||||
{
|
||||
do {
|
||||
if (FIXNUMP(x)) {
|
||||
return (ecl_long_long_t)fix(x);
|
||||
} else if (type_of(x) != t_bignum) {
|
||||
(void)0;
|
||||
} else if (mpz_fits_slong_p(x->big.big_num)) {
|
||||
return (ecl_long_long_t)mpz_get_si(x->big.big_num);
|
||||
} else {
|
||||
cl_object copy = big_register0_get();
|
||||
int i = ECL_LONG_LONG_BITS - CL_FIXNUM_BITS;
|
||||
mpz_fdiv_q_2exp(copy->bit.big_num, x->big.big_num, i);
|
||||
if (mpz_fits_ulong_p(copy->big.big_num)) {
|
||||
volatile ecl_long_long_t output;
|
||||
output = mpz_get_si(copy->big.big_num);
|
||||
for (i -= CL_FIXNUM_BITS; i; i-= CL_FIXNUM_BITS) {
|
||||
output = (output << CL_FIXNUM_BITS);
|
||||
output += mpz_get_ui(x->big.big_num);
|
||||
}
|
||||
return output;
|
||||
}
|
||||
}
|
||||
x = ecl_type_error(@'coerce', "variable", x,
|
||||
cl_list(3,@'integer',
|
||||
ecl_negate(ecl_ash(MAKE_FIXNUM(1), ECL_LONG_LONG_BITS-1)),
|
||||
ecl_one_minus(ecl_ash(MAKE_FIXNUM(1), ECL_LONG_LONG_BITS-1))));
|
||||
} while(1);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_make_unsigned_long_long(ecl_ulong_long_t i)
|
||||
{
|
||||
if (i <= MOST_POSITIVE_FIXNUM) {
|
||||
return MAKE_FIXNUM(i);
|
||||
} else if (i <= ~(ecl_uint32_t)0) {
|
||||
return ecl_make_uint32_t(i);
|
||||
} else {
|
||||
cl_object aux = ecl_make_uint32_t(i >> 32);
|
||||
return cl_logior(2, ecl_ash(aux, 32),
|
||||
ecl_make_uint32_t((ecl_uint32_t)i));
|
||||
}
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_make_long_long(ecl_long_long_t i)
|
||||
{
|
||||
if (i >= MOST_NEGATIVE_FIXNUM && i <= MOST_POSITIVE_FIXNUM) {
|
||||
return MAKE_FIXNUM(i);
|
||||
} else {
|
||||
cl_object aux = ecl_make_int32_t(i >> 32);
|
||||
return cl_logior(2, ecl_ash(aux, 32), ecl_make_uint32_t((ecl_uint32_t)i));
|
||||
}
|
||||
}
|
||||
# endif
|
||||
# endif
|
||||
#endif /* ecl_ulong_long_t */
|
||||
|
||||
cl_object
|
||||
ecl_make_ratio(cl_object num, cl_object den)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1417,17 +1417,27 @@ cl_symbols[] = {
|
|||
{KEY_ "FIXNUM", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "FLOAT", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "INT", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "INT8-T", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "INT16-T", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "INT32-T", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "INT64-T", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "LONG", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "LONG-LONG", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "POINTER-SELF", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "POINTER-VOID", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "SHORT", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "STRUCT", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UNION", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "VOID", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UINT8-T", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UINT16-T", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UINT32-T", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UINT64-T", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UNSIGNED-BYTE", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UNSIGNED-CHAR", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UNSIGNED-INT", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UNSIGNED-LONG", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UNSIGNED-LONG-LONG", KEYWORD, NULL, -1, OBJNULL},
|
||||
{KEY_ "UNSIGNED-SHORT", KEYWORD, NULL, -1, OBJNULL},
|
||||
{SYS_ "C-CHAR-BIT", SI_CONSTANT, NULL, -1, MAKE_FIXNUM(CHAR_BIT)},
|
||||
{SYS_ "C-CHAR-MAX", SI_CONSTANT, NULL, -1, MAKE_FIXNUM(CHAR_MAX)},
|
||||
|
|
@ -1442,7 +1452,7 @@ cl_symbols[] = {
|
|||
{SYS_ "C-UINT-MAX", SI_CONSTANT, NULL, -1, OBJNULL}, /* See main.d */
|
||||
{SYS_ "C-USHORT-MAX", SI_CONSTANT, NULL, -1, MAKE_FIXNUM(USHRT_MAX)},
|
||||
{SYS_ "C-ULONG-MAX", SI_CONSTANT, NULL, -1, OBJNULL}, /* See main.d */
|
||||
|
||||
{SYS_ "C-ULONG-LONG-MAX",SI_CONSTANT,NULL,-1,OBJNULL}, /* See main.d */
|
||||
#ifdef GBC_BOEHM
|
||||
{SYS_ "GC", SI_ORDINARY, si_gc, 1, OBJNULL},
|
||||
{SYS_ "GC-DUMP", SI_ORDINARY, si_gc_dump, 0, OBJNULL},
|
||||
|
|
|
|||
|
|
@ -1417,17 +1417,27 @@ cl_symbols[] = {
|
|||
{KEY_ "FIXNUM",NULL},
|
||||
{KEY_ "FLOAT",NULL},
|
||||
{KEY_ "INT",NULL},
|
||||
{KEY_ "INT8-T",NULL},
|
||||
{KEY_ "INT16-T",NULL},
|
||||
{KEY_ "INT32-T",NULL},
|
||||
{KEY_ "INT64-T",NULL},
|
||||
{KEY_ "LONG",NULL},
|
||||
{KEY_ "LONG-LONG",NULL},
|
||||
{KEY_ "POINTER-SELF",NULL},
|
||||
{KEY_ "POINTER-VOID",NULL},
|
||||
{KEY_ "SHORT",NULL},
|
||||
{KEY_ "STRUCT",NULL},
|
||||
{KEY_ "UNION",NULL},
|
||||
{KEY_ "VOID",NULL},
|
||||
{KEY_ "UINT8-T",NULL},
|
||||
{KEY_ "UINT16-T",NULL},
|
||||
{KEY_ "UINT32-T",NULL},
|
||||
{KEY_ "UINT64-T",NULL},
|
||||
{KEY_ "UNSIGNED-BYTE",NULL},
|
||||
{KEY_ "UNSIGNED-CHAR",NULL},
|
||||
{KEY_ "UNSIGNED-INT",NULL},
|
||||
{KEY_ "UNSIGNED-LONG",NULL},
|
||||
{KEY_ "UNSIGNED-LONG-LONG",NULL},
|
||||
{KEY_ "UNSIGNED-SHORT",NULL},
|
||||
{SYS_ "C-CHAR-BIT",NULL},
|
||||
{SYS_ "C-CHAR-MAX",NULL},
|
||||
|
|
@ -1442,7 +1452,7 @@ cl_symbols[] = {
|
|||
{SYS_ "C-UINT-MAX",NULL}, /* See main.d */
|
||||
{SYS_ "C-USHORT-MAX",NULL},
|
||||
{SYS_ "C-ULONG-MAX",NULL}, /* See main.d */
|
||||
|
||||
{SYS_ "C-ULONG-LONG-MAX",NULL}, /* See main.d */
|
||||
#ifdef GBC_BOEHM
|
||||
{SYS_ "GC","si_gc"},
|
||||
{SYS_ "GC-DUMP","si_gc_dump"},
|
||||
|
|
|
|||
89
src/configure
vendored
89
src/configure
vendored
|
|
@ -7054,15 +7054,12 @@ _ACEOF
|
|||
|
||||
fi
|
||||
|
||||
{ echo "$as_me:$LINENO: checking for long long int" >&5
|
||||
echo $ECHO_N "checking for long long int... $ECHO_C" >&6; }
|
||||
if test "${ac_cv_c_long_long+set}" = set; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
if test "$GCC" = yes; then
|
||||
{ echo "$as_me:$LINENO: checking size of long long" >&5
|
||||
echo $ECHO_N "checking size of long long... $ECHO_C" >&6; }
|
||||
if test "$GCC" = yes; then
|
||||
ac_cv_c_long_long=yes
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
|
|
@ -7103,11 +7100,73 @@ sed 's/^/| /' conftest.$ac_ext >&5
|
|||
fi
|
||||
|
||||
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
|
||||
fi
|
||||
fi
|
||||
{ echo "$as_me:$LINENO: result: $ac_cv_c_long_long" >&5
|
||||
echo "${ECHO_T}$ac_cv_c_long_long" >&6; }
|
||||
if test $ac_cv_c_long_long = yes; then
|
||||
if test $ac_cv_c_long_long = yes; then
|
||||
if test "$cross_compiling" = yes; then
|
||||
{ { echo "$as_me:$LINENO: error: cannot run test program while cross compiling
|
||||
See \`config.log' for more details." >&5
|
||||
echo "$as_me: error: cannot run test program while cross compiling
|
||||
See \`config.log' for more details." >&2;}
|
||||
{ (exit 1); exit 1; }; }
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
#include <stdio.h>
|
||||
int main() {
|
||||
const char *int_type;
|
||||
int bits;
|
||||
unsigned long long x = 1;
|
||||
FILE *f=fopen("conftestval", "w");
|
||||
if (!f) exit(1);
|
||||
for (bits = 0; x; bits++) {
|
||||
x <<= 1;
|
||||
}
|
||||
fprintf(f,"ECL_LONG_LONG_BITS='%d'",bits);
|
||||
exit(0);
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest$ac_exeext
|
||||
if { (ac_try="$ac_link"
|
||||
case "(($ac_try" in
|
||||
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
|
||||
*) ac_try_echo=$ac_try;;
|
||||
esac
|
||||
eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
|
||||
(eval "$ac_link") 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } && { ac_try='./conftest$ac_exeext'
|
||||
{ (case "(($ac_try" in
|
||||
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
|
||||
*) ac_try_echo=$ac_try;;
|
||||
esac
|
||||
eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
|
||||
(eval "$ac_try") 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
eval "`cat conftestval`"
|
||||
else
|
||||
echo "$as_me: program exited with status $ac_status" >&5
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
fi
|
||||
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
|
||||
fi
|
||||
|
||||
|
||||
fi
|
||||
if test -z "$ECL_LONG_LONG_BITS"; then
|
||||
{ echo "$as_me:$LINENO: result: not available" >&5
|
||||
echo "${ECHO_T}not available" >&6; }
|
||||
else
|
||||
{ echo "$as_me:$LINENO: result: $ECL_LONG_LONG_BITS" >&5
|
||||
echo "${ECHO_T}$ECL_LONG_LONG_BITS" >&6; }
|
||||
|
||||
cat >>confdefs.h <<\_ACEOF
|
||||
#define ecl_long_long_t long long
|
||||
|
|
@ -7118,7 +7177,11 @@ cat >>confdefs.h <<\_ACEOF
|
|||
#define ecl_ulong_long_t unsigned long long
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
cat >>confdefs.h <<_ACEOF
|
||||
#define ECL_LONG_LONG_BITS $ECL_LONG_LONG_BITS
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
|
||||
/*
|
||||
config.h.in -- Template configuration file.
|
||||
*/
|
||||
|
|
@ -312,6 +313,8 @@ typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey;
|
|||
#undef HAVE_UNAME
|
||||
#undef HAVE_UNISTD_H
|
||||
#undef HAVE_SYS_WAIT_H
|
||||
/* size of long long */
|
||||
#undef ECL_LONG_LONG_BITS
|
||||
|
||||
/*
|
||||
* we do not manage to get proper signal handling of floating point
|
||||
|
|
|
|||
|
|
@ -943,7 +943,6 @@ extern ECL_API ecl_uint8_t ecl_to_uint8_t(cl_object o);
|
|||
extern ECL_API ecl_int8_t ecl_to_int8_t(cl_object o);
|
||||
#define ecl_make_uint8_t(i) MAKE_FIXNUM(i)
|
||||
#define ecl_make_int8_t(i) MAKE_FIXNUM(i)
|
||||
|
||||
#if FIXNUM_BITS < 32
|
||||
# error "Unsupported platforms with FIXNUM_BITS < 32"
|
||||
#endif
|
||||
|
|
@ -953,7 +952,6 @@ extern ECL_API ecl_int16_t ecl_to_int16_t(cl_object o);
|
|||
# define ecl_make_uint16_t(i) MAKE_FIXNUM(i)
|
||||
# define ecl_make_int16_t(i) MAKE_FIXNUM(i)
|
||||
#endif /* ecl_uint16_t */
|
||||
|
||||
#ifdef ecl_uint32_t
|
||||
# if FIXNUM_BITS == 32
|
||||
# define ecl_to_uint32_t fixnnint
|
||||
|
|
@ -967,7 +965,6 @@ extern ECL_API ecl_uint32_t ecl_to_uint32_t(cl_object o);
|
|||
extern ECL_API ecl_int32_t ecl_to_int32_t(cl_object o);
|
||||
# endif
|
||||
#endif /* ecl_uint32_t */
|
||||
|
||||
#ifdef ecl_uint64_t
|
||||
# if FIXNUM_BITS >= 64
|
||||
# define ecl_to_uint64_t fixnnint
|
||||
|
|
@ -981,6 +978,12 @@ extern ECL_API cl_object ecl_make_uint64_t(ecl_uint64_t i);
|
|||
extern ECL_API cl_object ecl_make_int64_t(ecl_int64_t i);
|
||||
# endif
|
||||
#endif /* ecl_uint64_t */
|
||||
#ifdef ecl_long_long_t
|
||||
extern ECL_API ecl_ulong_long_t ecl_to_unsigned_long_long(cl_object p);
|
||||
extern ECL_API ecl_long_long_t ecl_to_long_long(cl_object p);
|
||||
extern ECL_API cl_object ecl_make_unsigned_long_long(ecl_ulong_long_t i);
|
||||
extern ECL_API cl_object ecl_make_long_long(ecl_long_long_t i);
|
||||
#endif /* ecl_long_long_t */
|
||||
|
||||
extern ECL_API cl_object ecl_make_ratio(cl_object num, cl_object den);
|
||||
extern ECL_API cl_object ecl_make_singlefloat(float f);
|
||||
|
|
|
|||
|
|
@ -717,6 +717,22 @@ enum ecl_ffi_tag {
|
|||
ECL_FFI_UNSIGNED_INT,
|
||||
ECL_FFI_LONG,
|
||||
ECL_FFI_UNSIGNED_LONG,
|
||||
#ifdef ecl_uint16_t
|
||||
ECL_FFI_INT16_T,
|
||||
ECL_FFI_UINT16_T,
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
ECL_FFI_INT32_T,
|
||||
ECL_FFI_UINT32_T,
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
ECL_FFI_INT64_T,
|
||||
ECL_FFI_UINT64_T,
|
||||
#endif
|
||||
#ifdef ecl_long_long_t
|
||||
ECL_FFI_LONG_LONG,
|
||||
ECL_FFI_UNSIGNED_LONG_LONG,
|
||||
#endif
|
||||
ECL_FFI_POINTER_VOID,
|
||||
ECL_FFI_CSTRING,
|
||||
ECL_FFI_OBJECT,
|
||||
|
|
@ -736,6 +752,23 @@ union ecl_ffi_values {
|
|||
unsigned short us;
|
||||
long l;
|
||||
unsigned long ul;
|
||||
#ifdef ecl_uint16_t
|
||||
ecl_int16_t i16;
|
||||
ecl_uint16_t u16;
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
ecl_int32_t i32;
|
||||
ecl_uint32_t u32;
|
||||
#endif
|
||||
#ifdef ecl_uint64_t
|
||||
ecl_int64_t i64;
|
||||
ecl_uint64_t u64;
|
||||
#endif
|
||||
#ifdef ecl_long_long_t
|
||||
ecl_long_long_t ll;
|
||||
ecl_ulong_long_t ull;
|
||||
unsigned long l2[2];
|
||||
#endif
|
||||
void *pv;
|
||||
char *pc;
|
||||
cl_object o;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue