mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 13:21:54 -08:00
Code Issues Projects Releases Packages Wiki Activity

New routines to convert lisp objects to 'int', 'long' and 'bool'.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-07-15 15:19:08 +02:00
parent bae4afc9c3
commit 2ca580b13c
3 changed files with 44 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

13
src/c/number.d
View file

@ -220,7 +220,7 @@ ecl_to_int16_t(cl_object x) {
}
#endif /* ecl_uint16_t */
#if defined(ecl_uint32_t) && (FIXNUM_BITS != 32)
#if defined(ecl_uint32_t) && (FIXNUM_BITS > 32)
ecl_uint32_t
ecl_to_uint32_t(cl_object x) {
do {
@ -254,12 +254,12 @@ ecl_to_int32_t(cl_object x) {
#endif /* ecl_uint32_t */
#if defined(ecl_uint64_t) && (FIXNUM_BITS < 64)
ecl_uint64_t
ecl_to_uint64_t(cl_object x) {
do {
# if !defined(WITH_GMP) || FIXNUM_BITS != 32
# error "Cannot handle ecl_uint64_t without GMP or 32/64 bits integer"
# endif
ecl_uint64_t
ecl_to_uint64_t(cl_object x) {
do {
if (!ecl_minusp(x)) {
if (FIXNUMP(x)) {
return (ecl_uint64_t)fix(x);
@ -287,9 +287,6 @@ ecl_to_uint64_t(cl_object x) {
ecl_int64_t
ecl_to_int64_t(cl_object x) {
# if !defined(WITH_GMP) || FIXNUM_BITS != 32
# error "Cannot handle ecl_uint64_t without GMP or 32 bits fixnums"
# endif
do {
if (FIXNUMP(x)) {
return (ecl_int64_t)fix(x);
@ -314,7 +311,6 @@ ecl_to_int64_t(cl_object x) {
} while(1);
}
# if FIXNUM_BITS < 64
cl_object
ecl_make_uint64_t(ecl_uint64_t i)
{
@ -339,7 +335,6 @@ ecl_make_int64_t(ecl_int64_t i)
return cl_logior(2, ecl_ash(aux, 32), ecl_make_uint32_t((ecl_uint32_t)i));
}
}
# endif /* FIXNUM_BITS < 64 */
#endif /* ecl_uint64_t */
#if defined(ecl_ulong_long_t)

37
src/h/external.h
View file

@ -574,6 +574,9 @@ extern ECL_API cl_object si_find_foreign_symbol(cl_object var, cl_object module,
extern ECL_API cl_object si_call_cfun(cl_narg, cl_object fun, cl_object return_type, cl_object arg_types, cl_object args, ...);
extern ECL_API cl_object si_make_dynamic_callback(cl_narg, cl_object fun, cl_object sym, cl_object return_type, cl_object arg_types, ...);
/* Only foreign data types can be coerced to a pointer */
#define ecl_make_pointer(x) ecl_make_foreign_data(Cnil,0,(x))
#define ecl_to_pointer(x) ecl_foreign_data_pointer_safe(x)
extern ECL_API cl_object ecl_make_foreign_data(cl_object tag, cl_index size, void *data);
extern ECL_API cl_object ecl_allocate_foreign_data(cl_object tag, cl_index size);
extern ECL_API void *ecl_foreign_data_pointer_safe(cl_object f);
@ -973,6 +976,10 @@ 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 */
#define ecl_make_short(n) MAKE_FIXNUM(n)
#define ecl_to_short(x) (short)fixint(n)
#define ecl_make_ushort(n) MAKE_FIXNUM(n)
#define ecl_to_ushort(x) (unsigned short)fixnnint(n)
#ifdef ecl_uint32_t
# if FIXNUM_BITS == 32
# define ecl_to_uint32_t fixnnint
@ -999,6 +1006,36 @@ 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 */
#if ECL_INT_BITS == 32
# define ecl_to_uint ecl_to_uint32_t
# define ecl_to_int ecl_to_int32_t
# define ecl_make_uint ecl_make_uint32_t
# define ecl_make_int ecl_make_int32_t
#else
# if ECL_INT_BITS == 64
# define ecl_to_uint ecl_to_uint64_t
# define ecl_to_int ecl_to_int64_t
# define ecl_make_uint ecl_make_uint64_t
# define ecl_make_int ecl_make_int64_t
# else
# error "Currently ECL expects 'int' type to have 32 or 64 bits"
# endif
#endif
#if ECL_LONG_BITS == 32
# define ecl_to_ulong ecl_to_uint32_t
# define ecl_to_long ecl_to_int32_t
# define ecl_make_ulong ecl_make_uint32_t
# define ecl_make_long ecl_make_int32_t
#else
# if ECL_LONG_BITS == 64
# define ecl_to_ulong ecl_to_uint64_t
# define ecl_to_long ecl_to_int64_t
# define ecl_make_ulong ecl_make_uint64_t
# define ecl_make_long ecl_make_int64_t
# else
# error "Currently ECL expects 'long' type to have 32 or 64 bits"
# endif
#endif
#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);

3
src/h/object.h
View file

@ -117,6 +117,9 @@ typedef cl_object (*cl_objectfn_fixed)();
#define IMMEDIATE(o) ((cl_fixnum)(o) & 3)
#define IMMEDIATE_TAG 3
#define ecl_to_bool(x) ((x)!=Cnil)
#define ecl_make_bool(x) ((x)? Ct : Cnil)
/* Immediate fixnums: */
#define FIXNUM_TAG t_fixnum
#define MAKE_FIXNUM(n) ((cl_object)(((cl_fixnum)(n) << 2) | FIXNUM_TAG))