mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-25 22:12:40 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'fix-decode-float' into 'develop'

Browse source 
decode-float: fix the implementation

See merge request embeddable-common-lisp/ecl!275
This commit is contained in:
Marius Gerbershagen 2022-10-22 17:57:15 +00:00
commit 509a77335a
2 changed files with 37 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

48
src/c/num_co.d
View file

@ -115,51 +115,47 @@ cl_object
cl_decode_float(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
int e, s;
cl_type tx = ecl_t_of(x);
float f;
int e, s = 1;
cl_object y = ECL_NIL;
switch (tx) {
case t_singlefloat: {
f = ecl_single_float(x);
if (f >= 0.0) {
s = 1;
} else {
f = -f;
s = 0;
switch (ecl_t_of(x)) {
case t_longfloat: {
long double d = ecl_long_float(x);
if (signbit(d)) {
s = -1;
d = -d;
}
f = frexpf(f, &e);
x = ecl_make_single_float(f);
d = frexpl(d, &e);
x = ecl_make_long_float(d);
y = ecl_make_long_float(s);
break;
}
case t_doublefloat: {
double d = ecl_double_float(x);
if (d >= 0.0) {
s = 1;
} else {
if (signbit(d)) {
s = -1;
d = -d;
s = 0;
}
d = frexp(d, &e);
x = ecl_make_double_float(d);
y = ecl_make_double_float(s);
break;
}
case t_longfloat: {
long double d = ecl_long_float(x);
if (d >= 0.0)
s = 1;
else {
case t_singlefloat: {
float d = ecl_single_float(x);
if (signbit(d)) {
s = -1;
d = -d;
s = 0;
}
d = frexpl(d, &e);
x = ecl_make_long_float(d);
d = frexpf(d, &e);
x = ecl_make_single_float(d);
y = ecl_make_single_float(s);
break;
}
default:
FEwrong_type_only_arg(@[decode-float],x,@[float]);
}
ecl_return3(the_env, x, ecl_make_fixnum(e), ecl_make_single_float(s));
ecl_return3(the_env, x, ecl_make_fixnum(e), y);
}
cl_object

15
src/tests/normal-tests/ieee-fp.lsp
View file

@ -813,3 +813,18 @@ Common Lisp type contagion rules."
:floating-point-inexact)
do (signals error (si:trap-fpe sym flag) "~s should be an invalid EXT:FPE-TRAP condition." sym)))
(si:trap-fpe bits t))))
(test ieee-fp.0034.decode-float
(labels ((test-float (proto num res exp sign)
(equal (multiple-value-list (decode-float (float num proto)))
(list (float res proto) exp (float sign proto))))
(test-float* (num res exp sign)
(is (test-float 1.0f0 num res exp sign))
(is (test-float 1.0d0 num res exp sign))
(is (test-float 1.0l0 num res exp sign))))
(test-float* -10.0 0.625 4 -1.0)
(test-float* -1.0 0.5 1 -1.0)
(test-float* -0.0 0.0 0 -1.0)
(test-float* +0.0 0.0 0 +1.0)
(test-float* +1.0 0.5 1 +1.0)
(test-float* +10.0 0.625 4 +1.0)))