Commit ea87100a authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

long-float: remove conditionalization

Many parts of the source code were bent backward to support builds
without long floats which are always present given we depend expect
c99 compiler.

The corresponding C macros (ECL_LONG_FLOAT) and the *feature*
entry (:long-float) are marked as deprecated in the documentation.
parent 8c30d1a3
......@@ -18,14 +18,15 @@ If you do not have access to the online version, follow the following recipies.
3. Enter
nmake ...
followed by zero or more of those options
4. Use "nmake install" to create a directory called "package" with ECL in it.
5. Move that directory wherever you need.
4. Use "nmake install" to create a directory called "package" with ECL in it.
5. Move that directory wherever you need.
* Cross-compile for the android platform (from the UNIX machine)
1. Build the host ECL
#+BEGIN_SRC shell-script
# C99 complex numbers are not fully supported on Android
./configure ABI=32 CFLAGS="-m32 -g -O2" LDFLAGS="-m32 -g -O2"\
--prefix=`pwd`/ecl-android-host --disable-longdouble
--prefix=`pwd`/ecl-android-host --disable-c99complex
make -j9
make install
rm -r build
......@@ -49,6 +50,7 @@ If you do not have access to the online version, follow the following recipies.
export CC=arm-linux-androideabi-clang
./configure --host=arm-linux-androideabi \
--prefix=`pwd`/ecl-android \
--disable-c99complex \
--with-cross-config=`pwd`/src/util/android-arm.cross_config
make -j9
make install
......
dnl -*- autoconf -*-
dnl --------------------------------------------------------------
dnl check existence of long double
AC_DEFUN([ECL_LONG_DOUBLE],[
if test "$enable_longdouble" != "no" ; then
AC_CHECK_TYPES([long double],
[enable_longdouble=yes, AC_DEFINE([ECL_LONG_FLOAT], [], [ECL_LONG_FLOAT])]
[enable_longdouble=no])
fi])
dnl --------------------------------------------------------------
dnl check for existence of complex float
AC_DEFUN([ECL_COMPLEX_C99],[
if test "$enable_c99complex" != "no" ; then
AC_CHECK_TYPES([float complex, double complex, long complex],
[enable_c99complex=yes, AC_DEFINE([ECL_COMPLEX_FLOAT], [], [ECL_COMPLEX_FLOAT])],
[enable_c99complex=yes],
[enable_c99complex=no],
[#include <complex.h>])
fi
dnl some retarded platforms (*cough* Android *cough*) have complex
dnl types defined, but not all corresponding numeric functions
if test "$enable_c99complex" != "no" ; then
AC_CHECK_FUNCS([crealf creal creall cimagf cimag cimagl] \
[cabsf cabs cabsl conjf conj conjl csqrtf csqrt csqrtl] \
[ccosf ccos ccosl csinf csin csinl ctanf ctan ctanl] \
[ccoshf ccosh ccoshl csinhf csinh csinhl ctanhf ctanh ctanhl] \
[cexpf cexp cexpl cpowf cpow cpowl clogf clog clogl] \
[casinf casin casinl cacosf cacos cacosl catanf catan catanl] \
[casinhf casinh casinhl cacoshf cacosh cacoshl catanhf catanh catanhl] \
[],
[enable_c99complex=no])
fi
if test "$enable_c99complex" != "no" ; then
AC_DEFINE([ECL_COMPLEX_FLOAT], [], [ECL_COMPLEX_FLOAT])
fi])
dnl --------------------------------------------------------------
......
......@@ -557,9 +557,7 @@ ecl_alloc_object(cl_type t)
#ifdef ECL_SSE2
case t_sse_pack:
#endif
#ifdef ECL_LONG_FLOAT
case t_longfloat:
#endif
#ifdef ECL_COMPLEX_FLOAT
case t_csfloat:
case t_cdfloat:
......@@ -852,9 +850,7 @@ init_alloc(void)
init_tm(t_ratio, "RATIO", sizeof(struct ecl_ratio), 2);
init_tm(t_singlefloat, "SINGLE-FLOAT", sizeof(struct ecl_singlefloat), 0);
init_tm(t_doublefloat, "DOUBLE-FLOAT", sizeof(struct ecl_doublefloat), 0);
#ifdef ECL_LONG_FLOAT
init_tm(t_longfloat, "LONG-FLOAT", sizeof(struct ecl_long_float), 0);
#endif
init_tm(t_complex, "COMPLEX", sizeof(struct ecl_complex), 2);
#ifdef ECL_COMPLEX_FLOAT
init_tm(t_csfloat, "COMPLEX-SINGLE-FLOAT", sizeof(struct ecl_csfloat), 0);
......@@ -913,9 +909,7 @@ init_alloc(void)
to_bitmap(&o, &(o.ratio.den));
type_info[t_singlefloat].descriptor = 0;
type_info[t_doublefloat].descriptor = 0;
#ifdef ECL_LONG_FLOAT
type_info[t_longfloat].descriptor = 0;
#endif
type_info[t_complex].descriptor =
to_bitmap(&o, &(o.complex.real)) |
to_bitmap(&o, &(o.complex.imag));
......
......@@ -22,9 +22,7 @@ static const cl_object ecl_aet_name[] = {
ECL_T, /* ecl_aet_object */
@'single-float', /* ecl_aet_sf */
@'double-float', /* ecl_aet_df */
#ifdef ECL_LONG_FLOAT
@'long-float', /* ecl_aet_lf */
#endif
#ifdef ECL_COMPLEX_FLOAT
@'si::complex-single-float', /* ecl_aet_csf */
@'si::complex-double-float', /* ecl_aet_cdf */
......@@ -181,10 +179,8 @@ ecl_aref_unsafe(cl_object x, cl_index index)
return(ecl_make_single_float(x->array.self.sf[index]));
case ecl_aet_df:
return(ecl_make_double_float(x->array.self.df[index]));
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
return(ecl_make_long_float(x->array.self.lf[index]));
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
return(ecl_make_csfloat(x->array.self.csf[index]));
......@@ -349,11 +345,9 @@ ecl_aset_unsafe(cl_object x, cl_index index, cl_object value)
case ecl_aet_df:
x->array.self.df[index] = ecl_to_double(value);
break;
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
x->array.self.lf[index] = ecl_to_long_double(value);
break;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
x->array.self.csf[index] = ecl_to_csfloat(value);
......@@ -669,13 +663,8 @@ ecl_symbol_to_elttype(cl_object x)
return(ecl_aet_sf);
else if (x == @'double-float')
return(ecl_aet_df);
else if (x == @'long-float') {
#ifdef ECL_LONG_FLOAT
else if (x == @'long-float')
return(ecl_aet_lf);
#else
return(ecl_aet_df);
#endif
}
#ifdef ECL_COMPLEX_FLOAT
else if (x == @'si::complex-single-float')
return(ecl_aet_csf);
......@@ -755,10 +744,8 @@ address_inc(void *address, cl_fixnum inc, cl_elttype elt_type)
#endif
case ecl_aet_df:
return aux.df + inc;
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
return aux.lf + inc;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
return aux.csf + inc;
......@@ -1028,11 +1015,9 @@ cl_array_displacement(cl_object a)
case ecl_aet_df:
offset = a->array.self.df - to_array->array.self.df;
break;
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
offset = a->array.self.lf - to_array->array.self.lf;
break;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
offset = a->array.self.csf - to_array->array.self.csf;
......@@ -1314,7 +1299,6 @@ ecl_reverse_subarray(cl_object x, cl_index i0, cl_index i1)
x->array.self.df[j] = y;
}
break;
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
for (i = i0, j = i1-1; i < j; i++, --j) {
long double y = x->array.self.lf[i];
......@@ -1322,7 +1306,6 @@ ecl_reverse_subarray(cl_object x, cl_index i0, cl_index i1)
x->array.self.lf[j] = y;
}
break;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
for (i = i0, j = i1-1; i < j; i++, --j) {
......@@ -1488,14 +1471,12 @@ si_fill_array_with_elt(cl_object x, cl_object elt, cl_object start, cl_object en
for (first = last - first; first; --first, ++p) { *p = e; }
break;
}
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf: {
long double e = ecl_to_long_double(elt);
long double *p = x->vector.self.lf + first;
for (first = last - first; first; --first, ++p) { *p = e; }
break;
}
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf: {
_Complex float e = ecl_to_csfloat(elt);
......
......@@ -401,7 +401,6 @@ _ecl_big_fits_in_index(cl_object x)
# error "ECL cannot build with GMP when both long and mp_limb_t are smaller than cl_fixnum"
#endif /* ECL_FIXNUM_BITS > GMP_LIMB_BITS, ECL_LONG_BITS */
#ifdef ECL_LONG_FLOAT
long double
_ecl_big_to_long_double(cl_object o)
{
......@@ -413,7 +412,6 @@ _ecl_big_to_long_double(cl_object o)
}
return (mpz_sgn(o->big.big_num) < 0)? -output : output;
}
#endif
static void
mpz_ior_op(cl_object out, cl_object i, cl_object j)
......
......@@ -337,9 +337,7 @@ enum ecl_built_in_classes {
ECL_BUILTIN_FLOAT,
ECL_BUILTIN_SINGLE_FLOAT,
ECL_BUILTIN_DOUBLE_FLOAT,
#ifdef ECL_LONG_FLOAT
ECL_BUILTIN_LONG_FLOAT,
#endif
ECL_BUILTIN_COMPLEX,
#ifdef ECL_COMPLEX_FLOAT
ECL_BUILTIN_COMPLEX_FLOAT,
......@@ -393,10 +391,8 @@ cl_class_of(cl_object x)
index = ECL_BUILTIN_SINGLE_FLOAT; break;
case t_doublefloat:
index = ECL_BUILTIN_DOUBLE_FLOAT; break;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
index = ECL_BUILTIN_LONG_FLOAT; break;
#endif
case t_complex:
index = ECL_BUILTIN_COMPLEX; break;
#ifdef ECL_COMPLEX_FLOAT
......
......@@ -78,10 +78,8 @@ ecl_to_fixnum(cl_object x)
return (cl_fixnum)ecl_single_float(x);
case t_doublefloat:
return (cl_fixnum)ecl_double_float(x);
#ifdef ECL_LONG_FLOAT
case t_longfloat:
return (cl_fixnum)ecl_long_float(x);
#endif
default:
FEerror("~S cannot be coerced to a C int.", 1, x);
}
......@@ -100,10 +98,8 @@ ecl_to_unsigned_integer(cl_object x)
return (cl_index)ecl_single_float(x);
case t_doublefloat:
return (cl_index)ecl_double_float(x);
#ifdef ECL_LONG_FLOAT
case t_longfloat:
return (cl_index)ecl_long_float(x);
#endif
default:
FEerror("~S cannot be coerced to a C unsigned int.", 1, x);
}
......
......@@ -2200,9 +2200,7 @@ need_to_make_load_form_p(cl_object o)
case t_ratio:
case t_singlefloat:
case t_doublefloat:
#ifdef ECL_LONG_FLOAT
case t_longfloat:
#endif
case t_complex:
case t_symbol:
case t_pathname:
......
......@@ -48,7 +48,6 @@ ecl_def_ct_double_float(dbl_min_neg_norm,-DBL_MIN,static,const);
#define ECL_MOST_POSITIVE_DOUBLE_FLOAT (cl_object)(&dbl_max_data)
#define ECL_MOST_NEGATIVE_DOUBLE_FLOAT (cl_object)(&dbl_max_neg_data)
#ifdef ECL_LONG_FLOAT
ecl_def_ct_long_float(ldbl_max,LDBL_MAX,static,const);
ecl_def_ct_long_float(ldbl_max_neg,-LDBL_MAX,static,const);
ecl_def_ct_long_float(ldbl_min,LDBL_TRUE_MIN,static,const);
......@@ -61,18 +60,6 @@ ecl_def_ct_long_float(ldbl_min_neg_norm,-LDBL_MIN,static,const);
#define ECL_LEAST_NEGATIVE_NORMALIZED_LONG_FLOAT (cl_object)(&ldbl_min_neg_norm_data)
#define ECL_MOST_POSITIVE_LONG_FLOAT (cl_object)(&ldbl_max_data)
#define ECL_MOST_NEGATIVE_LONG_FLOAT (cl_object)(&ldbl_max_neg_data)
#else
#define ECL_LEAST_POSITIVE_LONG_FLOAT (cl_object)(&dbl_min_data)
#define ECL_LEAST_NEGATIVE_LONG_FLOAT (cl_object)(&dbl_min_neg_data)
#define ECL_LEAST_POSITIVE_NORMALIZED_LONG_FLOAT (cl_object)(&dbl_min_norm_data)
#define ECL_LEAST_NEGATIVE_NORMALIZED_LONG_FLOAT (cl_object)(&dbl_min_neg_norm_data)
#define ECL_MOST_POSITIVE_LONG_FLOAT (cl_object)(&dbl_max_data)
#define ECL_MOST_NEGATIVE_LONG_FLOAT (cl_object)(&dbl_max_neg_data)
#endif
#ifdef ECL_LONG_FLOAT
ecl_def_ct_long_float(float_pi,ECL_PI_L,static,const);
#else
ecl_def_ct_double_float(float_pi,ECL_PI_D,static,const);
#endif
#define ECL_PI (cl_object)(&float_pi_data)
......@@ -71,9 +71,7 @@ ecl_def_string_array(feature_names,static,const) = {
#ifdef ECL_UNICODE
ecl_def_string_array_elt("UNICODE"),
#endif
#ifdef ECL_LONG_FLOAT
ecl_def_string_array_elt("LONG-FLOAT"),
#endif
#ifdef ECL_COMPLEX_FLOAT
ecl_def_string_array_elt("COMPLEX-FLOAT"),
#endif
......
......@@ -19,9 +19,7 @@ static const cl_object ecl_aet_to_ffi_table[ecl_aet_bc+1] = {
@':void', /* ecl_aet_object */
@':float', /* ecl_aet_sf */
@':double', /* ecl_aet_df */
#ifdef ECL_LONG_FLOAT
@':long-double', /* ecl_aet_lf */
#endif
#ifdef ECL_COMPLEX_FLOAT
@':csfloat', /* ecl_aet_csf */
@':cdfloat', /* ecl_aet_cdf */
......@@ -125,9 +123,7 @@ ecl_foreign_type_table[] = {
FFI_DESC(@':object', cl_object),
FFI_DESC(@':float', float),
FFI_DESC(@':double', double),
#ifdef ECL_LONG_FLOAT
FFI_DESC(@':long-double', long double),
#endif
#ifdef ECL_COMPLEX_FLOAT
FFI_DESC(@':csfloat', _Complex float),
FFI_DESC(@':cdfloat', _Complex double),
......@@ -191,9 +187,7 @@ static ffi_type *ecl_type_to_libffi_types[] = {
&ffi_type_pointer, /*@':object',*/
&ffi_type_float, /*@':float',*/
&ffi_type_double, /*@':double',*/
#ifdef ECL_LONG_FLOAT
&ffi_type_longdouble, /*@':long-double',*/
#endif
#ifdef ECL_COMPLEX_FLOAT
/* These ffi types are defined in libffi but they dont't seem to
work. For the issue report check the following link:
......@@ -537,10 +531,8 @@ ecl_foreign_data_ref_elt(void *p, enum ecl_ffi_tag tag)
return ecl_make_single_float(*(float *)p);
case ECL_FFI_DOUBLE:
return ecl_make_double_float(*(double *)p);
#ifdef ECL_LONG_FLOAT
case ECL_FFI_LONG_DOUBLE:
return ecl_make_long_float(*(long double *)p);
#endif
#ifdef ECL_COMPLEX_FLOAT
case ECL_FFI_CSFLOAT:
return ecl_make_csfloat(*(_Complex float *)p);
......@@ -643,11 +635,9 @@ ecl_foreign_data_set_elt(void *p, enum ecl_ffi_tag tag, cl_object value)
case ECL_FFI_DOUBLE:
*(double *)p = ecl_to_double(value);
break;
#ifdef ECL_LONG_FLOAT
case ECL_FFI_LONG_DOUBLE:
*(long double *)p = ecl_to_long_double(value);
break;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ECL_FFI_CSFLOAT:
*(_Complex float *)p = ecl_to_csfloat(value);
......
......@@ -751,31 +751,20 @@ fmt_character(format_stack fmt, bool colon, bool atsign)
* Notice that we leave some extra margin, to ensure that reading the number
* again will produce the same floating point number.
*/
#ifdef ECL_LONG_FLOAT
# define LDBL_SIG ((int)(LDBL_MANT_DIG * LOG10_2 + 1))
# define DBL_MAX_DIGITS (LDBL_SIG + 3)
# define DBL_EXPONENT_SIZE (1 + 1 + 4)
#else
# define DBL_MAX_DIGITS (DBL_SIG + 3)
# define DBL_EXPONENT_SIZE (1 + 1 + 3) /* Exponent marker 'e' + sign + digits .*/
#endif
#define LDBL_SIG ((int)(LDBL_MANT_DIG * LOG10_2 + 1))
#define DBL_MAX_DIGITS (LDBL_SIG + 3)
#define DBL_EXPONENT_SIZE (1 + 1 + 4)
/* The sinificant digits + the possible sign + the decimal dot. */
#define DBL_MANTISSA_SIZE (DBL_MAX_DIGITS + 1 + 1)
/* Total estimated size that a floating point number can take. */
#define DBL_SIZE (DBL_MANTISSA_SIZE + DBL_EXPONENT_SIZE)
#ifdef ECL_LONG_FLOAT
#define EXP_STRING "Le"
#define G_EXP_STRING "Lg"
#define DBL_TYPE long double
#define strtod strtold
extern long double strtold(const char *nptr, char **endptr);
#else
#define EXP_STRING "e"
#define G_EXP_STRING "g"
#define DBL_TYPE double
#endif
static int
edit_double(int n, DBL_TYPE d, int *sp, char *s, int *ep)
......@@ -795,10 +784,8 @@ edit_double(int n, DBL_TYPE d, int *sp, char *s, int *ep)
do {
sprintf(buff, "%- *.*" EXP_STRING, n + 1 + 1 + DBL_EXPONENT_SIZE, n-1, d);
aux = strtod(buff, NULL);
#ifdef ECL_LONG_FLOAT
if (n < LDBL_SIG)
aux = (double) aux;
#endif
if (n < DBL_SIG)
aux = (float)aux;
n++;
......@@ -1159,11 +1146,7 @@ fmt_exponential_float(format_stack fmt, bool colon, bool atsign)
y = ecl_symbol_value(@'*read-default-float-format*');
if (exponentchar < 0) {
if (y == @'long-float') {
#ifdef ECL_LONG_FLOAT
t = t_longfloat;
#else
t = t_doublefloat;
#endif
} else if (y == @'double-float') {
t = t_doublefloat;
} else if (y == @'single-float') {
......@@ -1175,10 +1158,8 @@ fmt_exponential_float(format_stack fmt, bool colon, bool atsign)
exponentchar = 'E';
else if (ecl_t_of(x) == t_singlefloat)
exponentchar = 'F';
#ifdef ECL_LONG_FLOAT
else if (ecl_t_of(x) == t_longfloat)
exponentchar = 'L';
#endif
else
exponentchar = 'D';
}
......
......@@ -47,7 +47,6 @@ _hash_eql(cl_hashkey h, cl_object x)
return hash_string(h, (unsigned char*)&ecl_single_float(x), sizeof(ecl_single_float(x)));
case t_doublefloat:
return hash_string(h, (unsigned char*)&ecl_double_float(x), sizeof(ecl_double_float(x)));
#ifdef ECL_LONG_FLOAT
case t_longfloat: {
/* We coerce to double because long double has extra bits that
* give rise to different hash key and are not meaningful. */
......@@ -56,7 +55,6 @@ _hash_eql(cl_hashkey h, cl_object x)
aux.sign = (ecl_long_float(x) < 0)? -1: 1;
return hash_string(h, (unsigned char*)&aux, sizeof(aux));
}
#endif
case t_complex:
h = _hash_eql(h, x->gencomplex.real);
return _hash_eql(h, x->gencomplex.imag);
......@@ -151,7 +149,6 @@ _hash_equal(int depth, cl_hashkey h, cl_object x)
if (f == 0.0) f = 0.0;
return hash_string(h, (unsigned char*)&f, sizeof(f));
}
# ifdef ECL_LONG_FLOAT
case t_longfloat: {
/* We coerce to double because long double has extra bits
* that give rise to different hash key and are not
......@@ -162,7 +159,6 @@ _hash_equal(int depth, cl_hashkey h, cl_object x)
if (aux.mantissa == 0.0) aux.mantissa = 0.0;
return hash_string(h, (unsigned char*)&aux, sizeof(aux));
}
# endif
case t_complex: {
h = _hash_equal(depth, h, x->gencomplex.real);
return _hash_equal(depth, h, x->gencomplex.imag);
......
......@@ -330,10 +330,8 @@ ecl_def_ct_single_float(flt_zero,0,static,const);
ecl_def_ct_single_float(flt_zero_neg,-0.0,static,const);
ecl_def_ct_double_float(dbl_zero,0,static,const);
ecl_def_ct_double_float(dbl_zero_neg,-0.0,static,const);
#ifdef ECL_LONG_FLOAT
ecl_def_ct_long_float(ldbl_zero,0,static,const);
ecl_def_ct_long_float(ldbl_zero_neg,-0.0l,static,const);
#endif
ecl_def_ct_ratio(plus_half,ecl_make_fixnum(1),ecl_make_fixnum(2),static,const);
ecl_def_ct_ratio(minus_half,ecl_make_fixnum(-1),ecl_make_fixnum(2),static,const);
ecl_def_ct_single_float(flt_one,1,static,const);
......@@ -382,10 +380,8 @@ struct cl_core_struct cl_core = {
(cl_object)&dbl_zero_data, /* doublefloat_zero */
(cl_object)&flt_zero_neg_data, /* singlefloat_minus_zero */
(cl_object)&dbl_zero_neg_data, /* doublefloat_minus_zero */
#ifdef ECL_LONG_FLOAT
(cl_object)&ldbl_zero_data, /* longfloat_zero */
(cl_object)&ldbl_zero_neg_data, /* longfloat_minus_zero */
#endif
(cl_object)&str_G_data, /* gensym_prefix */
(cl_object)&str_T_data, /* gentemp_prefix */
......
......@@ -53,9 +53,7 @@
switch (tx = ecl_t_of(x)) {
case t_singlefloat:
case t_doublefloat:
#ifdef ECL_LONG_FLOAT
case t_longfloat:
#endif
if (y == OBJNULL || ty == tx)
break;
case t_fixnum:
......@@ -66,10 +64,8 @@
x = ecl_make_single_float(ecl_to_double(x)); break;
case t_doublefloat:
x = ecl_make_double_float(ecl_to_double(x)); break;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
x = ecl_make_long_float(ecl_to_long_double(x)); break;
#endif
default:
FEwrong_type_nth_arg(@[float],2,y,@[float]);
}
......@@ -163,7 +159,6 @@ cl_decode_float(cl_object x)
x = ecl_make_double_float(d);
break;
}
#ifdef ECL_LONG_FLOAT
case t_longfloat: {
long double d = ecl_long_float(x);
if (d >= 0.0)
......@@ -176,7 +171,6 @@ cl_decode_float(cl_object x)
x = ecl_make_long_float(d);
break;
}
#endif
default:
FEwrong_type_only_arg(@[decode-float],x,@[float]);
}
......@@ -201,11 +195,9 @@ cl_scale_float(cl_object x, cl_object y)
case t_doublefloat:
x = ecl_make_double_float(ldexp(ecl_double_float(x), k));
break;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
x = ecl_make_long_float(ldexpl(ecl_long_float(x), k));
break;
#endif
default:
FEwrong_type_nth_arg(@[scale-float],1,x,@[float]);
}
......@@ -230,10 +222,8 @@ ecl_signbit(cl_object x)
return signbit(ecl_single_float(x));
case t_doublefloat:
return signbit(ecl_double_float(x));
#ifdef ECL_LONG_FLOAT
case t_longfloat:
return signbit(ecl_long_float(x));
#endif
default:
FEwrong_type_nth_arg(@[float-sign],1,x,@[float]);
}
......@@ -257,13 +247,11 @@ ecl_signbit(cl_object x)
if (signbit(f) != negativep) y = ecl_make_double_float(-f);
break;
}
#ifdef ECL_LONG_FLOAT
case t_longfloat: {
long double f = ecl_long_float(y);
if (signbit(f) != negativep) y = ecl_make_long_float(-f);
break;
}
#endif
default:
FEwrong_type_nth_arg(@[float-sign],2,y,@[float]);
}
......@@ -281,11 +269,9 @@ cl_float_digits(cl_object x)
case t_doublefloat:
x = ecl_make_fixnum(DBL_MANT_DIG);
break;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
x = ecl_make_fixnum(LDBL_MANT_DIG);
break;
#endif
default:
FEwrong_type_only_arg(@[float-digits],x,@[float]);
}
......@@ -328,7 +314,6 @@ cl_float_precision(cl_object x)
}
break;
}
#ifdef ECL_LONG_FLOAT
case t_longfloat: {
long double f = ecl_long_float(x);
if (f == 0.0) {
......@@ -344,7 +329,6 @@ cl_float_precision(cl_object x)
}
break;
}
#endif
default:
FEwrong_type_only_arg(@[float-precision],x,@[float]);
}
......@@ -358,7 +342,6 @@ cl_integer_decode_float(cl_object x)
int e, s = 1;
switch (ecl_t_of(x)) {
#ifdef ECL_LONG_FLOAT
case t_longfloat: {
long double d = ecl_long_float(x);
if (signbit(d)) {
......@@ -375,7 +358,6 @@ cl_integer_decode_float(cl_object x)
}
break;
}
#endif
case t_doublefloat: {
double d = ecl_double_float(x);
if (signbit(d)) {
......@@ -429,9 +411,7 @@ cl_realpart(cl_object x)
case t_ratio:
case t_singlefloat:
case t_doublefloat:
#ifdef ECL_LONG_FLOAT
case t_longfloat:
#endif
break;
case t_complex:
x = x->gencomplex.real;
......@@ -480,14 +460,12 @@ cl_imagpart(cl_object x)
else
x = cl_core.doublefloat_zero;
break;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
if (signbit(ecl_long_float(x)))
x = cl_core.longfloat_minus_zero;
else
x = cl_core.longfloat_zero;
break;
#endif
case t_complex:
x = x->gencomplex.imag;
break;
......
......@@ -70,10 +70,8 @@ ecl_float_nan_p(cl_object x)
/* return !isnan(ecl_single_float(x)); */
/* case t_doublefloat: */
/* return !isnan(ecl_double_float(x)); */
/* #ifdef ECL_LONG_FLOAT */
/* case t_longfloat: */
/* return !isnan(ecl_long_float(x)); */
/* #endif */
/* default: */
/* return 0; */
/* } */
......@@ -87,10 +85,8 @@ ecl_float_infinity_p(cl_object x)
return !isfinite(ecl_single_float(x));
case t_doublefloat:
return !isfinite(ecl_double_float(x));
#ifdef ECL_LONG_FLOAT
case t_longfloat:
return !isfinite(ecl_long_float(x));
#endif
default:
return 0;