This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] Move operator fields of gfc_expr into union
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: GCC Fortran mailing list <fortran at gcc dot gnu dot org>,patch <gcc-patches at gcc dot gnu dot org>
- Date: Tue, 08 Feb 2005 18:14:26 +0100
- Subject: [gfortran] Move operator fields of gfc_expr into union
Since with my previous bugfix the op1, op2, operator, and uop fields are only
meaningful when none of the other fields in the value union inside of gfc_expr
are used, I suggest moving these fields inside the union, as in the attached
patch.
The only interesting hunks are:
1. the one to gfc_extend_expr: since the union fields share their memory, one
has to be more careful than previously when changing the meaning of an
gfc_expr, and therefore those fields have to be nullified in order to not
confuse later passes. Without this,
gfortran.fortran-torture/execute/userop.f90 failed.
2. the one to gfc_find_forall_index: since the operator fields are now used
only in EXPR_OP, I moved the part that searches them inside the switch. I
could have done this together with my previous patch, but I didn't see this then.
Bubblestrapped and tested on i686-pc-linux-gnu. Inspired by g95 again.
- Tobi
2005-02-08 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
* gfortran.h (gfc_expr): Move 'operator', 'op1', 'op2', and 'uop'
fields into new struct 'op' inside the 'value' union.
* arith.c (eval_intrinsic): Adapt all users.
* dependency.c (gfc_check_dependency): Likewise.
* dump-parse-tree.c (gfc_show_expr): Likewise.
* expr.c (gfc_get_expr): Don't clear removed fields.
(free_expr0, gfc_copy_expr, gfc_type_convert_binary,
gfc_is_constant_expr, simplify_intrinsic_op, check_init_expr,
check_intrinsic_op): Adapt to new field names.
* interface.c (gfc_extend_expr): Likewise. Also explicitly
nullify 'esym' and 'isym' fields of new function call.
* iresolve.c (gfc_resolve_dot_product, gfc_resolve_matmul):
Adapt to renamed structure fields.
* matchexp.c (build_node, match_level_1, match_expr): Likewise.
* module.c (mio_expr): Likewise.
* resolve.c (resolve_operator): Likewise.
(gfc_find_forall_index): Likewise. Only look through operands
if dealing with EXPR_OP
* trans-array.c (gfc_walk_op_expr): Adapt to renamed fields.
* trans-expr.c (gfc_conv_unary_op, gfc_conv_power_op,
gfc_conv_concat_op, gfc_conv_expr_op): Likewise.
? bak.diff
? err
? err.diff
? missing.diff
? op.diff
? pool.diff
? semantic.cache
Index: arith.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/arith.c,v
retrieving revision 1.21
diff -u -p -r1.21 arith.c
--- arith.c 23 Jan 2005 22:29:39 -0000 1.21
+++ arith.c 8 Feb 2005 16:51:09 -0000
@@ -1598,10 +1598,10 @@ eval_intrinsic (gfc_intrinsic_op operato
temp.expr_type = EXPR_OP;
gfc_clear_ts (&temp.ts);
- temp.operator = operator;
+ temp.value.op.operator = operator;
- temp.op1 = op1;
- temp.op2 = op2;
+ temp.value.op.op1 = op1;
+ temp.value.op.op2 = op2;
gfc_type_convert_binary (&temp);
@@ -1671,10 +1671,10 @@ runtime:
result->ts = temp.ts;
result->expr_type = EXPR_OP;
- result->operator = operator;
+ result->value.op.operator = operator;
- result->op1 = op1;
- result->op2 = op2;
+ result->value.op.op1 = op1;
+ result->value.op.op2 = op2;
result->where = op1->where;
Index: dependency.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/dependency.c,v
retrieving revision 1.6
diff -u -p -r1.6 dependency.c
--- dependency.c 23 Jan 2005 14:36:25 -0000 1.6
+++ dependency.c 8 Feb 2005 16:51:09 -0000
@@ -277,11 +277,11 @@ gfc_check_dependency (gfc_expr * expr1,
switch (expr2->expr_type)
{
case EXPR_OP:
- n = gfc_check_dependency (expr1, expr2->op1, vars, nvars);
+ n = gfc_check_dependency (expr1, expr2->value.op.op1, vars, nvars);
if (n)
return n;
- if (expr2->op2)
- return gfc_check_dependency (expr1, expr2->op2, vars, nvars);
+ if (expr2->value.op.op2)
+ return gfc_check_dependency (expr1, expr2->value.op.op2, vars, nvars);
return 0;
case EXPR_VARIABLE:
Index: dump-parse-tree.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/dump-parse-tree.c,v
retrieving revision 1.10
diff -u -p -r1.10 dump-parse-tree.c
--- dump-parse-tree.c 27 Aug 2004 14:49:34 -0000 1.10
+++ dump-parse-tree.c 8 Feb 2005 16:51:09 -0000
@@ -415,7 +415,7 @@ gfc_show_expr (gfc_expr * p)
case EXPR_OP:
gfc_status ("(");
- switch (p->operator)
+ switch (p->value.op.operator)
{
case INTRINSIC_UPLUS:
gfc_status ("U+ ");
@@ -480,12 +480,12 @@ gfc_show_expr (gfc_expr * p)
("gfc_show_expr(): Bad intrinsic in expression!");
}
- gfc_show_expr (p->op1);
+ gfc_show_expr (p->value.op.op1);
- if (p->op2)
+ if (p->value.op.op2)
{
gfc_status (" ");
- gfc_show_expr (p->op2);
+ gfc_show_expr (p->value.op.op2);
}
gfc_status (")");
Index: expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/expr.c,v
retrieving revision 1.21
diff -u -p -r1.21 expr.c
--- expr.c 8 Feb 2005 13:40:59 -0000 1.21
+++ expr.c 8 Feb 2005 16:51:10 -0000
@@ -36,12 +36,9 @@ gfc_get_expr (void)
e = gfc_getmem (sizeof (gfc_expr));
gfc_clear_ts (&e->ts);
- e->op1 = NULL;
- e->op2 = NULL;
e->shape = NULL;
e->ref = NULL;
e->symtree = NULL;
- e->uop = NULL;
return e;
}
@@ -170,10 +167,10 @@ free_expr0 (gfc_expr * e)
break;
case EXPR_OP:
- if (e->op1 != NULL)
- gfc_free_expr (e->op1);
- if (e->op2 != NULL)
- gfc_free_expr (e->op2);
+ if (e->value.op.op1 != NULL)
+ gfc_free_expr (e->value.op.op1);
+ if (e->value.op.op2 != NULL)
+ gfc_free_expr (e->value.op.op2);
break;
case EXPR_FUNCTION:
@@ -437,17 +434,17 @@ gfc_copy_expr (gfc_expr * p)
break;
case EXPR_OP:
- switch (q->operator)
+ switch (q->value.op.operator)
{
case INTRINSIC_NOT:
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
- q->op1 = gfc_copy_expr (p->op1);
+ q->value.op.op1 = gfc_copy_expr (p->value.op.op1);
break;
default: /* Binary operators */
- q->op1 = gfc_copy_expr (p->op1);
- q->op2 = gfc_copy_expr (p->op2);
+ q->value.op.op1 = gfc_copy_expr (p->value.op.op1);
+ q->value.op.op2 = gfc_copy_expr (p->value.op.op2);
break;
}
@@ -584,8 +581,8 @@ gfc_type_convert_binary (gfc_expr * e)
{
gfc_expr *op1, *op2;
- op1 = e->op1;
- op2 = e->op2;
+ op1 = e->value.op.op1;
+ op2 = e->value.op.op2;
if (op1->ts.type == BT_UNKNOWN || op2->ts.type == BT_UNKNOWN)
{
@@ -619,17 +616,17 @@ gfc_type_convert_binary (gfc_expr * e)
e->ts = op1->ts;
/* Special cose for ** operator. */
- if (e->operator == INTRINSIC_POWER)
+ if (e->value.op.operator == INTRINSIC_POWER)
goto done;
- gfc_convert_type (e->op2, &e->ts, 2);
+ gfc_convert_type (e->value.op.op2, &e->ts, 2);
goto done;
}
if (op1->ts.type == BT_INTEGER)
{
e->ts = op2->ts;
- gfc_convert_type (e->op1, &e->ts, 2);
+ gfc_convert_type (e->value.op.op1, &e->ts, 2);
goto done;
}
@@ -640,9 +637,9 @@ gfc_type_convert_binary (gfc_expr * e)
else
e->ts.kind = op2->ts.kind;
if (op1->ts.type != BT_COMPLEX || op1->ts.kind != e->ts.kind)
- gfc_convert_type (e->op1, &e->ts, 2);
+ gfc_convert_type (e->value.op.op1, &e->ts, 2);
if (op2->ts.type != BT_COMPLEX || op2->ts.kind != e->ts.kind)
- gfc_convert_type (e->op2, &e->ts, 2);
+ gfc_convert_type (e->value.op.op2, &e->ts, 2);
done:
return;
@@ -665,9 +662,9 @@ gfc_is_constant_expr (gfc_expr * e)
switch (e->expr_type)
{
case EXPR_OP:
- rv = (gfc_is_constant_expr (e->op1)
- && (e->op2 == NULL
- || gfc_is_constant_expr (e->op2)));
+ rv = (gfc_is_constant_expr (e->value.op.op1)
+ && (e->value.op.op2 == NULL
+ || gfc_is_constant_expr (e->value.op.op2)));
break;
@@ -729,11 +726,11 @@ simplify_intrinsic_op (gfc_expr * p, int
{
gfc_expr *op1, *op2, *result;
- if (p->operator == INTRINSIC_USER)
+ if (p->value.op.operator == INTRINSIC_USER)
return SUCCESS;
- op1 = p->op1;
- op2 = p->op2;
+ op1 = p->value.op.op1;
+ op2 = p->value.op.op2;
if (gfc_simplify_expr (op1, type) == FAILURE)
return FAILURE;
@@ -745,10 +742,10 @@ simplify_intrinsic_op (gfc_expr * p, int
return SUCCESS;
/* Rip p apart */
- p->op1 = NULL;
- p->op2 = NULL;
+ p->value.op.op1 = NULL;
+ p->value.op.op2 = NULL;
- switch (p->operator)
+ switch (p->value.op.operator)
{
case INTRINSIC_UPLUS:
result = gfc_uplus (op1);
@@ -1191,15 +1188,17 @@ static try check_init_expr (gfc_expr *);
static try
check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
{
+ gfc_expr *op1 = e->value.op.op1;
+ gfc_expr *op2 = e->value.op.op2;
- if ((*check_function) (e->op1) == FAILURE)
+ if ((*check_function) (op1) == FAILURE)
return FAILURE;
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
- if (!numeric_type (et0 (e->op1)))
+ if (!numeric_type (et0 (op1)))
goto not_numeric;
break;
@@ -1209,11 +1208,11 @@ check_intrinsic_op (gfc_expr * e, try (*
case INTRINSIC_GE:
case INTRINSIC_LT:
case INTRINSIC_LE:
- if ((*check_function) (e->op2) == FAILURE)
+ if ((*check_function) (op2) == FAILURE)
return FAILURE;
- if (!(et0 (e->op1) == BT_CHARACTER && et0 (e->op2) == BT_CHARACTER)
- && !(numeric_type (et0 (e->op1)) && numeric_type (et0 (e->op2))))
+ if (!(et0 (op1) == BT_CHARACTER && et0 (op2) == BT_CHARACTER)
+ && !(numeric_type (et0 (op1)) && numeric_type (et0 (op2))))
{
gfc_error ("Numeric or CHARACTER operands are required in "
"expression at %L", &e->where);
@@ -1226,34 +1225,34 @@ check_intrinsic_op (gfc_expr * e, try (*
case INTRINSIC_TIMES:
case INTRINSIC_DIVIDE:
case INTRINSIC_POWER:
- if ((*check_function) (e->op2) == FAILURE)
+ if ((*check_function) (op2) == FAILURE)
return FAILURE;
- if (!numeric_type (et0 (e->op1)) || !numeric_type (et0 (e->op2)))
+ if (!numeric_type (et0 (op1)) || !numeric_type (et0 (op2)))
goto not_numeric;
- if (e->operator == INTRINSIC_POWER
- && check_function == check_init_expr && et0 (e->op2) != BT_INTEGER)
+ if (e->value.op.operator == INTRINSIC_POWER
+ && check_function == check_init_expr && et0 (op2) != BT_INTEGER)
{
gfc_error ("Exponent at %L must be INTEGER for an initialization "
- "expression", &e->op2->where);
+ "expression", &op2->where);
return FAILURE;
}
break;
case INTRINSIC_CONCAT:
- if ((*check_function) (e->op2) == FAILURE)
+ if ((*check_function) (op2) == FAILURE)
return FAILURE;
- if (et0 (e->op1) != BT_CHARACTER || et0 (e->op2) != BT_CHARACTER)
+ if (et0 (op1) != BT_CHARACTER || et0 (op2) != BT_CHARACTER)
{
gfc_error ("Concatenation operator in expression at %L "
- "must have two CHARACTER operands", &e->op1->where);
+ "must have two CHARACTER operands", &op1->where);
return FAILURE;
}
- if (e->op1->ts.kind != e->op2->ts.kind)
+ if (op1->ts.kind != op2->ts.kind)
{
gfc_error ("Concat operator at %L must concatenate strings of the "
"same kind", &e->where);
@@ -1263,10 +1262,10 @@ check_intrinsic_op (gfc_expr * e, try (*
break;
case INTRINSIC_NOT:
- if (et0 (e->op1) != BT_LOGICAL)
+ if (et0 (op1) != BT_LOGICAL)
{
gfc_error (".NOT. operator in expression at %L must have a LOGICAL "
- "operand", &e->op1->where);
+ "operand", &op1->where);
return FAILURE;
}
@@ -1276,10 +1275,10 @@ check_intrinsic_op (gfc_expr * e, try (*
case INTRINSIC_OR:
case INTRINSIC_EQV:
case INTRINSIC_NEQV:
- if ((*check_function) (e->op2) == FAILURE)
+ if ((*check_function) (op2) == FAILURE)
return FAILURE;
- if (et0 (e->op1) != BT_LOGICAL || et0 (e->op2) != BT_LOGICAL)
+ if (et0 (op1) != BT_LOGICAL || et0 (op2) != BT_LOGICAL)
{
gfc_error ("LOGICAL operands are required in expression at %L",
&e->where);
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.52
diff -u -p -r1.52 gfortran.h
--- gfortran.h 7 Feb 2005 22:16:13 -0000 1.52
+++ gfortran.h 8 Feb 2005 16:51:10 -0000
@@ -1043,15 +1043,11 @@ typedef struct gfc_expr
int rank;
mpz_t *shape; /* Can be NULL if shape is unknown at compile time */
- gfc_intrinsic_op operator;
-
/* Nonnull for functions and structure constructors */
gfc_symtree *symtree;
- gfc_user_op *uop;
gfc_ref *ref;
- struct gfc_expr *op1, *op2;
locus where;
union
@@ -1069,6 +1065,14 @@ typedef struct gfc_expr
struct
{
+ gfc_intrinsic_op operator;
+ gfc_user_op *uop;
+ struct gfc_expr *op1, *op2;
+ }
+ op;
+
+ struct
+ {
gfc_actual_arglist *actual;
const char *name; /* Points to the ultimate name of the function */
gfc_intrinsic_sym *isym;
Index: interface.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/interface.c,v
retrieving revision 1.11
diff -u -p -r1.11 interface.c
--- interface.c 7 Feb 2005 22:16:13 -0000 1.11
+++ interface.c 8 Feb 2005 16:51:11 -0000
@@ -1640,21 +1640,21 @@ gfc_extend_expr (gfc_expr * e)
sym = NULL;
actual = gfc_get_actual_arglist ();
- actual->expr = e->op1;
+ actual->expr = e->value.op.op1;
- if (e->op2 != NULL)
+ if (e->value.op.op2 != NULL)
{
actual->next = gfc_get_actual_arglist ();
- actual->next->expr = e->op2;
+ actual->next->expr = e->value.op.op2;
}
- i = fold_unary (e->operator);
+ i = fold_unary (e->value.op.operator);
if (i == INTRINSIC_USER)
{
for (ns = gfc_current_ns; ns; ns = ns->parent)
{
- uop = gfc_find_uop (e->uop->name, ns);
+ uop = gfc_find_uop (e->value.op.uop->name, ns);
if (uop == NULL)
continue;
@@ -1687,6 +1687,8 @@ gfc_extend_expr (gfc_expr * e)
e->expr_type = EXPR_FUNCTION;
e->symtree = find_sym_in_symtree (sym);
e->value.function.actual = actual;
+ e->value.function.esym = NULL;
+ e->value.function.isym = NULL;
if (gfc_pure (NULL) && !gfc_pure (sym))
{
Index: iresolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.31
diff -u -p -r1.31 iresolve.c
--- iresolve.c 23 Jan 2005 17:00:57 -0000 1.31
+++ iresolve.c 8 Feb 2005 16:51:11 -0000
@@ -383,9 +383,9 @@ gfc_resolve_dot_product (gfc_expr * f, g
{
temp.expr_type = EXPR_OP;
gfc_clear_ts (&temp.ts);
- temp.operator = INTRINSIC_NONE;
- temp.op1 = a;
- temp.op2 = b;
+ temp.value.op.operator = INTRINSIC_NONE;
+ temp.value.op.op1 = a;
+ temp.value.op.op2 = b;
gfc_type_convert_binary (&temp);
f->ts = temp.ts;
}
@@ -753,9 +753,9 @@ gfc_resolve_matmul (gfc_expr * f, gfc_ex
{
temp.expr_type = EXPR_OP;
gfc_clear_ts (&temp.ts);
- temp.operator = INTRINSIC_NONE;
- temp.op1 = a;
- temp.op2 = b;
+ temp.value.op.operator = INTRINSIC_NONE;
+ temp.value.op.op1 = a;
+ temp.value.op.op2 = b;
gfc_type_convert_binary (&temp);
f->ts = temp.ts;
}
Index: matchexp.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/matchexp.c,v
retrieving revision 1.7
diff -u -p -r1.7 matchexp.c
--- matchexp.c 18 Jan 2005 12:11:53 -0000 1.7
+++ matchexp.c 8 Feb 2005 16:51:11 -0000
@@ -179,11 +179,11 @@ build_node (gfc_intrinsic_op operator, l
new = gfc_get_expr ();
new->expr_type = EXPR_OP;
- new->operator = operator;
+ new->value.op.operator = operator;
new->where = *where;
- new->op1 = op1;
- new->op2 = op2;
+ new->value.op.op1 = op1;
+ new->value.op.op2 = op2;
return new;
}
@@ -214,7 +214,7 @@ match_level_1 (gfc_expr ** result)
else
{
f = build_node (INTRINSIC_USER, &where, e, NULL);
- f->uop = uop;
+ f->value.op.uop = uop;
*result = f;
}
@@ -873,7 +873,7 @@ gfc_match_expr (gfc_expr ** result)
}
all = build_node (INTRINSIC_USER, &where, all, e);
- all->uop = uop;
+ all->value.op.uop = uop;
}
*result = all;
Index: module.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/module.c,v
retrieving revision 1.26
diff -u -p -r1.26 module.c
--- module.c 8 Feb 2005 13:40:59 -0000 1.26
+++ module.c 8 Feb 2005 16:51:12 -0000
@@ -2404,14 +2404,15 @@ mio_expr (gfc_expr ** ep)
switch (e->expr_type)
{
case EXPR_OP:
- e->operator = MIO_NAME(gfc_intrinsic_op) (e->operator, intrinsics);
+ e->value.op.operator
+ = MIO_NAME(gfc_intrinsic_op) (e->value.op.operator, intrinsics);
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
case INTRINSIC_NOT:
- mio_expr (&e->op1);
+ mio_expr (&e->value.op.op1);
break;
case INTRINSIC_PLUS:
@@ -2430,8 +2431,8 @@ mio_expr (gfc_expr ** ep)
case INTRINSIC_GE:
case INTRINSIC_LT:
case INTRINSIC_LE:
- mio_expr (&e->op1);
- mio_expr (&e->op2);
+ mio_expr (&e->value.op.op1);
+ mio_expr (&e->value.op.op2);
break;
default:
Index: resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.32
diff -u -p -r1.32 resolve.c
--- resolve.c 7 Feb 2005 22:16:13 -0000 1.32
+++ resolve.c 8 Feb 2005 16:51:14 -0000
@@ -1262,10 +1262,10 @@ resolve_operator (gfc_expr * e)
/* Resolve all subnodes-- give them types. */
- switch (e->operator)
+ switch (e->value.op.operator)
{
default:
- if (gfc_resolve_expr (e->op2) == FAILURE)
+ if (gfc_resolve_expr (e->value.op.op2) == FAILURE)
return FAILURE;
/* Fall through... */
@@ -1273,17 +1273,17 @@ resolve_operator (gfc_expr * e)
case INTRINSIC_NOT:
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
- if (gfc_resolve_expr (e->op1) == FAILURE)
+ if (gfc_resolve_expr (e->value.op.op1) == FAILURE)
return FAILURE;
break;
}
/* Typecheck the new node. */
- op1 = e->op1;
- op2 = e->op2;
+ op1 = e->value.op.op1;
+ op2 = e->value.op.op2;
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
@@ -1296,7 +1296,7 @@ resolve_operator (gfc_expr * e)
}
sprintf (msg, "Operand of unary numeric operator '%s' at %%L is %s",
- gfc_op2string (e->operator), gfc_typename (&e->ts));
+ gfc_op2string (e->value.op.operator), gfc_typename (&e->ts));
goto bad_op;
case INTRINSIC_PLUS:
@@ -1312,7 +1312,7 @@ resolve_operator (gfc_expr * e)
sprintf (msg,
"Operands of binary numeric operator '%s' at %%L are %s/%s",
- gfc_op2string (e->operator), gfc_typename (&op1->ts),
+ gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
@@ -1345,7 +1345,7 @@ resolve_operator (gfc_expr * e)
}
sprintf (msg, "Operands of logical operator '%s' at %%L are %s/%s",
- gfc_op2string (e->operator), gfc_typename (&op1->ts),
+ gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
@@ -1393,7 +1393,7 @@ resolve_operator (gfc_expr * e)
}
sprintf (msg, "Operands of comparison operator '%s' at %%L are %s/%s",
- gfc_op2string (e->operator), gfc_typename (&op1->ts),
+ gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
@@ -1401,10 +1401,10 @@ resolve_operator (gfc_expr * e)
case INTRINSIC_USER:
if (op2 == NULL)
sprintf (msg, "Operand of user operator '%s' at %%L is %s",
- e->uop->name, gfc_typename (&op1->ts));
+ e->value.op.uop->name, gfc_typename (&op1->ts));
else
sprintf (msg, "Operands of user operator '%s' at %%L are %s/%s",
- e->uop->name, gfc_typename (&op1->ts),
+ e->value.op.uop->name, gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
@@ -1417,7 +1417,7 @@ resolve_operator (gfc_expr * e)
t = SUCCESS;
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_PLUS:
case INTRINSIC_MINUS:
@@ -3327,23 +3327,27 @@ gfc_find_forall_index (gfc_expr *expr, g
gfc_error ("Unsupported statement while finding forall index in "
"expression");
break;
- default:
+
+ case EXPR_OP:
+ /* Find the FORALL index in the first operand. */
+ if (expr->value.op.op1)
+ {
+ if (gfc_find_forall_index (expr->value.op.op1, symbol) == SUCCESS)
+ return SUCCESS;
+ }
+
+ /* Find the FORALL index in the second operand. */
+ if (expr->value.op.op2)
+ {
+ if (gfc_find_forall_index (expr->value.op.op2, symbol) == SUCCESS)
+ return SUCCESS;
+ }
break;
- }
- /* Find the FORALL index in the first operand. */
- if (expr->op1)
- {
- if (gfc_find_forall_index (expr->op1, symbol) == SUCCESS)
- return SUCCESS;
+ default:
+ break;
}
- /* Find the FORALL index in the second operand. */
- if (expr->op2)
- {
- if (gfc_find_forall_index (expr->op2, symbol) == SUCCESS)
- return SUCCESS;
- }
return FAILURE;
}
Index: trans-array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.34
diff -u -p -r1.34 trans-array.c
--- trans-array.c 23 Jan 2005 14:36:25 -0000 1.34
+++ trans-array.c 8 Feb 2005 16:51:16 -0000
@@ -4194,18 +4194,18 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr
gfc_ss *head2;
gfc_ss *newss;
- head = gfc_walk_subexpr (ss, expr->op1);
- if (expr->op2 == NULL)
+ head = gfc_walk_subexpr (ss, expr->value.op.op1);
+ if (expr->value.op.op2 == NULL)
head2 = head;
else
- head2 = gfc_walk_subexpr (head, expr->op2);
+ head2 = gfc_walk_subexpr (head, expr->value.op.op2);
/* All operands are scalar. Pass back and let the caller deal with it. */
if (head2 == ss)
return head2;
/* All operands require scalarization. */
- if (head != ss && (expr->op2 == NULL || head2 != head))
+ if (head != ss && (expr->value.op.op2 == NULL || head2 != head))
return head2;
/* One of the operands needs scalarization, the other is scalar.
@@ -4223,7 +4223,7 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr
gcc_assert (head);
newss->next = ss;
head->next = newss;
- newss->expr = expr->op1;
+ newss->expr = expr->value.op.op1;
}
else /* head2 == head */
{
@@ -4231,7 +4231,7 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr
/* Second operand is scalar. */
newss->next = head2;
head2 = newss;
- newss->expr = expr->op2;
+ newss->expr = expr->value.op.op2;
}
return head2;
Index: trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.37
diff -u -p -r1.37 trans-expr.c
--- trans-expr.c 23 Jan 2005 14:36:25 -0000 1.37
+++ trans-expr.c 8 Feb 2005 16:51:17 -0000
@@ -414,7 +414,7 @@ gfc_conv_unary_op (enum tree_code code,
gcc_assert (expr->ts.type != BT_CHARACTER);
/* Initialize the operand. */
gfc_init_se (&operand, se);
- gfc_conv_expr_val (&operand, expr->op1);
+ gfc_conv_expr_val (&operand, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &operand.pre);
type = gfc_typenode_for_spec (&expr->ts);
@@ -607,25 +607,25 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
tree tmp;
gfc_init_se (&lse, se);
- gfc_conv_expr_val (&lse, expr->op1);
+ gfc_conv_expr_val (&lse, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &lse.pre);
gfc_init_se (&rse, se);
- gfc_conv_expr_val (&rse, expr->op2);
+ gfc_conv_expr_val (&rse, expr->value.op.op2);
gfc_add_block_to_block (&se->pre, &rse.pre);
- if (expr->op2->ts.type == BT_INTEGER
- && expr->op2->expr_type == EXPR_CONSTANT)
+ if (expr->value.op.op2->ts.type == BT_INTEGER
+ && expr->value.op.op2->expr_type == EXPR_CONSTANT)
if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
return;
gfc_int4_type_node = gfc_get_int_type (4);
- kind = expr->op1->ts.kind;
- switch (expr->op2->ts.type)
+ kind = expr->value.op.op1->ts.kind;
+ switch (expr->value.op.op2->ts.type)
{
case BT_INTEGER:
- ikind = expr->op2->ts.kind;
+ ikind = expr->value.op.op2->ts.kind;
switch (ikind)
{
case 1:
@@ -648,7 +648,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
{
case 1:
case 2:
- if (expr->op1->ts.type == BT_INTEGER)
+ if (expr->value.op.op1->ts.type == BT_INTEGER)
lse.expr = convert (gfc_int4_type_node, lse.expr);
else
gcc_unreachable ();
@@ -666,7 +666,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr
gcc_unreachable ();
}
- switch (expr->op1->ts.type)
+ switch (expr->value.op.op1->ts.type)
{
case BT_INTEGER:
fndecl = gfor_fndecl_math_powi[kind][ikind].integer;
@@ -780,14 +780,14 @@ gfc_conv_concat_op (gfc_se * se, gfc_exp
tree args;
tree tmp;
- gcc_assert (expr->op1->ts.type == BT_CHARACTER
- && expr->op2->ts.type == BT_CHARACTER);
+ gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER
+ && expr->value.op.op2->ts.type == BT_CHARACTER);
gfc_init_se (&lse, se);
- gfc_conv_expr (&lse, expr->op1);
+ gfc_conv_expr (&lse, expr->value.op.op1);
gfc_conv_string_parameter (&lse);
gfc_init_se (&rse, se);
- gfc_conv_expr (&rse, expr->op2);
+ gfc_conv_expr (&rse, expr->value.op.op2);
gfc_conv_string_parameter (&rse);
gfc_add_block_to_block (&se->pre, &lse.pre);
@@ -846,10 +846,10 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr
checkstring = 0;
lop = 0;
- switch (expr->operator)
+ switch (expr->value.op.operator)
{
case INTRINSIC_UPLUS:
- gfc_conv_expr (se, expr->op1);
+ gfc_conv_expr (se, expr->value.op.op1);
return;
case INTRINSIC_UMINUS:
@@ -951,19 +951,19 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr
}
/* The only exception to this is **, which is handled separately anyway. */
- gcc_assert (expr->op1->ts.type == expr->op2->ts.type);
+ gcc_assert (expr->value.op.op1->ts.type == expr->value.op.op2->ts.type);
- if (checkstring && expr->op1->ts.type != BT_CHARACTER)
+ if (checkstring && expr->value.op.op1->ts.type != BT_CHARACTER)
checkstring = 0;
/* lhs */
gfc_init_se (&lse, se);
- gfc_conv_expr (&lse, expr->op1);
+ gfc_conv_expr (&lse, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &lse.pre);
/* rhs */
gfc_init_se (&rse, se);
- gfc_conv_expr (&rse, expr->op2);
+ gfc_conv_expr (&rse, expr->value.op.op2);
gfc_add_block_to_block (&se->pre, &rse.pre);
/* For string comparisons we generate a library call, and compare the return