OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/15206 (RRSPACING intrinsics returns wrong result for 0.0) 

PR fortran/15206
* trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to
handle zero correctly.

From-SVN: r81848
This commit is contained in:
Tobias Schlüter 2004-05-14 17:32:01 +02:00 committed by Tobias Schlüter
parent 571325db59
commit 4f9c6b6e18
2 changed files with 25 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2004-05-08 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/15206
* trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to
handle zero correctly.
2004-05-14 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* match.c (gfc_match): Eliminate dead code.

29
gcc/fortran/trans-intrinsic.c
View File

@ -2398,23 +2398,28 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
se->expr = tmp;
}
/* Generate code for RRSPACING (X) intrinsic function. We generate:
sedigits = edigits + 1;
if (expn == 0)
/* Generate code for RRSPACING (X) intrinsic function. We generate:
if (expn == 0 && frac == 0)
res = 0;
else
{
t1 = leadzero (frac);
frac = frac << (t1 + sedigits);
frac = frac >> (sedigits);
}
t = bias + BITS_OF_FRACTION_OF;
res = (t << BITS_OF_FRACTION_OF) | frac;
sedigits = edigits + 1;
if (expn == 0)
{
t1 = leadzero (frac);
frac = frac << (t1 + sedigits);
frac = frac >> (sedigits);
}
t = bias + BITS_OF_FRACTION_OF;
res = (t << BITS_OF_FRACTION_OF) | frac;
*/
static void
gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
{
tree masktype;
tree tmp, t1, t2, cond;
tree tmp, t1, t2, cond, cond2;
tree one, zero;
tree fdigits, fraction;
real_compnt_info rcs;
@ -2438,6 +2443,10 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
tmp = build (LSHIFT_EXPR, masktype, tmp, fdigits);
tmp = build (BIT_IOR_EXPR, masktype, tmp, fraction);
cond2 = build (EQ_EXPR, boolean_type_node, rcs.frac, zero);
cond = build (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2);
tmp = build (COND_EXPR, masktype, cond, integer_zero_node, tmp);
tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
se->expr = tmp;
}