mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-23 05:49:11 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/37635 (Fortran 2008: Support LEADZ / TRAILZ)

Browse Source 
testsuite
	* gfortran.fortran-torture/execute/intrinsic_leadz.f90: New test.
	* gfortran.fortran-torture/execute/intrinsic_trailz.f90: New test.

fortran/
	PR fortran/37635
	* intrinsic.c (add_functions): Add LEADZ and TRAILZ as generics.
	* intrinsic.h (gfc_simplify_leadz, gfc_simplify_trailz): New protos.
	* gfortran.h <enum gfc_isym_id>: (GFC_ISYM_LEADZ, GFC_ISYM_TRAILZ): New.
	* f95-lang (gfc_init_builtin_functions): Add BUILT_IN_CLZ,
	BUILT_IN_CLZL, BUILT_IN_CLZLL, BUILT_IN_CTZ, BUILT_IN_CTZL, and
	BUILT_IN_CTZLL.
	* trans-intrinsic.c (gfc_conv_intrinsic_leadz,
	gfc_conv_intrinsic_trails): New code-generation functions for LEADZ
	and TRAILZ intrinsics.
	(gfc_conv_intrinsic_function): Use them
	* intrinsic.texi: Add documentation for LEADZ and TRAILZ.
	* simplify.c (gfc_simplify_leadz, gfc_simplify_trailz): New functions.

From-SVN: r140837
This commit is contained in:
Steven Bosscher 2008-10-02 18:51:12 +00:00
parent 3057d7cfab
commit 414f00e997
11 changed files with 433 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/fortran/ChangeLog
View File

@ -1,3 +1,19 @@
2008-10-02 Steven Bosscher <steven@gcc.gnu.org>
PR fortran/37635
* intrinsic.c (add_functions): Add LEADZ and TRAILZ as generics.
* intrinsic.h (gfc_simplify_leadz, gfc_simplify_trailz): New protos.
* gfortran.h <enum gfc_isym_id>: (GFC_ISYM_LEADZ, GFC_ISYM_TRAILZ): New.
* f95-lang (gfc_init_builtin_functions): Add BUILT_IN_CLZ,
BUILT_IN_CLZL, BUILT_IN_CLZLL, BUILT_IN_CTZ, BUILT_IN_CTZL, and
BUILT_IN_CTZLL.
* trans-intrinsic.c (gfc_conv_intrinsic_leadz,
gfc_conv_intrinsic_trails): New code-generation functions for LEADZ
and TRAILZ intrinsics.
(gfc_conv_intrinsic_function): Use them
* intrinsic.texi: Add documentation for LEADZ and TRAILZ.
* simplify.c (gfc_simplify_leadz, gfc_simplify_trailz): New functions.
2008-09-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/36592

31
gcc/fortran/f95-lang.c
View File

@ -1003,6 +1003,37 @@ gfc_init_builtin_functions (void)
BUILT_IN_SINCOSF, "sincosf", false);
}
/* For LEADZ / TRAILZ. */
tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
"__builtin_clz", true);
tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
"__builtin_clzl", true);
tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
"__builtin_clzll", true);
tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
"__builtin_ctz", true);
tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
"__builtin_ctzl", true);
tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
"__builtin_ctzll", true);
/* Other builtin functions we use. */
tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);

2
gcc/fortran/gfortran.h
View File

@ -417,6 +417,7 @@ enum gfc_isym_id
GFC_ISYM_KILL,
GFC_ISYM_KIND,
GFC_ISYM_LBOUND,
GFC_ISYM_LEADZ,
GFC_ISYM_LEN,
GFC_ISYM_LEN_TRIM,
GFC_ISYM_LGAMMA,
@ -503,6 +504,7 @@ enum gfc_isym_id
GFC_ISYM_TIME,
GFC_ISYM_TIME8,
GFC_ISYM_TINY,
GFC_ISYM_TRAILZ,
GFC_ISYM_TRANSFER,
GFC_ISYM_TRANSPOSE,
GFC_ISYM_TRIM,

14
gcc/fortran/intrinsic.c
View File

@ -1781,6 +1781,13 @@ add_functions (void)
make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
BT_INTEGER, di, GFC_STD_F2008,
gfc_check_i, gfc_simplify_leadz, NULL,
i, BT_INTEGER, di, REQUIRED);
make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
BT_INTEGER, di, GFC_STD_F77,
gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
@ -2388,6 +2395,13 @@ add_functions (void)
make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
BT_INTEGER, di, GFC_STD_F2008,
gfc_check_i, gfc_simplify_trailz, NULL,
i, BT_INTEGER, di, REQUIRED);
make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,

2
gcc/fortran/intrinsic.h
View File

@ -259,6 +259,7 @@ gfc_expr *gfc_simplify_ishft (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_kind (gfc_expr *);
gfc_expr *gfc_simplify_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_leadz (gfc_expr *);
gfc_expr *gfc_simplify_len (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_len_trim (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_lgamma (gfc_expr *);
@ -310,6 +311,7 @@ gfc_expr *gfc_simplify_sqrt (gfc_expr *);
gfc_expr *gfc_simplify_tan (gfc_expr *);
gfc_expr *gfc_simplify_tanh (gfc_expr *);
gfc_expr *gfc_simplify_tiny (gfc_expr *);
gfc_expr *gfc_simplify_trailz (gfc_expr *);
gfc_expr *gfc_simplify_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_trim (gfc_expr *);
gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *);

82
gcc/fortran/intrinsic.texi
View File

@ -164,6 +164,7 @@ Some basic guidelines for editing this document:
* @code{KILL}: KILL, Send a signal to a process
* @code{KIND}: KIND, Kind of an entity
* @code{LBOUND}: LBOUND, Lower dimension bounds of an array
* @code{LEADZ}: LEADZ, Number of leading zero bits of an integer
* @code{LEN}: LEN, Length of a character entity
* @code{LEN_TRIM}: LEN_TRIM, Length of a character entity without trailing blank characters
* @code{LOG_GAMMA}: LOG_GAMMA, Logarithm of the Gamma function
@ -252,6 +253,7 @@ Some basic guidelines for editing this document:
* @code{TIME}: TIME, Time function
* @code{TIME8}: TIME8, Time function (64-bit)
* @code{TINY}: TINY, Smallest positive number of a real kind
* @code{TRAILZ}: TRAILZ, Number of trailing zero bits of an integer
* @code{TRANSFER}: TRANSFER, Transfer bit patterns
* @code{TRANSPOSE}: TRANSPOSE, Transpose an array of rank two
* @code{TRIM}: TRIM, Remove trailing blank characters of a string
@ -6504,6 +6506,46 @@ dimension, the lower bound is taken to be 1.
@node LEADZ
@section @code{LEADZ} --- Number of leading zero bits of an integer
@fnindex LEADZ
@cindex zero bits
@table @asis
@item @emph{Description}:
@code{LEADZ} returns the number of leading zero bits of an integer.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = LEADZ(I)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{I} @tab Shall be of type @code{INTEGER}.
@end multitable
@item @emph{Return value}:
The type of the return value is the default @code{INTEGER}.
If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}.
@item @emph{Example}:
@smallexample
PROGRAM test_leadz
WRITE (*,*) LEADZ(1) ! prints 8 if BITSIZE(I) has the value 32
END PROGRAM
@end smallexample
@item @emph{See also}:
@ref{BIT_SIZE}, @ref{TRAILZ}
@end table
@node LEN
@section @code{LEN} --- Length of a character entity
@fnindex LEN
@ -10642,6 +10684,46 @@ See @code{HUGE} for an example.
@node TRAILZ
@section @code{TRAILZ} --- Number of trailing zero bits of an integer
@fnindex TRAILZ
@cindex zero bits
@table @asis
@item @emph{Description}:
@code{TRAILZ} returns the number of trailing zero bits of an integer.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = TRAILZ(I)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{I} @tab Shall be of type @code{INTEGER}.
@end multitable
@item @emph{Return value}:
The type of the return value is the default @code{INTEGER}.
If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}.
@item @emph{Example}:
@smallexample
PROGRAM test_trailz
WRITE (*,*) TRAILZ(8) ! prints 3
END PROGRAM
@end smallexample
@item @emph{See also}:
@ref{BIT_SIZE}, @ref{LEADZ}
@end table
@node TRANSFER
@section @code{TRANSFER} --- Transfer bit patterns
@fnindex TRANSFER

45
gcc/fortran/simplify.c
View File

@ -2399,6 +2399,30 @@ gfc_simplify_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
}
gfc_expr *
gfc_simplify_leadz (gfc_expr *e)
{
gfc_expr *result;
unsigned long lz, bs;
int i;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
bs = gfc_integer_kinds[i].bit_size;
if (mpz_cmp_si (e->value.integer, 0) == 0)
lz = bs;
else
lz = bs - mpz_sizeinbase (e->value.integer, 2);
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where);
mpz_set_ui (result->value.integer, lz);
return result;
}
gfc_expr *
gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
{
@ -4337,6 +4361,27 @@ gfc_simplify_tiny (gfc_expr *e)
}
gfc_expr *
gfc_simplify_trailz (gfc_expr *e)
{
gfc_expr *result;
unsigned long tz, bs;
int i;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
bs = gfc_integer_kinds[i].bit_size;
tz = mpz_scan1 (e->value.integer, 0);
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where);
mpz_set_ui (result->value.integer, MIN (tz, bs));
return result;
}
gfc_expr *
gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
{

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

@ -2653,6 +2653,141 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
se->expr = fold_build3 (COND_EXPR, type, tmp, args[0], rrot);
}
/* LEADZ (i) = (i == 0) ? BIT_SIZE (i)
: __builtin_clz(i) - (BIT_SIZE('int') - BIT_SIZE(i))
The conditional expression is necessary because the result of LEADZ(0)
is defined, but the result of __builtin_clz(0) is undefined for most
targets.
For INTEGER kinds smaller than the C 'int' type, we have to subtract the
difference in bit size between the argument of LEADZ and the C int. */
static void
gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
{
tree arg;
tree arg_type;
tree cond;
tree result_type;
tree leadz;
tree bit_size;
tree tmp;
int arg_kind;
int i, n, s;
gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
/* Which variant of __builtin_clz* should we call? */
arg_kind = expr->value.function.actual->expr->ts.kind;
i = gfc_validate_kind (BT_INTEGER, arg_kind, false);
switch (arg_kind)
{
case 1:
case 2:
case 4:
arg_type = unsigned_type_node;
n = BUILT_IN_CLZ;
break;
case 8:
arg_type = long_unsigned_type_node;
n = BUILT_IN_CLZL;
break;
case 16:
arg_type = long_long_unsigned_type_node;
n = BUILT_IN_CLZLL;
break;
default:
gcc_unreachable ();
}
/* Convert the actual argument to the proper argument type for the built-in
function. But the return type is of the default INTEGER kind. */
arg = fold_convert (arg_type, arg);
result_type = gfc_get_int_type (gfc_default_integer_kind);
/* Compute LEADZ for the case i .ne. 0. */
s = TYPE_PRECISION (arg_type) - gfc_integer_kinds[i].bit_size;
tmp = fold_convert (result_type, build_call_expr (built_in_decls[n], 1, arg));
leadz = fold_build2 (MINUS_EXPR, result_type,
tmp, build_int_cst (result_type, s));
/* Build BIT_SIZE. */
bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size);
/* ??? For some combinations of targets and integer kinds, the condition
can be avoided if CLZ_DEFINED_VALUE_AT_ZERO is used. Later. */
cond = fold_build2 (EQ_EXPR, boolean_type_node,
arg, build_int_cst (arg_type, 0));
se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, leadz);
}
/* TRAILZ(i) = (i == 0) ? BIT_SIZE (i) : __builtin_ctz(i)
The conditional expression is necessary because the result of TRAILZ(0)
is defined, but the result of __builtin_ctz(0) is undefined for most
targets. */
static void
gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr)
{
tree arg;
tree arg_type;
tree cond;
tree result_type;
tree trailz;
tree bit_size;
int arg_kind;
int i, n;
gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
/* Which variant of __builtin_clz* should we call? */
arg_kind = expr->value.function.actual->expr->ts.kind;
i = gfc_validate_kind (BT_INTEGER, arg_kind, false);
switch (expr->ts.kind)
{
case 1:
case 2:
case 4:
arg_type = unsigned_type_node;
n = BUILT_IN_CTZ;
break;
case 8:
arg_type = long_unsigned_type_node;
n = BUILT_IN_CTZL;
break;
case 16:
arg_type = long_long_unsigned_type_node;
n = BUILT_IN_CTZLL;
break;
default:
gcc_unreachable ();
}
/* Convert the actual argument to the proper argument type for the built-in
function. But the return type is of the default INTEGER kind. */
arg = fold_convert (arg_type, arg);
result_type = gfc_get_int_type (gfc_default_integer_kind);
/* Compute TRAILZ for the case i .ne. 0. */
trailz = fold_convert (result_type, build_call_expr (built_in_decls[n], 1, arg));
/* Build BIT_SIZE. */
bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size);
/* ??? For some combinations of targets and integer kinds, the condition
can be avoided if CTZ_DEFINED_VALUE_AT_ZERO is used. Later. */
cond = fold_build2 (EQ_EXPR, boolean_type_node,
arg, build_int_cst (arg_type, 0));
se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, trailz);
}
/* Process an intrinsic with unspecified argument-types that has an optional
argument (which could be of type character), e.g. EOSHIFT. For those, we
@ -4482,6 +4617,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_ishftc (se, expr);
break;
case GFC_ISYM_LEADZ:
gfc_conv_intrinsic_leadz (se, expr);
break;
case GFC_ISYM_TRAILZ:
gfc_conv_intrinsic_trailz (se, expr);
break;
case GFC_ISYM_LBOUND:
gfc_conv_intrinsic_bound (se, expr, 0);
break;

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2008-10-02 Steven Bosscher <steven@gcc.gnu.org>
PR fortran/37635
* gfortran.fortran-torture/execute/intrinsic_leadz.f90: New test.
* gfortran.fortran-torture/execute/intrinsic_trailz.f90: New test.
2008-10-02 Janis Johnson <janis187@us.ibm.com>
* gcc.dg/torture/pr36891.c: Ignore an irrelevant warning.

46
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_leadz.f90 Normal file
View File

@ -0,0 +1,46 @@
program test_intrinsic_leadz
implicit none
call test_leadz(0_1,0_2,0_4,0_8,1_1,1_2,1_4,1_8,8_1,8_2,8_4,8_8)
stop
contains
subroutine test_leadz(z1,z2,z4,z8,i1,i2,i4,i8,e1,e2,e4,e8)
integer(kind=1) :: z1, i1, e1
integer(kind=2) :: z2, i2, e2
integer(kind=4) :: z4, i4, e4
integer(kind=8) :: z8, i8, e8
if (leadz(0_1) /= 8) call abort()
if (leadz(0_2) /= 16) call abort()
if (leadz(0_4) /= 32) call abort()
if (leadz(0_8) /= 64) call abort()
if (leadz(1_1) /= 7) call abort()
if (leadz(1_2) /= 15) call abort()
if (leadz(1_4) /= 31) call abort()
if (leadz(1_8) /= 63) call abort()
if (leadz(8_1) /= 4) call abort()
if (leadz(8_2) /= 12) call abort()
if (leadz(8_4) /= 28) call abort()
if (leadz(8_8) /= 60) call abort()
if (leadz(z1) /= 8) call abort()
if (leadz(z2) /= 16) call abort()
if (leadz(z4) /= 32) call abort()
if (leadz(z8) /= 64) call abort()
if (leadz(i1) /= 7) call abort()
if (leadz(i2) /= 15) call abort()
if (leadz(i4) /= 31) call abort()
if (leadz(i8) /= 63) call abort()
if (leadz(e1) /= 4) call abort()
if (leadz(e2) /= 12) call abort()
if (leadz(e4) /= 28) call abort()
if (leadz(e8) /= 60) call abort()
end subroutine test_leadz
end program

46
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trailz.f90 Normal file
View File

@ -0,0 +1,46 @@
program test_intrinsic_trailz
implicit none
call test_trailz(0_1,0_2,0_4,0_8,1_1,1_2,1_4,1_8,8_1,8_2,8_4,8_8)
stop
contains
subroutine test_trailz(z1,z2,z4,z8,i1,i2,i4,i8,e1,e2,e4,e8)
integer(kind=1) :: z1, i1, e1
integer(kind=2) :: z2, i2, e2
integer(kind=4) :: z4, i4, e4
integer(kind=8) :: z8, i8, e8
if (trailz(0_1) /= 8) call abort()
if (trailz(0_2) /= 16) call abort()
if (trailz(0_4) /= 32) call abort()
if (trailz(0_8) /= 64) call abort()
if (trailz(1_1) /= 0) call abort()
if (trailz(1_2) /= 0) call abort()
if (trailz(1_4) /= 0) call abort()
if (trailz(1_8) /= 0) call abort()
if (trailz(8_1) /= 3) call abort()
if (trailz(8_2) /= 3) call abort()
if (trailz(8_4) /= 3) call abort()
if (trailz(8_8) /= 3) call abort()
if (trailz(z1) /= 8) call abort()
if (trailz(z2) /= 16) call abort()
if (trailz(z4) /= 32) call abort()
if (trailz(z8) /= 64) call abort()
if (trailz(i1) /= 0) call abort()
if (trailz(i2) /= 0) call abort()
if (trailz(i4) /= 0) call abort()
if (trailz(i8) /= 0) call abort()
if (trailz(e1) /= 3) call abort()
if (trailz(e2) /= 3) call abort()
if (trailz(e4) /= 3) call abort()
if (trailz(e8) /= 3) call abort()
end subroutine test_trailz
end program