From: Francois-Xavier Coudert Date: Tue, 31 Aug 2010 18:56:46 +0000 (+0000) Subject: re PR fortran/38282 (Bit intrinsics: ILEN and IBCHNG) X-Git-Tag: releases/gcc-4.6.0~4752 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ad5f4de228737897d59cb3e629f934d504029e16;p=thirdparty%2Fgcc.git re PR fortran/38282 (Bit intrinsics: ILEN and IBCHNG) 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4e64e8483a7f..cdceae8d02dd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2010-08-31 Francois-Xavier Coudert + + 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 PR fortran/45456 diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 91dc491032c7..163c0d229ce8 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -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. */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 66c378efbaf9..1ee9bd584020 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 2ce3482e3a1c..c14e14d75cdb 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -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); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 2c101d391be6..383ada085d40 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -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 *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index c4767f5a6eb2..49b9d53f5400 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -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 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 2fe714096a89..864959798c05 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -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) { diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 256cd8d67fcc..c0f39b22309f 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e46264217a3b..a42dfe0559e6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-08-31 Francois-Xavier Coudert + + PR fortran/38282 + * gfortran.dg/popcnt_poppar_1.F90: New test. + * gfortran.dg/popcnt_poppar_2.F90: New test. + 2010-08-31 Uros Bizjak * gcc.target/i386/volatile-2.c: Require nonpic target. diff --git a/gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90 b/gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90 new file mode 100644 index 000000000000..3b7322b94fa9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90 b/gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90 new file mode 100644 index 000000000000..fb984e2f55a0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90 @@ -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