procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/38282 (Bit intrinsics: ILEN and IBCHNG)

Browse source 
PR fortran/38282

	* f95-lang.c (gfc_init_builtin_functions): Define popcount{,l,ll}
	and parity{,l,ll} builtins.
	* trans-intrinsic.c (gfc_conv_intrinsic_popcnt_poppar): New function.
	(gfc_conv_intrinsic_function): Call above new functions.
	* simplify.c (gfc_simplify_popcnt, gfc_simplify_poppar): New
	functions.
	* intrinsic.texi: Document POPCNT and POPPAR.

	* gfortran.dg/popcnt_poppar_1.F90: New test.
	* gfortran.dg/popcnt_poppar_2.F90: New test.

From-SVN: r163691
This commit is contained in:
Francois-Xavier Coudert 2010-08-31 18:56:46 +00:00 • committed by François-Xavier Coudert
parent 18dbb85903
commit ad5f4de228
11 changed files with 432 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View file

@ -1,3 +1,14 @@
2010-08-31 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/38282
* f95-lang.c (gfc_init_builtin_functions): Define popcount{,l,ll}
and parity{,l,ll} builtins.
* trans-intrinsic.c (gfc_conv_intrinsic_popcnt_poppar): New function.
(gfc_conv_intrinsic_function): Call above new functions.
* simplify.c (gfc_simplify_popcnt, gfc_simplify_poppar): New
functions.
* intrinsic.texi: Document POPCNT and POPPAR.
2010-08-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/45456

14
gcc/fortran/f95-lang.c
View file

@ -938,13 +938,17 @@ gfc_init_builtin_functions (void)
BUILT_IN_SINCOSF, "sincosf", false);
}
/* For LEADZ / TRAILZ. */
/* For LEADZ, TRAILZ, POPCNT and POPAR. */
ftype = build_function_type_list (integer_type_node,
unsigned_type_node, NULL_TREE);
gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
"__builtin_clz", true);
gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
"__builtin_ctz", true);
gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
"__builtin_parity", true);
gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
"__builtin_popcount", true);
ftype = build_function_type_list (integer_type_node,
long_unsigned_type_node, NULL_TREE);
@ -952,6 +956,10 @@ gfc_init_builtin_functions (void)
"__builtin_clzl", true);
gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
"__builtin_ctzl", true);
gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
"__builtin_parityl", true);
gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
"__builtin_popcountl", true);
ftype = build_function_type_list (integer_type_node,
long_long_unsigned_type_node, NULL_TREE);
@ -959,6 +967,10 @@ gfc_init_builtin_functions (void)
"__builtin_clzll", true);
gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
"__builtin_ctzll", true);
gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
"__builtin_parityll", true);
gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
"__builtin_popcountll", true);
/* Other builtin functions we use. */

2
gcc/fortran/gfortran.h
View file

@ -472,6 +472,8 @@ enum gfc_isym_id
GFC_ISYM_PACK,
GFC_ISYM_PARITY,
GFC_ISYM_PERROR,
GFC_ISYM_POPCNT,
GFC_ISYM_POPPAR,
GFC_ISYM_PRECISION,
GFC_ISYM_PRESENT,
GFC_ISYM_PRODUCT,

14
gcc/fortran/intrinsic.c
View file

@ -2299,6 +2299,20 @@ add_functions (void)
make_generic ("parity", GFC_ISYM_PARITY, GFC_STD_F2008);
add_sym_1 ("popcnt", GFC_ISYM_POPCNT, CLASS_ELEMENTAL, ACTUAL_NO,
BT_INTEGER, di, GFC_STD_F2008,
gfc_check_i, gfc_simplify_popcnt, NULL,
i, BT_INTEGER, di, REQUIRED);
make_generic ("popcnt", GFC_ISYM_POPCNT, GFC_STD_F2008);
add_sym_1 ("poppar", GFC_ISYM_POPPAR, CLASS_ELEMENTAL, ACTUAL_NO,
BT_INTEGER, di, GFC_STD_F2008,
gfc_check_i, gfc_simplify_poppar, NULL,
i, BT_INTEGER, di, REQUIRED);
make_generic ("poppar", GFC_ISYM_POPPAR, GFC_STD_F2008);
add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
gfc_check_precision, gfc_simplify_precision, NULL,
x, BT_UNKNOWN, 0, REQUIRED);

2
gcc/fortran/intrinsic.h
View file

@ -317,6 +317,8 @@ gfc_expr *gfc_simplify_not (gfc_expr *);
gfc_expr *gfc_simplify_or (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_pack (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_parity (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_popcnt (gfc_expr *);
gfc_expr *gfc_simplify_poppar (gfc_expr *);
gfc_expr *gfc_simplify_precision (gfc_expr *);
gfc_expr *gfc_simplify_product (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_radix (gfc_expr *);

95
gcc/fortran/intrinsic.texi
View file

@ -211,6 +211,8 @@ Some basic guidelines for editing this document:
* @code{PACK}: PACK, Pack an array into an array of rank one
* @code{PARITY}: PARITY, Reduction with exclusive OR
* @code{PERROR}: PERROR, Print system error message
* @code{POPCNT}: POPCNT, Number of bits set
* @code{POPPAR}: POPPAR, Parity of the number of bits set
* @code{PRECISION}: PRECISION, Decimal precision of a real kind
* @code{PRESENT}: PRESENT, Determine whether an optional dummy argument is specified
* @code{PRODUCT}: PRODUCT, Product of array elements
@ -6719,7 +6721,7 @@ END PROGRAM
@end smallexample
@item @emph{See also}:
@ref{BIT_SIZE}, @ref{TRAILZ}
@ref{BIT_SIZE}, @ref{TRAILZ}, @ref{POPCNT}, @ref{POPPAR}
@end table
@ -8899,6 +8901,95 @@ end program prec_and_range
@node POPCNT
@section @code{POPCNT} --- Number of bits set
@fnindex POPCNT
@cindex binary representation
@cindex bits set
@table @asis
@item @emph{Description}:
@code{POPCNT(I)} returns the number of bits set ('1' bits) in the binary
representation of @code{I}.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = POPCNT(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 return value is of type @code{INTEGER} and of the default integer
kind.
@item @emph{See also}:
@ref{POPPAR}, @ref{LEADZ}, @ref{TRAILZ}
@item @emph{Example}:
@smallexample
program test_population
print *, popcnt(127), poppar(127)
print *, popcnt(huge(0_4)), poppar(huge(0_4))
print *, popcnt(huge(0_8)), poppar(huge(0_8))
end program test_population
@end smallexample
@end table
@node POPPAR
@section @code{POPPAR} --- Parity of the number of bits set
@fnindex POPPAR
@cindex binary representation
@cindex parity
@table @asis
@item @emph{Description}:
@code{POPPAR(I)} returns parity of the integer @code{I}, i.e. the parity
of the number of bits set ('1' bits) in the binary representation of
@code{I}. It is equal to 0 if @code{I} has an even number of bits set,
and 1 for an odd number of '1' bits.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Elemental function
@item @emph{Syntax}:
@code{RESULT = POPPAR(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 return value is of type @code{INTEGER} and of the default integer
kind.
@item @emph{See also}:
@ref{POPCNT}, @ref{LEADZ}, @ref{TRAILZ}
@item @emph{Example}:
@smallexample
program test_population
print *, popcnt(127), poppar(127)
print *, popcnt(huge(0_4)), poppar(huge(0_4))
print *, popcnt(huge(0_8)), poppar(huge(0_8))
end program test_population
@end smallexample
@end table
@node PRESENT
@section @code{PRESENT} --- Determine whether an optional dummy argument is specified
@fnindex PRESENT
@ -11228,7 +11319,7 @@ END PROGRAM
@end smallexample
@item @emph{See also}:
@ref{BIT_SIZE}, @ref{LEADZ}
@ref{BIT_SIZE}, @ref{LEADZ}, @ref{POPPAR}, @ref{POPCNT}
@end table

41
gcc/fortran/simplify.c
View file

@ -4292,6 +4292,47 @@ gfc_simplify_parity (gfc_expr *e, gfc_expr *dim)
}
gfc_expr *
gfc_simplify_popcnt (gfc_expr *e)
{
int res, k;
mpz_t x;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
/* Convert argument to unsigned, then count the '1' bits. */
mpz_init_set (x, e->value.integer);
convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
res = mpz_popcount (x);
mpz_clear (x);
return gfc_get_int_expr (gfc_default_integer_kind, &e->where, res);
}
gfc_expr *
gfc_simplify_poppar (gfc_expr *e)
{
gfc_expr *popcnt;
const char *s;
int i;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
popcnt = gfc_simplify_popcnt (e);
gcc_assert (popcnt);
s = gfc_extract_int (popcnt, &i);
gcc_assert (!s);
return gfc_get_int_expr (gfc_default_integer_kind, &e->where, i % 2);
}
gfc_expr *
gfc_simplify_precision (gfc_expr *e)
{

90
gcc/fortran/trans-intrinsic.c
View file

@ -3476,6 +3476,88 @@ gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr)
se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, trailz);
}
/* Using __builtin_popcount for POPCNT and __builtin_parity for POPPAR;
for types larger than "long long", we call the long long built-in for
the lower and higher bits and combine the result. */
static void
gfc_conv_intrinsic_popcnt_poppar (gfc_se * se, gfc_expr *expr, int parity)
{
tree arg;
tree arg_type;
tree result_type;
tree func;
int argsize;
gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
argsize = TYPE_PRECISION (TREE_TYPE (arg));
result_type = gfc_get_int_type (gfc_default_integer_kind);
/* Which variant of the builtin should we call? */
if (argsize <= INT_TYPE_SIZE)
{
arg_type = unsigned_type_node;
func = built_in_decls[parity ? BUILT_IN_PARITY : BUILT_IN_POPCOUNT];
}
else if (argsize <= LONG_TYPE_SIZE)
{
arg_type = long_unsigned_type_node;
func = built_in_decls[parity ? BUILT_IN_PARITYL : BUILT_IN_POPCOUNTL];
}
else if (argsize <= LONG_LONG_TYPE_SIZE)
{
arg_type = long_long_unsigned_type_node;
func = built_in_decls[parity ? BUILT_IN_PARITYLL : BUILT_IN_POPCOUNTLL];
}
else
{
/* Our argument type is larger than 'long long', which mean none
of the POPCOUNT builtins covers it. We thus call the 'long long'
variant multiple times, and add the results. */
tree utype, arg2, call1, call2;
/* For now, we only cover the case where argsize is twice as large
as 'long long'. */
gcc_assert (argsize == 2 * LONG_LONG_TYPE_SIZE);
func = built_in_decls[parity ? BUILT_IN_PARITYLL : BUILT_IN_POPCOUNTLL];
/* Convert it to an integer, and store into a variable. */
utype = gfc_build_uint_type (argsize);
arg = fold_convert (utype, arg);
arg = gfc_evaluate_now (arg, &se->pre);
/* Call the builtin twice. */
call1 = build_call_expr_loc (input_location, func, 1,
fold_convert (long_long_unsigned_type_node,
arg));
arg2 = fold_build2 (RSHIFT_EXPR, utype, arg,
build_int_cst (utype, LONG_LONG_TYPE_SIZE));
call2 = build_call_expr_loc (input_location, func, 1,
fold_convert (long_long_unsigned_type_node,
arg2));
/* Combine the results. */
if (parity)
se->expr = fold_build2 (BIT_XOR_EXPR, result_type, call1, call2);
else
se->expr = fold_build2 (PLUS_EXPR, result_type, call1, call2);
return;
}
/* Convert the actual argument twice: first, to the unsigned type of the
same size; then, to the proper argument type for the built-in
function. */
arg = fold_convert (gfc_build_uint_type (argsize), arg);
arg = fold_convert (arg_type, arg);
se->expr = fold_convert (result_type,
build_call_expr_loc (input_location, func, 1, arg));
}
/* Process an intrinsic with unspecified argument-types that has an optional
argument (which could be of type character), e.g. EOSHIFT. For those, we
need to append the string length of the optional argument if it is not
@ -5418,6 +5500,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_trailz (se, expr);
break;
case GFC_ISYM_POPCNT:
gfc_conv_intrinsic_popcnt_poppar (se, expr, 0);
break;
case GFC_ISYM_POPPAR:
gfc_conv_intrinsic_popcnt_poppar (se, expr, 1);
break;
case GFC_ISYM_LBOUND:
gfc_conv_intrinsic_bound (se, expr, 0);
break;

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2010-08-31 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/38282
* gfortran.dg/popcnt_poppar_1.F90: New test.
* gfortran.dg/popcnt_poppar_2.F90: New test.
2010-08-31 Uros Bizjak <ubizjak@gmail.com>
* gcc.target/i386/volatile-2.c: Require nonpic target.

121
gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90 Normal file
View file

@ -0,0 +1,121 @@
! { dg-do run }
! { dg-options "-ffree-line-length-none" }
interface runtime_popcnt
procedure runtime_popcnt_i1
procedure runtime_popcnt_i2
procedure runtime_popcnt_i4
procedure runtime_popcnt_i8
end interface
interface runtime_poppar
procedure runtime_poppar_i1
procedure runtime_poppar_i2
procedure runtime_poppar_i4
procedure runtime_poppar_i8
end interface
#define CHECK(val,res) \
if (popcnt(val) /= res) call abort ; \
if (runtime_popcnt(val) /= res) call abort
#define CHECK2(val) \
if (poppar(val) /= modulo(popcnt(val),2)) call abort ; \
if (runtime_poppar(val) /= poppar(val)) call abort
CHECK(0_1, 0)
CHECK(0_2, 0)
CHECK(0_4, 0)
CHECK(0_8, 0)
CHECK(1_1, 1)
CHECK(1_2, 1)
CHECK(1_4, 1)
CHECK(1_8, 1)
CHECK(-1_1,8)
CHECK(-1_2,16)
CHECK(-1_4,32)
CHECK(-1_8,64)
CHECK(-8_1,8-3)
CHECK(-8_2,16-3)
CHECK(-8_4,32-3)
CHECK(-8_8,64-3)
CHECK(huge(0_1), 8-1)
CHECK(huge(0_2), 16-1)
CHECK(huge(0_4), 32-1)
CHECK(huge(0_8), 64-1)
CHECK(-huge(0_1), 2)
CHECK(-huge(0_2), 2)
CHECK(-huge(0_4), 2)
CHECK(-huge(0_8), 2)
CHECK2(0_1)
CHECK2(0_2)
CHECK2(0_4)
CHECK2(0_8)
CHECK2(17_1)
CHECK2(17_2)
CHECK2(17_4)
CHECK2(17_8)
CHECK2(-17_1)
CHECK2(-17_2)
CHECK2(-17_4)
CHECK2(-17_8)
CHECK2(huge(0_1))
CHECK2(huge(0_2))
CHECK2(huge(0_4))
CHECK2(huge(0_8))
CHECK2(-huge(0_1))
CHECK2(-huge(0_2))
CHECK2(-huge(0_4))
CHECK2(-huge(0_8))
contains
integer function runtime_popcnt_i1 (i) result(res)
integer(kind=1), intent(in) :: i
res = popcnt(i)
end function
integer function runtime_popcnt_i2 (i) result(res)
integer(kind=2), intent(in) :: i
res = popcnt(i)
end function
integer function runtime_popcnt_i4 (i) result(res)
integer(kind=4), intent(in) :: i
res = popcnt(i)
end function
integer function runtime_popcnt_i8 (i) result(res)
integer(kind=8), intent(in) :: i
res = popcnt(i)
end function
integer function runtime_poppar_i1 (i) result(res)
integer(kind=1), intent(in) :: i
res = poppar(i)
end function
integer function runtime_poppar_i2 (i) result(res)
integer(kind=2), intent(in) :: i
res = poppar(i)
end function
integer function runtime_poppar_i4 (i) result(res)
integer(kind=4), intent(in) :: i
res = poppar(i)
end function
integer function runtime_poppar_i8 (i) result(res)
integer(kind=8), intent(in) :: i
res = poppar(i)
end function
end

39
gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90 Normal file
View file

@ -0,0 +1,39 @@
! { dg-do run }
! { dg-options "-ffree-line-length-none" }
! { dg-require-effective-target fortran_integer_16 }
#define CHECK(val,res) \
if (popcnt(val) /= res) call abort ; \
if (runtime_popcnt(val) /= res) call abort
#define CHECK2(val) \
if (poppar(val) /= modulo(popcnt(val),2)) call abort ; \
if (runtime_poppar(val) /= poppar(val)) call abort
CHECK(0_16, 0)
CHECK(1_16, 1)
CHECK(-1_16,128)
CHECK(-8_16,128-3)
CHECK(huge(0_16), 128-1)
CHECK(-huge(0_16), 2)
CHECK2(0_16)
CHECK2(17_16)
CHECK2(-17_16)
CHECK2(huge(0_16))
CHECK2(-huge(0_16))
contains
integer function runtime_popcnt (i) result(res)
integer(kind=16), intent(in) :: i
res = popcnt(i)
end function
integer function runtime_poppar (i) result(res)
integer(kind=16), intent(in) :: i
res = poppar(i)
end function
end