diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.texi | 38 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 105 |
3 files changed, 149 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; |