This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[gfortran, patch] Fix pr15441
- From: Feng Wang <fengwang at nudt dot edu dot cn>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot or
- Date: Sat, 18 Sep 2004 00:17:15 +0800 (HKT)
- Subject: [gfortran, patch] Fix pr15441
- Reply-to: Feng Wang <fengwang at nudt dot edu dot cn>
This patch just fixes some comments and adds some
foldings. See http://gcc.gnu.org/bugzilla/show_bug.cgi?
id=15441, the discussion with Tobi.
Regards,
Feng Wang
ChangeLog entry:
2004-09-14 Feng Wang <fengwang@nudt.edu.cn>
* trans-intrinsic.c: Fix comments on spacing
and rrspacing
(gfc_conv_intrinsic_rrspacing): Add fold on
constant trees.
*** trans-intrinsic.c 2004/09/15 00:09:39 1.1
--- trans-intrinsic.c 2004/09/16 17:25:38
*************** typedef struct
*** 138,145 ****
tree smask; /* Constant tree of sign's mask. */
tree emask; /* Constant tree of exponent's mask. */
tree fmask; /* Constant tree of fraction's mask. */
! tree edigits; /* Constant tree of bit numbers of exponent. */
! tree fdigits; /* Constant tree of bit numbers of fraction. */
tree f1; /* Constant tree of the f1 defined in the real model. */
tree bias; /* Constant tree of the bias of exponent in the memory. */
tree type; /* Type tree of arg1. */
--- 138,145 ----
tree smask; /* Constant tree of sign's mask. */
tree emask; /* Constant tree of exponent's mask. */
tree fmask; /* Constant tree of fraction's mask. */
! tree edigits; /* Constant tree of the number of exponent bits. */
! tree fdigits; /* Constant tree of the number of fraction bits. */
tree f1; /* Constant tree of the f1 defined in the real model. */
tree bias; /* Constant tree of the bias of exponent in the memory. */
tree type; /* Type tree of arg1. */
*************** call_builtin_clz (tree result_type, tree
*** 2409,2419 ****
return convert (result_type, call);
}
! /* Generate code for SPACING (X) intrinsic function. We generate:
! t = expn - (BITS_OF_FRACTION)
! res = t << (BITS_OF_FRACTION)
! if (t < 0)
res = tiny(X)
*/
--- 2409,2422 ----
return convert (result_type, call);
}
! /* Generate code for SPACING (X) intrinsic function.
! SPACING (X) = POW (2, e-p)
!
! We generate:
! t = expn - fdigits // e - p.
! res = t << fdigits // Form the exponent. Fraction is zero.
! if (t < 0) // The result is out of range. Denormalized case.
res = tiny(X)
*/
*************** gfc_conv_intrinsic_spacing (gfc_se * se,
*** 2444,2464 ****
se->expr = tmp;
}
! /* Generate code for RRSPACING (X) intrinsic function. We generate:
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;
*/
static void
--- 2447,2480 ----
se->expr = tmp;
}
! /* Generate code for RRSPACING (X) intrinsic function.
! RRSPACING (X) = |X * POW (2, -e)| * POW (2, p) = |FRACTION (X)| * POW (2, p)
!
! So the result's exponenet is p. And if X is normalized, X's fraction part
! is the result's fraction. If X is denormalized, to get the X's fraction we
! shift X's fraction part to left until the first '1' is removed.
!
! We generate:
if (expn == 0 && frac == 0)
res = 0;
else
{
+ // edigits is the number of exponent bits. Add the sign bit.
sedigits = edigits + 1;
!
! if (expn == 0) // Denormalized case.
{
t1 = leadzero (frac);
! frac = frac << (t1 + 1); //Remove the first '1'.
! frac = frac >> (sedigits); //Form the fraction.
}
!
! //fdigits is the number of fraction bits. Form the exponent.
! t = bias + fdigits;
!
! res = (t << fdigits) | frac;
! }
*/
static void
*************** gfc_conv_intrinsic_rrspacing (gfc_se * s
*** 2476,2482 ****
fraction = rcs.frac;
one = gfc_build_const (masktype, integer_one_node);
zero = gfc_build_const (masktype, integer_zero_node);
! t2 = build2 (PLUS_EXPR, masktype, rcs.edigits, one);
t1 = call_builtin_clz (masktype, fraction);
tmp = build2 (PLUS_EXPR, masktype, t1, one);
--- 2492,2498 ----
fraction = rcs.frac;
one = gfc_build_const (masktype, integer_one_node);
zero = gfc_build_const (masktype, integer_zero_node);
! t2 = fold (build2 (PLUS_EXPR, masktype, rcs.edigits, one));
t1 = call_builtin_clz (masktype, fraction);
tmp = build2 (PLUS_EXPR, masktype, t1, one);
*************** gfc_conv_intrinsic_rrspacing (gfc_se * s
*** 2485,2492 ****
cond = build2 (EQ_EXPR, boolean_type_node, rcs.expn, zero);
fraction = build3 (COND_EXPR, masktype, cond, tmp, fraction);
! tmp = build2 (PLUS_EXPR, masktype, rcs.bias, fdigits);
! tmp = build2 (LSHIFT_EXPR, masktype, tmp, fdigits);
tmp = build2 (BIT_IOR_EXPR, masktype, tmp, fraction);
cond2 = build2 (EQ_EXPR, boolean_type_node, rcs.frac, zero);
--- 2501,2508 ----
cond = build2 (EQ_EXPR, boolean_type_node, rcs.expn, zero);
fraction = build3 (COND_EXPR, masktype, cond, tmp, fraction);
! tmp = fold (build2 (PLUS_EXPR, masktype, rcs.bias, fdigits));
! tmp = fold (build2 (LSHIFT_EXPR, masktype, tmp, fdigits));
tmp = build2 (BIT_IOR_EXPR, masktype, tmp, fraction);
cond2 = build2 (EQ_EXPR, boolean_type_node, rcs.frac, zero);