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

fix handling of floating point exceptions on certain architectures

Browse source
This commit is contained in:
Marius Gerbershagen 2017-08-03 17:20:20 +02:00
parent 612eeb5ed1
commit de205bb114
4 changed files with 61 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/ffi.d
View file

@ -491,9 +491,9 @@ ecl_foreign_data_ref_elt(void *p, enum ecl_ffi_tag tag)
case ECL_FFI_OBJECT:
return *(cl_object *)p;
case ECL_FFI_FLOAT:
return ecl_make_single_float(*(float *)p);
return ecl_make_single_float_unchecked(*(float *)p);
case ECL_FFI_DOUBLE:
return ecl_make_double_float(*(double *)p);
return ecl_make_double_float_unchecked(*(double *)p);
case ECL_FFI_VOID:
return ECL_NIL;
default:

53
src/c/number.d
View file

@ -526,6 +526,59 @@ ecl_make_long_float(long double f)
}
#endif
cl_object
ecl_make_single_float_unchecked(float f)
{
cl_object x;
if (f == (float)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (signbit(f))
return cl_core.singlefloat_minus_zero;
#endif
return cl_core.singlefloat_zero;
}
x = ecl_alloc_object(t_singlefloat);
ecl_single_float(x) = f;
return(x);
}
cl_object
ecl_make_double_float_unchecked(double f)
{
cl_object x;
if (f == (double)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (signbit(f))
return cl_core.doublefloat_minus_zero;
#endif
return cl_core.doublefloat_zero;
}
x = ecl_alloc_object(t_doublefloat);
ecl_double_float(x) = f;
return(x);
}
#ifdef ECL_LONG_FLOAT
cl_object
ecl_make_long_float_unchecked(long double f)
{
cl_object x;
if (f == (long double)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (signbit(f))
return cl_core.longfloat_minus_zero;
#endif
return cl_core.longfloat_zero;
}
x = ecl_alloc_object(t_longfloat);
x->longfloat.value = f;
return x;
}
#endif
cl_object
ecl_make_complex(cl_object r, cl_object i)
{

6
src/cmp/cmpc-machine.lsp
View file

@ -31,9 +31,9 @@
(:cl-index integer "cl_index" "ecl_make_unsigned_integer" "ecl_to_cl_index" "ecl_fixnum")
(:long-long integer "ecl_long_long_t" "ecl_make_long_long" "ecl_to_long_long" "ecl_to_long_long")
(:unsigned-long-long integer "ecl_ulong_long_t" "ecl_make_ulong_long" "ecl_to_ulong_long" "ecl_to_ulong_long")
(:float single-float "float" "ecl_make_single_float" "ecl_to_float" "ecl_single_float")
(:double double-float "double" "ecl_make_double_float" "ecl_to_double" "ecl_double_float")
(:long-double long-float "long double" "ecl_make_long_float" "ecl_to_long_double" "ecl_long_float")
(:float single-float "float" "ecl_make_single_float_unchecked" "ecl_to_float" "ecl_single_float")
(:double double-float "double" "ecl_make_double_float_unchecked" "ecl_to_double" "ecl_double_float")
(:long-double long-float "long double" "ecl_make_long_float_unchecked" "ecl_to_long_double" "ecl_long_float")
(:unsigned-char base-char "unsigned char" "CODE_CHAR" "ecl_base_char_code" "CHAR_CODE")
(:char base-char "char" "CODE_CHAR" "ecl_base_char_code" "CHAR_CODE")
(:wchar character "ecl_character" "CODE_CHAR" "ecl_char_code" "CHAR_CODE")

6
src/cmp/cmptop.lsp
View file

@ -478,10 +478,10 @@
(wt-nl "return " (case return-type
(FIXNUM "ecl_make_fixnum")
(CHARACTER "CODE_CHAR")
(DOUBLE-FLOAT "ecl_make_double_float")
(SINGLE-FLOAT "ecl_make_single_float")
(DOUBLE-FLOAT "ecl_make_double_float_unchecked")
(SINGLE-FLOAT "ecl_make_single_float_unchecked")
#+long-float
(LONG-FLOAT "ecl_make_long_float")
(LONG-FLOAT "ecl_make_long_float_unchecked")
(otherwise ""))
"(LI" cfun "(")
(do ((types arg-types (cdr types))