mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-19 03:30:27 +08:00
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:
parent
571325db59
commit
4f9c6b6e18
@ -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.
|
||||
|
@ -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;
|
||||
}
|
||||
|
Loading…
x
Reference in New Issue
Block a user