From dd90ca33e8596f23354edc654528899feb12ff8a Mon Sep 17 00:00:00 2001 From: Fritz Reese Date: Tue, 25 Oct 2016 18:27:51 +0000 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 6 + gcc/fortran/gfortran.texi | 38 +++++ gcc/fortran/resolve.c | 105 ++++++++++++ gcc/testsuite/ChangeLog | 5 + .../gfortran.dg/dec_bitwise_ops_1.f90 | 106 ++++++++++++ .../gfortran.dg/dec_bitwise_ops_2.f90 | 155 ++++++++++++++++++ 6 files changed, 415 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/dec_bitwise_ops_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/dec_bitwise_ops_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2e7c2930c2d..f517550c863 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2016-10-25 Fritz Reese + + * 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 PR fortran/72770 diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 60b619f71a9..0278bd6eef7 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 2a64ab7adf1..8cee007af17 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 2dc44319323..decdae89d1b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-10-25 Fritz Reese + + * gfortran.dg/dec_bitwise_ops_1.f90: New test. + * gfortran.dg/dec_bitwise_ops_2.f90: New test. + 2016-10-25 Eric Botcazou * 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 00000000000..491577cc553 --- /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 00000000000..5559a875b35 --- /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 -- 2.30.2