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

trans-intrinsic.c (gfc_conv_intrinsic_sign): New branchless implementation for the SIGN intrinsic with integral operands. 

* trans-intrinsic.c (gfc_conv_intrinsic_sign): New branchless
	implementation for the SIGN intrinsic with integral operands.
	(gfc_conv_intrinsic_minmax): Fix whitespace.

	* gfortran.dg/intrinsic_sign_1.f90: New test case.
	* gfortran.dg/intrinsic_sign_2.f90: Likewise.


Co-Authored-By: Brooks Moses <brooks.moses@codesourcery.com>
Co-Authored-By: Francois-Xavier Coudert <coudert@clipper.ens.fr>

From-SVN: r121009
This commit is contained in:
Roger Sayle 2007-01-20 20:05:24 +00:00 committed by Roger Sayle
parent ca6c6f643a
commit 0eadc0917a
5 changed files with 120 additions and 14 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 @@
2007-01-20 Roger Sayle <roger@eyesopen.com>
* trans-intrinsic.c (gfc_conv_intrinsic_sign): New branchless
implementation for the SIGN intrinsic with integral operands.
(gfc_conv_intrinsic_minmax): Fix whitespace.
2007-01-20 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* gfortran.h (gfc_options_t): Add flag_allow_leading_underscore.

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

@ -1,5 +1,6 @@
/* Intrinsic translation
Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
and Steven Bosscher <s.bosscher@student.tudelft.nl>
@ -1130,7 +1131,7 @@ gfc_conv_intrinsic_dim (gfc_se * se, gfc_expr * expr)
/* SIGN(A, B) is absolute value of A times sign of B.
The real value versions use library functions to ensure the correct
handling of negative zero. Integer case implemented as:
SIGN(A, B) = ((a >= 0) .xor. (b >= 0)) ? a : -a
SIGN(A, B) = { tmp = (A ^ B) >> C; (A + tmp) ^ tmp }
*/
static void
@ -1140,10 +1141,6 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
tree arg;
tree arg2;
tree type;
tree zero;
tree testa;
tree testb;
arg = gfc_conv_intrinsic_function_args (se, expr);
if (expr->ts.type == BT_REAL)
@ -1167,16 +1164,27 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
return;
}
/* Having excluded floating point types, we know we are now dealing
with signed integer types. */
arg2 = TREE_VALUE (TREE_CHAIN (arg));
arg = TREE_VALUE (arg);
type = TREE_TYPE (arg);
zero = gfc_build_const (type, integer_zero_node);
testa = fold_build2 (GE_EXPR, boolean_type_node, arg, zero);
testb = fold_build2 (GE_EXPR, boolean_type_node, arg2, zero);
tmp = fold_build2 (TRUTH_XOR_EXPR, boolean_type_node, testa, testb);
se->expr = fold_build3 (COND_EXPR, type, tmp,
build1 (NEGATE_EXPR, type, arg), arg);
/* Arg is used multiple times below. */
arg = gfc_evaluate_now (arg, &se->pre);
/* Construct (A ^ B) >> 31, which generates a bit mask of all zeros if
the signs of A and B are the same, and of all ones if they differ. */
tmp = fold_build2 (BIT_XOR_EXPR, type, arg, arg2);
tmp = fold_build2 (RSHIFT_EXPR, type, tmp,
build_int_cst (type, TYPE_PRECISION (type) - 1));
tmp = gfc_evaluate_now (tmp, &se->pre);
/* Construct (A + tmp) ^ tmp, which is A if tmp is zero, and -A if tmp]
is all ones (i.e. -1). */
se->expr = fold_build2 (BIT_XOR_EXPR, type,
fold_build2 (PLUS_EXPR, type, arg, tmp),
tmp);
}
@ -1385,7 +1393,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
limit = convert (type, limit);
/* Only evaluate the argument once. */
if (TREE_CODE (limit) != VAR_DECL && !TREE_CONSTANT (limit))
limit = gfc_evaluate_now(limit, &se->pre);
limit = gfc_evaluate_now (limit, &se->pre);
mvar = gfc_create_var (type, "M");
elsecase = build2_v (MODIFY_EXPR, mvar, limit);
@ -1397,7 +1405,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
/* Only evaluate the argument once. */
if (TREE_CODE (val) != VAR_DECL && !TREE_CONSTANT (val))
val = gfc_evaluate_now(val, &se->pre);
val = gfc_evaluate_now (val, &se->pre);
thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val));

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2007-01-20 Roger Sayle <roger@eyesopen.com>
Brooks Moses <brooks.moses@codesourcery.com>
Francois-Xavier Coudert <coudert@clipper.ens.fr>
* gfortran.dg/intrinsic_sign_1.f90: New test case.
* gfortran.dg/intrinsic_sign_2.f90: Likewise.
2007-01-19 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* gcc.dg/torture/builtin-math-3.c: Test fdim.

16
gcc/testsuite/gfortran.dg/intrinsic_sign_1.f90 Normal file
View File

@ -0,0 +1,16 @@
! { dg-do run }
! At one point, SIGN() evaluated its first argument twice.
! Contributed by Brooks Moses <brooks.moses@codesourcery.com>
program sign1
integer :: i
i = 1
if (sign(foo(i), 1) /= 1) call abort
i = 1
if (sign(foo(i), -1) /= -1) call abort
contains
integer function foo(i)
integer :: i
foo = i
i = i + 1
end function
end

69
gcc/testsuite/gfortran.dg/intrinsic_sign_2.f90 Executable file
View File

@ -0,0 +1,69 @@
! { dg-do run }
! Testcase for SIGN() with integer arguments
! Check that:
! + SIGN() evaluates its arguments only once
! + SIGN() works on large values
! + SIGN() works with parameter arguments
! Contributed by FX Coudert <fxcoudert@gmail.com>
program sign1
implicit none
integer(kind=1), parameter :: one1 = 1_1, mone1 = -1_1
integer(kind=2), parameter :: one2 = 1_2, mone2 = -1_2
integer(kind=4), parameter :: one4 = 1_4, mone4 = -1_4
integer(kind=8), parameter :: one8 = 1_8, mone8 = -1_8
integer(kind=1) :: i1, j1
integer(kind=2) :: i2, j2
integer(kind=4) :: i4, j4
integer(kind=8) :: i8, j8
integer :: i = 1
i1 = huge(0_1) ; j1 = -huge(0_1)
if (sign(i1, j1) /= j1) call abort()
if (sign(j1, i1) /= i1) call abort()
if (sign(i1,one1) /= i1 .or. sign(j1,one1) /= i1) call abort()
if (sign(i1,mone1) /= j1 .or. sign(j1,mone1) /= j1) call abort()
i2 = huge(0_2) ; j2 = -huge(0_2)
if (sign(i2, j2) /= j2) call abort()
if (sign(j2, i2) /= i2) call abort()
if (sign(i2,one2) /= i2 .or. sign(j2,one2) /= i2) call abort()
if (sign(i2,mone2) /= j2 .or. sign(j2,mone2) /= j2) call abort()
i4 = huge(0_4) ; j4 = -huge(0_4)
if (sign(i4, j4) /= j4) call abort()
if (sign(j4, i4) /= i4) call abort()
if (sign(i4,one4) /= i4 .or. sign(j4,one4) /= i4) call abort()
if (sign(i4,mone4) /= j4 .or. sign(j4,mone4) /= j4) call abort()
i8 = huge(0_8) ; j8 = -huge(0_8)
if (sign(i8, j8) /= j8) call abort()
if (sign(j8, i8) /= i8) call abort()
if (sign(i8,one8) /= i8 .or. sign(j8,one8) /= i8) call abort()
if (sign(i8,mone8) /= j8 .or. sign(j8,mone8) /= j8) call abort()
if (sign(foo(i), 1) /= 1) call abort
if (sign(foo(i), -1) /= -2) call abort
if (sign(42, foo(i)) /= 42) call abort
if (sign(42, -foo(i)) /= -42) call abort
if (i /= 5) call abort
if (sign(bar(), 1) /= 1) call abort
if (sign(bar(), -1) /= -2) call abort
if (sign(17, bar()) /= 17) call abort
if (sign(17, -bar()) /= -17) call abort
if (bar() /= 5) call abort
contains
integer function foo(i)
integer :: i
foo = i
i = i + 1
end function
integer function bar()
integer, save :: i = 0
i = i + 1
bar = i
end function
end