From 2ca580b13cb54a056c5fe7a801e5079066bd2fda Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Wed, 15 Jul 2009 15:19:08 +0200 Subject: [PATCH] New routines to convert lisp objects to 'int', 'long' and 'bool'. --- src/c/number.d | 13 ++++--------- src/h/external.h | 37 +++++++++++++++++++++++++++++++++++++ src/h/object.h | 3 +++ 3 files changed, 44 insertions(+), 9 deletions(-) diff --git a/src/c/number.d b/src/c/number.d index 025753370..c4ac6b94c 100644 --- a/src/c/number.d +++ b/src/c/number.d @@ -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) diff --git a/src/h/external.h b/src/h/external.h index 3aa0b205a..fab4eff8c 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -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); diff --git a/src/h/object.h b/src/h/object.h index 26ec8d4d1..ef15e983a 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -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))