This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] PR15206 RRSPACING wrong for zero
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: GCC Fortran mailing list <fortran at gcc dot gnu dot org>,patch <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 08 May 2004 18:28:29 +0200
- Subject: [gfortran] PR15206 RRSPACING wrong for zero
This patch fixes the RRSPACING intrinsic. It didn't return the correct
result for a zero argument. I don't really understand how the original
code worked, but I verified that RRSPACING(x) == x/SPACING(x) for a wide
range of arguments. I used the condition (expn == 0 && frac == 0) to
check for a zero argument, if this is not the correct check, please
correct this.
Bootstrapped and regtested on i686-pc-linux.
- Tobi
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.
Index: trans-intrinsic.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/trans-intrinsic.c,v
retrieving revision 1.1.2.30
diff -u -p -r1.1.2.30 trans-intrinsic.c
--- trans-intrinsic.c 24 Apr 2004 12:19:27 -0000 1.1.2.30
+++ trans-intrinsic.c 8 May 2004 16:19:17 -0000
@@ -2399,22 +2400,27 @@ gfc_conv_intrinsic_spacing (gfc_se * se,
}
/* Generate code for RRSPACING (X) intrinsic function. We generate:
- sedigits = edigits + 1;
- if (expn == 0)
- {
- t1 = leadzero (frac);
- frac = frac << (t1 + sedigits);
- frac = frac >> (sedigits);
+ if (expn == 0 && frac == 0)
+ res = 0;
+ else
+ {
+ 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;
}
- 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;
@@ -2437,6 +2443,10 @@ gfc_conv_intrinsic_rrspacing (gfc_se * s
tmp = build (PLUS_EXPR, masktype, rcs.bias, fdigits);
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;