Re: [fortran, patch] Implement POPCNT and POPPAR

Re: [fortran, patch] Implement POPCNT and POPPAR

[Uros Bizjak]

Hello!

> Please find attached a patch implementing the Fortran 2008 intrinsics POPCNT and POPPAR. They're implemented by using the existing popcount(), popcountl() and popcountll() builtins. For types larger than 'long long int' (i.e. 128 bit integer on x86_64), we call the long long variant twice on two 64-bit parts, and add the results.

Hm, why you don't also use __buitlin_parity and friends?

Uros.,

Re: [fortran, patch] Implement POPCNT and POPPAR

[FX]

[-- Attachment #1: Type: text/plain, Size: 929 bytes --]

> Hm, why you don't also use __buitlin_parity and friends?

Because I didn't know they existed! And I see that it leads to much better generated code that way, at least on x86_64, where popcount apparently expands to a libgcc call while parity does not. Thanks Uros!

Please find amended patch using both popcount{,l,ll} and parity{,l,ll} built-ins to implement the POPCNT and POPPAR Fortran intrinsics. For types larger than "long long", we call the long long variant twice on two 64-bit parts of the integer, and add (for popcount) or xor (for parity) the results.

Also, this updated patch includes documentation of the intrinsics, which I forgot in last version.

Bootstrapped and regtested on x86_64-linux, OK to commit?

FX


PS for Tobias: I did look at implementing a int128 libgcc intrinsic and use it, but it's much much more work than emitting the code directly... so I did not go that route, sorry!



[-- Attachment #2: popcnt_poppar_2.ChangeLog --]
[-- Type: application/octet-stream, Size: 601 bytes --]

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-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.


[-- Attachment #3: popcnt_poppar_2.diff --]
[-- Type: application/octet-stream, Size: 16735 bytes --]

Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 163667)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -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);
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h	(revision 163667)
+++ gcc/fortran/intrinsic.h	(working copy)
@@ -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 *);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 163667)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -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,
Index: gcc/fortran/f95-lang.c
===================================================================
--- gcc/fortran/f95-lang.c	(revision 163667)
+++ gcc/fortran/f95-lang.c	(working copy)
@@ -938,13 +938,17 @@ gfc_init_builtin_functions (void)
 		          BUILT_IN_SINCOSF, "sincosf", false);
     }
 
-  /* For LEADZ / TRAILZ.  */
+  /* For LEADZ / TRAILZ / POPCNT / 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.  */
 
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(revision 163667)
+++ gcc/fortran/trans-intrinsic.c	(working copy)
@@ -3476,6 +3476,90 @@ gfc_conv_intrinsic_trailz (gfc_se * se, 
   se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, trailz);
 }
 
+/* POPCNT(i) = __builtin_popcount (i)
+   POPCNT(i) = __builtin_parity (i)
+   using __builtin_popcount, __builtin_popcountl or __builtin_popcountll
+   (and their __builtin_parity counterparts) for the appropriate types.
+   For types larger than "long long", we call the built-in twice and add.  */
+ 
+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 __builtin_popcount* 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));
+			  
+      /* Add 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 +5502,14 @@ gfc_conv_intrinsic_function (gfc_se * se
       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;
Index: gcc/fortran/intrinsic.texi
===================================================================
--- gcc/fortran/intrinsic.texi	(revision 163667)
+++ gcc/fortran/intrinsic.texi	(working copy)
@@ -211,6 +211,8 @@ Some basic guidelines for editing this d
 * @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
 
 
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c	(revision 163667)
+++ gcc/fortran/simplify.c	(working copy)
@@ -4293,6 +4293,47 @@ gfc_simplify_parity (gfc_expr *e, gfc_ex
 
 
 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)
 {
   int i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
Index: gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90
===================================================================
--- gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90	(revision 0)
+++ gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90	(revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90
===================================================================
--- gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90	(revision 0)
+++ gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90	(revision 0)
@@ -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

Re: [fortran, patch] Implement POPCNT and POPPAR

[Tobias Burnus]

  FX wrote:
>> Hm, why you don't also use __buitlin_parity and friends?
> Because I didn't know they existed!

Cf. http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38282#c5 which listed 
__builtin_parity ...


> PS for Tobias: I did look at implementing a int128 libgcc intrinsic and use it, but it's much much more work than emitting the code directly... so I did not go that route, sorry!

Understood - and adding the *first* quad built-in is probably extra work.

> Bootstrapped and regtested on x86_64-linux, OK to commit

OK, however, I am not 100% happy with the comments. Suggestions below.

+  /* For LEADZ / TRAILZ / POPCNT / POPAR.  */
/* For LEADZ, TRAILZ, POPCNT, and POPAR.  */


+/* POPCNT(i) = __builtin_popcount (i)
+   POPCNT(i) = __builtin_parity (i)
+   using __builtin_popcount, __builtin_popcountl or __builtin_popcountll
+   (and their __builtin_parity counterparts) for the appropriate types.
+   For types larger than "long long", we call the built-in twice and add.  */


Twice POPCNT is a copy and paste error ;-) How about:

/* Using __builtin_popcount for POPCNT and __builtin_parity for POPPAR; 
for types larger than "long long", we call the long built-in for the 
lower and higher bits and combine the result.  */

+  /* Which variant of __builtin_popcount* should we call?  */

  /* Which variant of the __builtin_* should we call?  */

+      /* Add the results.  */
/* Combine the results.  */


Tobias

Re: [fortran, patch] Implement POPCNT and POPPAR

[Uros Bizjak]

On Tue, 2010-08-31 at 19:55 +0200, Tobias Burnus wrote:

> OK, however, I am not 100% happy with the comments. Suggestions below.
> 
> +  /* For LEADZ / TRAILZ / POPCNT / POPAR.  */
> /* For LEADZ, TRAILZ, POPCNT, and POPAR.  */

/* For LEADZ, TRAILZ, POPCNT and POPPAR.  */

Uros.

Re: [fortran, patch] Implement POPCNT and POPPAR

[FX]

> OK, however, I am not 100% happy with the comments.

Committed as rev. 163691, with your suggested comment (and the seria comma removed).
Thanks for the review!

FX

Re: [fortran, patch] Implement POPCNT and POPPAR

[Richard Henderson]

> +/* POPPAR(i) = POPCNT(i) % 2  */

__builtin_parity et al.


r~

[fortran, patch] Implement POPCNT and POPPAR

[FX]

[-- Attachment #1: Type: text/plain, Size: 385 bytes --]

Please find attached a patch implementing the Fortran 2008 intrinsics POPCNT and POPPAR. They're implemented by using the existing popcount(), popcountl() and popcountll() builtins. For types larger than 'long long int' (i.e. 128 bit integer on x86_64), we call the long long variant twice on two 64-bit parts, and add the results.

Regtested on x86_64-linux, OK to commit?
FX



[-- Attachment #2: popcnt_poppar.ChangeLog --]
[-- Type: application/octet-stream, Size: 794 bytes --]

2010-08-31  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/38282
	* intrinsic.c (add_functions): New POPCNT and POPPAR intrinsics.
	* intrinsic.h (gfc_simplify_popcnt, gfc_simplify_poppar): New
	prototypes.
	* gfortran.h (gfc_isym_id): Add GFC_ISYM_POPCNT and GFC_ISYM_POPPAR.
	* f95-lang.c (gfc_init_builtin_functions): Define popcount(),
	popcountl() and popcountll() builtins.
	* trans-intrinsic.c (gfc_conv_intrinsic_popcnt,
	gfc_conv_intrinsic_poppar): New functions
	(gfc_conv_intrinsic_function): Call above new functions.
	* simplify.c (gfc_simplify_popcnt, gfc_simplify_poppar): New
	functions.


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.


[-- Attachment #3: popcnt_poppar.diff --]
[-- Type: application/octet-stream, Size: 12907 bytes --]

Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 163667)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -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);
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h	(revision 163667)
+++ gcc/fortran/intrinsic.h	(working copy)
@@ -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 *);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 163667)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -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,
Index: gcc/fortran/f95-lang.c
===================================================================
--- gcc/fortran/f95-lang.c	(revision 163667)
+++ gcc/fortran/f95-lang.c	(working copy)
@@ -938,13 +938,15 @@ gfc_init_builtin_functions (void)
 		          BUILT_IN_SINCOSF, "sincosf", false);
     }
 
-  /* For LEADZ / TRAILZ.  */
+  /* For LEADZ / TRAILZ / POPCNT / 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_popcount", ftype, BUILT_IN_POPCOUNT,
+		      "__builtin_popcount", true);
 
   ftype = build_function_type_list (integer_type_node,
                                     long_unsigned_type_node, NULL_TREE);
@@ -952,6 +954,8 @@ gfc_init_builtin_functions (void)
 		      "__builtin_clzl", true);
   gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
 		      "__builtin_ctzl", 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 +963,8 @@ gfc_init_builtin_functions (void)
 		      "__builtin_clzll", true);
   gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
 		      "__builtin_ctzll", true);
+  gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
+		      "__builtin_popcountll", true);
 
   /* Other builtin functions we use.  */
 
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(revision 163667)
+++ gcc/fortran/trans-intrinsic.c	(working copy)
@@ -3476,6 +3476,97 @@ gfc_conv_intrinsic_trailz (gfc_se * se, 
   se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, trailz);
 }
 
+/* POPCNT(i) = __builtin_popcount (i)
+   using __builtin_popcount, __builtin_popcountl or __builtin_popcountll
+   for the appropriate types. For types larger than "long long", we call
+   it twice and add.  */
+ 
+static void
+gfc_conv_intrinsic_popcnt (gfc_se * se, gfc_expr *expr)
+{
+  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 __builtin_popcount* should we call?  */
+  if (argsize <= INT_TYPE_SIZE)
+    {
+      arg_type = unsigned_type_node;
+      func = built_in_decls[BUILT_IN_POPCOUNT];
+    }
+  else if (argsize <= LONG_TYPE_SIZE)
+    {
+      arg_type = long_unsigned_type_node;
+      func = built_in_decls[BUILT_IN_POPCOUNTL];
+    }
+  else if (argsize <= LONG_LONG_TYPE_SIZE)
+    {
+      arg_type = long_long_unsigned_type_node;
+      func = built_in_decls[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);
+
+      /* 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,
+				   built_in_decls[BUILT_IN_POPCOUNTLL], 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,
+				   built_in_decls[BUILT_IN_POPCOUNTLL], 1,
+				   fold_convert (long_long_unsigned_type_node,
+						 arg2));
+			  
+      /* Add the results.  */
+      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));
+}
+
+/* POPPAR(i) = POPCNT(i) % 2  */
+ 
+static void
+gfc_conv_intrinsic_poppar (gfc_se * se, gfc_expr *expr)
+{
+  /* Generate code for POPCNT.  */
+  gfc_conv_intrinsic_popcnt (se, expr);
+
+  se->expr = fold_build2 (TRUNC_MOD_EXPR, TREE_TYPE(se->expr),
+			  se->expr, build_int_cst (TREE_TYPE(se->expr), 2));
+}
+
+
+
 /* 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 +5509,14 @@ gfc_conv_intrinsic_function (gfc_se * se
       gfc_conv_intrinsic_trailz (se, expr);
       break;
 
+    case GFC_ISYM_POPCNT:
+      gfc_conv_intrinsic_popcnt (se, expr);
+      break;
+
+    case GFC_ISYM_POPPAR:
+      gfc_conv_intrinsic_poppar (se, expr);
+      break;
+
     case GFC_ISYM_LBOUND:
       gfc_conv_intrinsic_bound (se, expr, 0);
       break;
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c	(revision 163667)
+++ gcc/fortran/simplify.c	(working copy)
@@ -4293,6 +4293,47 @@ gfc_simplify_parity (gfc_expr *e, gfc_ex
 
 
 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)
 {
   int i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
Index: gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90
===================================================================
--- gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90	(revision 0)
+++ gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90	(revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90
===================================================================
--- gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90	(revision 0)
+++ gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90	(revision 0)
@@ -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