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

decode-float: fix the implementation

Browse source 
The previous code returned 0 for negative floats. Moreover it did not honor
the signed negative zero wrt third returned value.
This commit is contained in:
Daniel Kochmański 2022-10-05 10:31:28 +02:00
parent e760e9182b
commit 4861e02c1f
1 changed files with 22 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