Convert logical ops on integers to bitwise equivalent with -fdec.

	gcc/fortran/
	* gfortran.texi: Document.
	* resolve.c (logical_to_bitwise): New function.
	* resolve.c (resolve_operator): Wrap operands with logical_to_bitwise.

	gcc/testsuite/gfortran.dg/
	* dec_bitwise_ops_1.f90, dec_bitwise_ops_2.f90: New testcases.

From-SVN: r241534

6 files changed, 415 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2e7c293..f517550 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-10-25  Fritz Reese <fritzoreese@gmail.com>
+
+	* gfortran.texi: Document.
+	* resolve.c (logical_to_bitwise): New function.
+	* resolve.c (resolve_operator): Wrap operands with logical_to_bitwise.
+
 2016-10-25  Andre Vehreschild  <vehre@gcc.gnu.org>
 
 	PR fortran/72770
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 60b619f..0278bd6 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1469,6 +1469,7 @@ compatibility extensions along with those enabled by @option{-std=legacy}.
 * TYPE as an alias for PRINT::
 * %LOC as an rvalue::
 * .XOR. operator::
+* Bitwise logical operators::
 @end menu
 
 @node Old-style kind specifications
@@ -2567,6 +2568,43 @@ GNU Fortran supports @code{.XOR.} as a logical operator with @code{-std=legacy}
 for compatibility with legacy code. @code{.XOR.} is equivalent to
 @code{.NEQV.}. That is, the output is true if and only if the inputs differ.
 
+@node Bitwise logical operators
+@subsection Bitwise logical operators
+@cindex logical, bitwise
+
+With @option{-fdec}, GNU Fortran relaxes the type constraints on
+logical operators to allow integer operands, and performs the corresponding
+bitwise operation instead.  This flag is for compatibility only, and should be
+avoided in new code.  Consider:
+
+@smallexample
+  INTEGER :: i, j
+  i = z'33'
+  j = z'cc'
+  print *, i .AND. j
+@end smallexample
+
+In this example, compiled with @option{-fdec}, GNU Fortran will
+replace the @code{.AND.} operation with a call to the intrinsic
+@code{@ref{IAND}} function, yielding the bitwise-and of @code{i} and @code{j}.
+
+Note that this conversion will occur if at least one operand is of integral
+type.  As a result, a logical operand will be converted to an integer when the
+other operand is an integer in a logical operation.  In this case,
+@code{.TRUE.} is converted to @code{1} and @code{.FALSE.} to @code{0}.
+
+Here is the mapping of logical operator to bitwise intrinsic used with
+@option{-fdec}:
+
+@multitable @columnfractions .25 .25 .5
+@headitem Operator @tab Intrinsic @tab Bitwise operation
+@item @code{.NOT.} @tab @code{@ref{NOT}} @tab complement
+@item @code{.AND.} @tab @code{@ref{IAND}} @tab intersection
+@item @code{.OR.} @tab @code{@ref{IOR}} @tab union
+@item @code{.NEQV.} @tab @code{@ref{IEOR}} @tab exclusive or
+@item @code{.EQV.} @tab @code{@ref{NOT}(@ref{IEOR})} @tab complement of exclusive or
+@end multitable
+
 
 @node Extensions not implemented in GNU Fortran
 @section Extensions not implemented in GNU Fortran
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2a64ab7..8cee007 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3522,6 +3522,88 @@ compare_shapes (gfc_expr *op1, gfc_expr *op2)
   return t;
 }
 
+/* Convert a logical operator to the corresponding bitwise intrinsic call.
+   For example A .AND. B becomes IAND(A, B).  */
+static gfc_expr *
+logical_to_bitwise (gfc_expr *e)
+{
+  gfc_expr *tmp, *op1, *op2;
+  gfc_isym_id isym;
+  gfc_actual_arglist *args = NULL;
+
+  gcc_assert (e->expr_type == EXPR_OP);
+
+  isym = GFC_ISYM_NONE;
+  op1 = e->value.op.op1;
+  op2 = e->value.op.op2;
+
+  switch (e->value.op.op)
+    {
+    case INTRINSIC_NOT:
+      isym = GFC_ISYM_NOT;
+      break;
+    case INTRINSIC_AND:
+      isym = GFC_ISYM_IAND;
+      break;
+    case INTRINSIC_OR:
+      isym = GFC_ISYM_IOR;
+      break;
+    case INTRINSIC_NEQV:
+      isym = GFC_ISYM_IEOR;
+      break;
+    case INTRINSIC_EQV:
+      /* "Bitwise eqv" is just the complement of NEQV === IEOR.
+	 Change the old expression to NEQV, which will get replaced by IEOR,
+	 and wrap it in NOT.  */
+      tmp = gfc_copy_expr (e);
+      tmp->value.op.op = INTRINSIC_NEQV;
+      tmp = logical_to_bitwise (tmp);
+      isym = GFC_ISYM_NOT;
+      op1 = tmp;
+      op2 = NULL;
+      break;
+    default:
+      gfc_internal_error ("logical_to_bitwise(): Bad intrinsic");
+    }
+
+  /* Inherit the original operation's operands as arguments.  */
+  args = gfc_get_actual_arglist ();
+  args->expr = op1;
+  if (op2)
+    {
+      args->next = gfc_get_actual_arglist ();
+      args->next->expr = op2;
+    }
+
+  /* Convert the expression to a function call.  */
+  e->expr_type = EXPR_FUNCTION;
+  e->value.function.actual = args;
+  e->value.function.isym = gfc_intrinsic_function_by_id (isym);
+  e->value.function.name = e->value.function.isym->name;
+  e->value.function.esym = NULL;
+
+  /* Make up a pre-resolved function call symtree if we need to.  */
+  if (!e->symtree || !e->symtree->n.sym)
+    {
+      gfc_symbol *sym;
+      gfc_get_ha_sym_tree (e->value.function.isym->name, &e->symtree);
+      sym = e->symtree->n.sym;
+      sym->result = sym;
+      sym->attr.flavor = FL_PROCEDURE;
+      sym->attr.function = 1;
+      sym->attr.elemental = 1;
+      sym->attr.pure = 1;
+      sym->attr.referenced = 1;
+      gfc_intrinsic_symbol (sym);
+      gfc_commit_symbol (sym);
+    }
+
+  args->name = e->value.function.isym->formal->name;
+  if (e->value.function.isym->formal->next)
+    args->next->name = e->value.function.isym->formal->next->name;
+
+  return e;
+}
 
 /* Resolve an operator expression node.  This can involve replacing the
    operation with a user defined function call.  */
@@ -3628,6 +3710,20 @@ resolve_operator (gfc_expr *e)
 	  break;
 	}
 
+      /* Logical ops on integers become bitwise ops with -fdec.  */
+      else if (flag_dec
+	       && (op1->ts.type == BT_INTEGER || op2->ts.type == BT_INTEGER))
+	{
+	  e->ts.type = BT_INTEGER;
+	  e->ts.kind = gfc_kind_max (op1, op2);
+	  if (op1->ts.type != e->ts.type || op1->ts.kind != e->ts.kind)
+	    gfc_convert_type (op1, &e->ts, 1);
+	  if (op2->ts.type != e->ts.type || op2->ts.kind != e->ts.kind)
+	    gfc_convert_type (op2, &e->ts, 1);
+	  e = logical_to_bitwise (e);
+	  return resolve_function (e);
+	}
+
       sprintf (msg, _("Operands of logical operator %%<%s%%> at %%L are %s/%s"),
 	       gfc_op2string (e->value.op.op), gfc_typename (&op1->ts),
 	       gfc_typename (&op2->ts));
@@ -3635,6 +3731,15 @@ resolve_operator (gfc_expr *e)
       goto bad_op;
 
     case INTRINSIC_NOT:
+      /* Logical ops on integers become bitwise ops with -fdec.  */
+      if (flag_dec && op1->ts.type == BT_INTEGER)
+	{
+	  e->ts.type = BT_INTEGER;
+	  e->ts.kind = op1->ts.kind;
+	  e = logical_to_bitwise (e);
+	  return resolve_function (e);
+	}
+
       if (op1->ts.type == BT_LOGICAL)
 	{
 	  e->ts.type = BT_LOGICAL;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2dc4431..decdae8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-10-25  Fritz Reese <fritzoreese@gmail.com>
+
+	* gfortran.dg/dec_bitwise_ops_1.f90: New test.
+	* gfortran.dg/dec_bitwise_ops_2.f90: New test.
+
 2016-10-25  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/opt59.adb: New test.
diff --git a/gcc/testsuite/gfortran.dg/dec_bitwise_ops_1.f90 b/gcc/testsuite/gfortran.dg/dec_bitwise_ops_1.f90
new file mode 100644
index 0000000..491577c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_bitwise_ops_1.f90
@@ -0,0 +1,106 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Runtime tests to verify logical-to-bitwise operations perform as expected
+! with -fdec.
+!
+
+subroutine assert(expected, actual, str)
+  implicit none
+  character(*), intent(in) :: str
+  integer, intent(in)      :: expected, actual
+  if (actual .ne. expected) then
+    write (*, '(A,I4,I4)') str, expected, actual
+    call abort()
+  endif
+end subroutine
+
+implicit none
+
+integer expected, expected_expr
+integer output_vars, output_const, output_expr
+integer op1, op2, mult
+
+mult = 3
+op1 = 3
+op2 = 5
+
+!!!! AND -> IAND
+
+expected      = IAND(op1, op2)
+expected_expr = mult*expected
+
+output_const  = 3 .AND. 5
+output_vars   = op1 .AND. op2
+output_expr   = mult * (op1 .AND. op2)
+
+call assert(expected, output_vars,      "( ) and")
+call assert(expected, output_const,     "(c) and")
+call assert(expected_expr, output_expr, "(x) and")
+
+!!!! EQV -> NOT IEOR
+
+expected   = NOT(IEOR(op1, op2))
+expected_expr = mult*expected
+
+output_const    = 3 .EQV. 5
+output_vars     = op1 .EQV. op2
+output_expr     = mult * (op1 .EQV. op2)
+
+call assert(expected, output_vars,       "( ) EQV")
+call assert(expected, output_const,      "(c) EQV")
+call assert(expected_expr, output_expr,  "(x) EQV")
+
+!!!! NEQV -> IEOR
+
+expected   = IEOR(op1, op2)
+expected_expr = mult*expected
+
+output_const    = 3 .NEQV. 5
+output_vars     = op1 .NEQV. op2
+output_expr     = mult * (op1 .NEQV. op2)
+
+call assert(expected, output_vars,       "( ) NEQV")
+call assert(expected, output_const,      "(c) NEQV")
+call assert(expected_expr, output_expr,  "(x) NEQV")
+
+!!!! NOT -> NOT
+
+expected   = NOT(op2)
+expected_expr = mult*expected
+
+output_const    = .NOT. 5
+output_vars     = .NOT. op2
+output_expr     = mult * (.NOT. op2)
+
+call assert(expected, output_vars,       "( ) NOT")
+call assert(expected, output_const,      "(c) NOT")
+call assert(expected_expr, output_expr,  "(x) NOT")
+
+!!!! OR -> IOR
+
+expected   = IOR(op1, op2)
+expected_expr = mult*expected
+
+output_const    = 3 .OR. 5
+output_vars     = op1 .OR. op2
+output_expr     = mult * (op1 .OR. op2)
+
+call assert(expected, output_vars,       "( ) OR")
+call assert(expected, output_const,      "(c) OR")
+call assert(expected_expr, output_expr,  "(x) OR")
+
+!!!! XOR -> IEOR, not to be confused with .XOR.
+
+expected  = IEOR(op1, op2)
+expected_expr = mult*expected
+
+output_const    = 3 .XOR. 5
+output_vars     = op1 .XOR. op2
+output_expr     = mult * (op1 .XOR. op2)
+
+call assert(expected, output_vars,       "( ) XOR")
+call assert(expected, output_const,      "(c) XOR")
+call assert(expected_expr, output_expr,  "(x) XOR")
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_bitwise_ops_2.f90 b/gcc/testsuite/gfortran.dg/dec_bitwise_ops_2.f90
new file mode 100644
index 0000000..5559a87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_bitwise_ops_2.f90
@@ -0,0 +1,155 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Runtime tests to verify bitwise ops perform appropriate conversions
+! with -fdec.
+!
+
+subroutine assert(expected, actual, str)
+  implicit none
+  character(*), intent(in) :: str
+  integer, intent(in)      :: expected, actual(9)
+  integer :: i
+  do i=1,9
+    if (expected .ne. actual(i)) then
+      write (*, '(A,I8,I8)') str, expected, actual(i)
+      call abort()
+    endif
+  enddo
+end subroutine
+
+implicit none
+
+logical(1), volatile :: op1_1l
+integer(1), volatile :: op1_1, op2_1
+
+logical(2), volatile :: op1_2l
+integer(2), volatile :: op1_2, op2_2
+
+logical(4), volatile :: op1_4l
+integer(4), volatile :: op1_4, op2_4
+
+integer, volatile :: expect, outs(9)
+
+
+op1_1l = .true.
+op1_2l = .true.
+op1_4l = .true.
+op1_1 = 117_1
+op1_2 = 117_2
+op1_4 = 117_4
+op2_1 =  49_1
+op2_2 =  49_2
+op2_4 =  49_4
+
+!!! Explicit integer operands
+
+expect = IAND(op1_1, op2_1)
+outs(1) = op1_1 .AND. op2_1
+outs(2) = op1_1 .AND. op2_2
+outs(3) = op1_1 .AND. op2_4
+outs(4) = op1_2 .AND. op2_1
+outs(5) = op1_2 .AND. op2_2
+outs(6) = op1_2 .AND. op2_4
+outs(7) = op1_4 .AND. op2_1
+outs(8) = op1_4 .AND. op2_2
+outs(9) = op1_4 .AND. op2_4
+call assert(expect, outs, "AND")
+
+expect = IOR(op1_1, op2_1)
+outs(1) = op1_1 .OR. op2_1
+outs(2) = op1_1 .OR. op2_2
+outs(3) = op1_1 .OR. op2_4
+outs(4) = op1_2 .OR. op2_1
+outs(5) = op1_2 .OR. op2_2
+outs(6) = op1_2 .OR. op2_4
+outs(7) = op1_4 .OR. op2_1
+outs(8) = op1_4 .OR. op2_2
+outs(9) = op1_4 .OR. op2_4
+
+call assert(expect, outs, "OR")
+
+expect = NOT(IEOR(op1_1, op2_1))
+outs(1) = op1_1 .EQV. op2_1
+outs(2) = op1_1 .EQV. op2_2
+outs(3) = op1_1 .EQV. op2_4
+outs(4) = op1_2 .EQV. op2_1
+outs(5) = op1_2 .EQV. op2_2
+outs(6) = op1_2 .EQV. op2_4
+outs(7) = op1_4 .EQV. op2_1
+outs(8) = op1_4 .EQV. op2_2
+outs(9) = op1_4 .EQV. op2_4
+
+call assert(expect, outs, "EQV")
+
+expect = IEOR(op1_1, op2_1)
+outs(1) = op1_1 .NEQV. op2_1
+outs(2) = op1_1 .NEQV. op2_2
+outs(3) = op1_1 .NEQV. op2_4
+outs(4) = op1_2 .NEQV. op2_1
+outs(5) = op1_2 .NEQV. op2_2
+outs(6) = op1_2 .NEQV. op2_4
+outs(7) = op1_4 .NEQV. op2_1
+outs(8) = op1_4 .NEQV. op2_2
+outs(9) = op1_4 .NEQV. op2_4
+
+call assert(expect, outs, "NEQV")
+
+!!! Logical -> Integer operand conversions
+op1_1 = op1_1l
+op1_2 = op1_2l
+op1_4 = op1_4l
+
+expect = IAND(op1_1, op2_1)
+outs(1) = op1_1l .AND. op2_1 ! implicit conversions
+outs(2) = op1_1l .AND. op2_2
+outs(3) = op1_1l .AND. op2_4
+outs(4) = op1_2l .AND. op2_1
+outs(5) = op1_2l .AND. op2_2
+outs(6) = op1_2l .AND. op2_4
+outs(7) = op1_4l .AND. op2_1
+outs(8) = op1_4l .AND. op2_2
+outs(9) = op1_4l .AND. op2_4
+call assert(expect, outs, "AND")
+
+expect = IOR(op1_1, op2_1)
+outs(1) = op1_1l .OR. op2_1 ! implicit conversions
+outs(2) = op1_1l .OR. op2_2
+outs(3) = op1_1l .OR. op2_4
+outs(4) = op1_2l .OR. op2_1
+outs(5) = op1_2l .OR. op2_2
+outs(6) = op1_2l .OR. op2_4
+outs(7) = op1_4l .OR. op2_1
+outs(8) = op1_4l .OR. op2_2
+outs(9) = op1_4l .OR. op2_4
+
+call assert(expect, outs, "OR")
+
+expect = NOT(IEOR(op1_1, op2_1))
+outs(1) = op1_1l .EQV. op2_1 ! implicit conversions
+outs(2) = op1_1l .EQV. op2_2
+outs(3) = op1_1l .EQV. op2_4
+outs(4) = op1_2l .EQV. op2_1
+outs(5) = op1_2l .EQV. op2_2
+outs(6) = op1_2l .EQV. op2_4
+outs(7) = op1_4l .EQV. op2_1
+outs(8) = op1_4l .EQV. op2_2
+outs(9) = op1_4l .EQV. op2_4
+
+call assert(expect, outs, "EQV")
+
+expect = IEOR(op1_1, op2_1)
+outs(1) = op1_1l .NEQV. op2_1 ! implicit conversions
+outs(2) = op1_1l .NEQV. op2_2
+outs(3) = op1_1l .NEQV. op2_4
+outs(4) = op1_2l .NEQV. op2_1
+outs(5) = op1_2l .NEQV. op2_2
+outs(6) = op1_2l .NEQV. op2_4
+outs(7) = op1_4l .NEQV. op2_1
+outs(8) = op1_4l .NEQV. op2_2
+outs(9) = op1_4l .NEQV. op2_4
+
+call assert(expect, outs, "NEQV")
+
+
+end