diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 51cfdbb52c4..07984071988 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,34 @@ +2009-05-13 Steven G. Kargl + + * gfortran.h (gfc_code): Rename struct member expr to expr1. + * openmp.c (resolve_omp_atomic): Update expr to expr1. + * interface.c (gfc_extend_assign): Ditto. + * trans-expr.c (gfc_conv_expr_reference, gfc_trans_assignment, + gfc_trans_init_assign): Ditto. + * dump-parse-tree.c (show_code_node): Ditto. + * trans-openmp.c (gfc_trans_omp_atomic): Ditto. + * trans-stmt.c ( gfc_trans_label_assign, gfc_trans_goto, gfc_trans_call, + gfc_trans_return, gfc_trans_pause, gfc_trans_stop, gfc_trans_if_1, + gfc_trans_arithmetic_if, gfc_trans_do_while, gfc_trans_integer_select, + gfc_trans_logical_select, gfc_trans_character_select + forall_make_variable_temp, check_forall_dependencies + gfc_trans_forall_1, gfc_trans_where_2, gfc_trans_where_3 + gfc_trans_where, gfc_trans_allocate, gfc_trans_deallocate): Ditto. + * io.c (match_io_element, gfc_match_inquire): Ditto. + * resolve.c (resolve_typebound_call, resolve_ppc_call, + resolve_allocate_expr, resolve_allocate_deallocate, resolve_select, + resolve_transfer, resolve_where, gfc_resolve_assign_in_forall, + gfc_resolve_blocks, resolve_code, build_init_assign): Ditto. + * st.c (gfc_free_statement): Ditto. + * match.c (gfc_match_assignment, gfc_match_pointer_assignment, + match_arithmetic_if, gfc_match_if, gfc_match_elseif + gfc_match_stopcode, gfc_match_assign, gfc_match_goto, + gfc_match_nullify, match_typebound_call, gfc_match_call + gfc_match_select, match_simple_where, gfc_match_where + gfc_match_elsewhere, match_simple_forall, gfc_match_forall): Ditto. + * trans-io.c (gfc_trans_transfer): Ditto. + * parse.c (parse_where_block, parse_if_block): Ditto. + 2009-05-13 Steven G. Kargl * gfortran.h (gfc_code): Rename struct member label to label1. diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 8c8ad8d32de..eb747c1bd6a 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1166,20 +1166,20 @@ show_code_node (int level, gfc_code *c) case EXEC_INIT_ASSIGN: case EXEC_ASSIGN: fputs ("ASSIGN ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); fputc (' ', dumpfile); show_expr (c->expr2); break; case EXEC_LABEL_ASSIGN: fputs ("LABEL ASSIGN ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); fprintf (dumpfile, " %d", c->label1->value); break; case EXEC_POINTER_ASSIGN: fputs ("POINTER ASSIGN ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); fputc (' ', dumpfile); show_expr (c->expr2); break; @@ -1190,7 +1190,7 @@ show_code_node (int level, gfc_code *c) fprintf (dumpfile, "%d", c->label1->value); else { - show_expr (c->expr); + show_expr (c->expr1); d = c->block; if (d != NULL) { @@ -1221,26 +1221,26 @@ show_code_node (int level, gfc_code *c) case EXEC_COMPCALL: fputs ("CALL ", dumpfile); - show_compcall (c->expr); + show_compcall (c->expr1); break; case EXEC_CALL_PPC: fputs ("CALL ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); show_actual_arglist (c->ext.actual); break; case EXEC_RETURN: fputs ("RETURN ", dumpfile); - if (c->expr) - show_expr (c->expr); + if (c->expr1) + show_expr (c->expr1); break; case EXEC_PAUSE: fputs ("PAUSE ", dumpfile); - if (c->expr != NULL) - show_expr (c->expr); + if (c->expr1 != NULL) + show_expr (c->expr1); else fprintf (dumpfile, "%d", c->ext.stop_code); @@ -1249,8 +1249,8 @@ show_code_node (int level, gfc_code *c) case EXEC_STOP: fputs ("STOP ", dumpfile); - if (c->expr != NULL) - show_expr (c->expr); + if (c->expr1 != NULL) + show_expr (c->expr1); else fprintf (dumpfile, "%d", c->ext.stop_code); @@ -1258,7 +1258,7 @@ show_code_node (int level, gfc_code *c) case EXEC_ARITHMETIC_IF: fputs ("IF ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); fprintf (dumpfile, " %d, %d, %d", c->label1->value, c->label2->value, c->label3->value); break; @@ -1266,7 +1266,7 @@ show_code_node (int level, gfc_code *c) case EXEC_IF: d = c->block; fputs ("IF ", dumpfile); - show_expr (d->expr); + show_expr (d->expr1); fputc ('\n', dumpfile); show_code (level + 1, d->next); @@ -1275,12 +1275,12 @@ show_code_node (int level, gfc_code *c) { code_indent (level, 0); - if (d->expr == NULL) + if (d->expr1 == NULL) fputs ("ELSE\n", dumpfile); else { fputs ("ELSE IF ", dumpfile); - show_expr (d->expr); + show_expr (d->expr1); fputc ('\n', dumpfile); } @@ -1295,7 +1295,7 @@ show_code_node (int level, gfc_code *c) case EXEC_SELECT: d = c->block; fputs ("SELECT CASE ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); fputc ('\n', dumpfile); for (; d; d = d->block) @@ -1325,7 +1325,7 @@ show_code_node (int level, gfc_code *c) fputs ("WHERE ", dumpfile); d = c->block; - show_expr (d->expr); + show_expr (d->expr1); fputc ('\n', dumpfile); show_code (level + 1, d->next); @@ -1334,7 +1334,7 @@ show_code_node (int level, gfc_code *c) { code_indent (level, 0); fputs ("ELSE WHERE ", dumpfile); - show_expr (d->expr); + show_expr (d->expr1); fputc ('\n', dumpfile); show_code (level + 1, d->next); } @@ -1360,10 +1360,10 @@ show_code_node (int level, gfc_code *c) fputc (',', dumpfile); } - if (c->expr != NULL) + if (c->expr1 != NULL) { fputc (',', dumpfile); - show_expr (c->expr); + show_expr (c->expr1); } fputc ('\n', dumpfile); @@ -1393,7 +1393,7 @@ show_code_node (int level, gfc_code *c) case EXEC_DO_WHILE: fputs ("DO WHILE ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); fputc ('\n', dumpfile); show_code (level + 1, c->block->next); @@ -1416,10 +1416,10 @@ show_code_node (int level, gfc_code *c) case EXEC_ALLOCATE: fputs ("ALLOCATE ", dumpfile); - if (c->expr) + if (c->expr1) { fputs (" STAT=", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); } for (a = c->ext.alloc_list; a; a = a->next) @@ -1432,10 +1432,10 @@ show_code_node (int level, gfc_code *c) case EXEC_DEALLOCATE: fputs ("DEALLOCATE ", dumpfile); - if (c->expr) + if (c->expr1) { fputs (" STAT=", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); } for (a = c->ext.alloc_list; a; a = a->next) @@ -1798,7 +1798,7 @@ show_code_node (int level, gfc_code *c) case EXEC_IOLENGTH: fputs ("IOLENGTH ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); goto show_dt_code; break; @@ -1907,7 +1907,7 @@ show_code_node (int level, gfc_code *c) case EXEC_TRANSFER: fputs ("TRANSFER ", dumpfile); - show_expr (c->expr); + show_expr (c->expr1); break; case EXEC_DT_END: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 97c9c1f9ec9..86f2c5bf252 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1915,7 +1915,7 @@ typedef struct gfc_code gfc_st_label *here, *label1, *label2, *label3; gfc_symtree *symtree; - gfc_expr *expr, *expr2; + gfc_expr *expr1, *expr2; /* A name isn't sufficient to identify a subroutine, we need the actual symbol for the interface definition. const char *sub_name; */ diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 3c03f959fb2..ee1f5286309 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2591,7 +2591,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) gfc_expr *lhs, *rhs; gfc_symbol *sym; - lhs = c->expr; + lhs = c->expr1; rhs = c->expr2; /* Don't allow an intrinsic assignment to be replaced. */ @@ -2626,7 +2626,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) /* Replace the assignment with the call. */ c->op = EXEC_ASSIGN_CALL; c->symtree = gfc_find_sym_in_symtree (sym); - c->expr = NULL; + c->expr1 = NULL; c->expr2 = NULL; c->ext.actual = actual; diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 57e65f85422..eb0e3ae6b28 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -2830,7 +2830,7 @@ match_io_element (io_kind k, gfc_code **cpp) cp = gfc_get_code (); cp->op = EXEC_TRANSFER; - cp->expr = expr; + cp->expr1 = expr; *cpp = cp; return MATCH_YES; @@ -3662,7 +3662,7 @@ gfc_match_inquire (void) goto syntax; new_st.op = EXEC_IOLENGTH; - new_st.expr = inquire->iolength; + new_st.expr1 = inquire->iolength; new_st.ext.inquire = inquire; if (gfc_pure (NULL)) diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 3a49ca19ea3..ed7bf58bb86 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1306,7 +1306,7 @@ gfc_match_assignment (void) gfc_set_sym_referenced (lvalue->symtree->n.sym); new_st.op = EXEC_ASSIGN; - new_st.expr = lvalue; + new_st.expr1 = lvalue; new_st.expr2 = rvalue; gfc_check_do_variable (lvalue->symtree); @@ -1346,7 +1346,7 @@ gfc_match_pointer_assignment (void) goto cleanup; new_st.op = EXEC_POINTER_ASSIGN; - new_st.expr = lvalue; + new_st.expr1 = lvalue; new_st.expr2 = rvalue; return MATCH_YES; @@ -1388,7 +1388,7 @@ match_arithmetic_if (void) return MATCH_ERROR; new_st.op = EXEC_ARITHMETIC_IF; - new_st.expr = expr; + new_st.expr1 = expr; new_st.label1 = l1; new_st.label2 = l2; new_st.label3 = l3; @@ -1469,7 +1469,7 @@ gfc_match_if (gfc_statement *if_type) return MATCH_ERROR; new_st.op = EXEC_ARITHMETIC_IF; - new_st.expr = expr; + new_st.expr1 = expr; new_st.label1 = l1; new_st.label2 = l2; new_st.label3 = l3; @@ -1481,7 +1481,7 @@ gfc_match_if (gfc_statement *if_type) if (gfc_match (" then%t") == MATCH_YES) { new_st.op = EXEC_IF; - new_st.expr = expr; + new_st.expr1 = expr; *if_type = ST_IF_BLOCK; return MATCH_YES; } @@ -1601,7 +1601,7 @@ got_match: *p->next = new_st; p->next->loc = gfc_current_locus; - p->expr = expr; + p->expr1 = expr; p->op = EXEC_IF; gfc_clear_new_st (); @@ -1677,7 +1677,7 @@ gfc_match_elseif (void) done: new_st.op = EXEC_IF; - new_st.expr = expr; + new_st.expr1 = expr; return MATCH_YES; cleanup: @@ -1792,7 +1792,7 @@ done: new_st.label1 = label; if (new_st.op == EXEC_DO_WHILE) - new_st.expr = iter.end; + new_st.expr1 = iter.end; else { new_st.ext.iterator = ip = gfc_get_iterator (); @@ -1952,7 +1952,7 @@ gfc_match_stopcode (gfc_statement st) } new_st.op = st == ST_STOP ? EXEC_STOP : EXEC_PAUSE; - new_st.expr = e; + new_st.expr1 = e; new_st.ext.stop_code = stop_code; return MATCH_YES; @@ -2034,7 +2034,7 @@ gfc_match_assign (void) new_st.op = EXEC_LABEL_ASSIGN; new_st.label1 = label; - new_st.expr = expr; + new_st.expr1 = expr; return MATCH_YES; } } @@ -2077,7 +2077,7 @@ gfc_match_goto (void) return MATCH_ERROR; new_st.op = EXEC_GOTO; - new_st.expr = expr; + new_st.expr1 = expr; if (gfc_match_eos () == MATCH_YES) return MATCH_YES; @@ -2184,7 +2184,7 @@ gfc_match_goto (void) equivalent SELECT statement constructed. */ new_st.op = EXEC_SELECT; - new_st.expr = NULL; + new_st.expr1 = NULL; /* Hack: For a "real" SELECT, the expression is in expr. We put it in expr2 so we can distinguish then and produce the correct @@ -2337,7 +2337,7 @@ alloc_opt_list: goto syntax; new_st.op = EXEC_ALLOCATE; - new_st.expr = stat; + new_st.expr1 = stat; new_st.expr2 = errmsg; new_st.ext.alloc_list = head; @@ -2402,7 +2402,7 @@ gfc_match_nullify (void) } tail->op = EXEC_POINTER_ASSIGN; - tail->expr = p; + tail->expr1 = p; tail->expr2 = e; if (gfc_match (" )%t") == MATCH_YES) @@ -2538,7 +2538,7 @@ dealloc_opt_list: goto syntax; new_st.op = EXEC_DEALLOCATE; - new_st.expr = stat; + new_st.expr1 = stat; new_st.expr2 = errmsg; new_st.ext.alloc_list = head; @@ -2606,7 +2606,7 @@ done: return MATCH_ERROR; new_st.op = EXEC_RETURN; - new_st.expr = e; + new_st.expr1 = e; return MATCH_YES; } @@ -2652,7 +2652,7 @@ match_typebound_call (gfc_symtree* varst) "at %C"); return MATCH_ERROR; } - new_st.expr = base; + new_st.expr1 = base; return MATCH_YES; } @@ -2755,11 +2755,11 @@ gfc_match_call (void) select_sym->ts.type = BT_INTEGER; select_sym->ts.kind = gfc_default_integer_kind; gfc_set_sym_referenced (select_sym); - c->expr = gfc_get_expr (); - c->expr->expr_type = EXPR_VARIABLE; - c->expr->symtree = select_st; - c->expr->ts = select_sym->ts; - c->expr->where = gfc_current_locus; + c->expr1 = gfc_get_expr (); + c->expr1->expr_type = EXPR_VARIABLE; + c->expr1->symtree = select_st; + c->expr1->ts = select_sym->ts; + c->expr1->where = gfc_current_locus; i = 0; for (a = arglist; a; a = a->next) @@ -3655,7 +3655,7 @@ gfc_match_select (void) return m; new_st.op = EXEC_SELECT; - new_st.expr = expr; + new_st.expr1 = expr; return MATCH_YES; } @@ -3760,7 +3760,7 @@ match_simple_where (void) c = gfc_get_code (); c->op = EXEC_WHERE; - c->expr = expr; + c->expr1 = expr; c->next = gfc_get_code (); *c->next = new_st; @@ -3801,7 +3801,7 @@ gfc_match_where (gfc_statement *st) { *st = ST_WHERE_BLOCK; new_st.op = EXEC_WHERE; - new_st.expr = expr; + new_st.expr1 = expr; return MATCH_YES; } @@ -3820,7 +3820,7 @@ gfc_match_where (gfc_statement *st) c = gfc_get_code (); c->op = EXEC_WHERE; - c->expr = expr; + c->expr1 = expr; c->next = gfc_get_code (); *c->next = new_st; @@ -3890,7 +3890,7 @@ gfc_match_elsewhere (void) } new_st.op = EXEC_WHERE; - new_st.expr = expr; + new_st.expr1 = expr; return MATCH_YES; syntax: @@ -4107,7 +4107,7 @@ match_simple_forall (void) gfc_clear_new_st (); new_st.op = EXEC_FORALL; - new_st.expr = mask; + new_st.expr1 = mask; new_st.ext.forall_iterator = head; new_st.block = gfc_get_code (); @@ -4159,7 +4159,7 @@ gfc_match_forall (gfc_statement *st) { *st = ST_FORALL_BLOCK; new_st.op = EXEC_FORALL; - new_st.expr = mask; + new_st.expr1 = mask; new_st.ext.forall_iterator = head; return MATCH_YES; } @@ -4182,7 +4182,7 @@ gfc_match_forall (gfc_statement *st) gfc_clear_new_st (); new_st.op = EXEC_FORALL; - new_st.expr = mask; + new_st.expr1 = mask; new_st.ext.forall_iterator = head; new_st.block = gfc_get_code (); new_st.block->op = EXEC_FORALL; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 9ac9a4aec91..0e9dda80ce6 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1072,20 +1072,20 @@ resolve_omp_atomic (gfc_code *code) gcc_assert (code->op == EXEC_ASSIGN); gcc_assert (code->next == NULL); - if (code->expr->expr_type != EXPR_VARIABLE - || code->expr->symtree == NULL - || code->expr->rank != 0 - || (code->expr->ts.type != BT_INTEGER - && code->expr->ts.type != BT_REAL - && code->expr->ts.type != BT_COMPLEX - && code->expr->ts.type != BT_LOGICAL)) + if (code->expr1->expr_type != EXPR_VARIABLE + || code->expr1->symtree == NULL + || code->expr1->rank != 0 + || (code->expr1->ts.type != BT_INTEGER + && code->expr1->ts.type != BT_REAL + && code->expr1->ts.type != BT_COMPLEX + && code->expr1->ts.type != BT_LOGICAL)) { gfc_error ("!$OMP ATOMIC statement must set a scalar variable of " "intrinsic type at %L", &code->loc); return; } - var = code->expr->symtree->n.sym; + var = code->expr1->symtree->n.sym; expr2 = is_conversion (code->expr2, false); if (expr2 == NULL) expr2 = code->expr2; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 3dec1735b23..0b2cbf3cb0e 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2508,10 +2508,10 @@ parse_where_block (void) push_state (&s, COMP_WHERE, gfc_new_block); d = add_statement (); - d->expr = top->expr; + d->expr1 = top->expr1; d->op = EXEC_WHERE; - top->expr = NULL; + top->expr1 = NULL; top->block = d; seen_empty_else = 0; @@ -2541,12 +2541,12 @@ parse_where_block (void) break; } - if (new_st.expr == NULL) + if (new_st.expr1 == NULL) seen_empty_else = 1; d = new_level (gfc_state_stack->head); d->op = EXEC_WHERE; - d->expr = new_st.expr; + d->expr1 = new_st.expr1; accept_statement (st); @@ -2651,8 +2651,8 @@ parse_if_block (void) new_st.op = EXEC_IF; d = add_statement (); - d->expr = top->expr; - top->expr = NULL; + d->expr1 = top->expr1; + top->expr1 = NULL; top->block = d; do @@ -2676,7 +2676,7 @@ parse_if_block (void) d = new_level (gfc_state_stack->head); d->op = EXEC_IF; - d->expr = new_st.expr; + d->expr1 = new_st.expr1; accept_statement (st); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 028235b8794..dbca1752b55 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4738,31 +4738,31 @@ resolve_typebound_call (gfc_code* c) gfc_symtree* target; /* Check that's really a SUBROUTINE. */ - if (!c->expr->value.compcall.tbp->subroutine) + if (!c->expr1->value.compcall.tbp->subroutine) { gfc_error ("'%s' at %L should be a SUBROUTINE", - c->expr->value.compcall.name, &c->loc); + c->expr1->value.compcall.name, &c->loc); return FAILURE; } - if (check_typebound_baseobject (c->expr) == FAILURE) + if (check_typebound_baseobject (c->expr1) == FAILURE) return FAILURE; - if (resolve_typebound_generic_call (c->expr) == FAILURE) + if (resolve_typebound_generic_call (c->expr1) == FAILURE) return FAILURE; /* Transform into an ordinary EXEC_CALL for now. */ - if (resolve_typebound_static (c->expr, &target, &newactual) == FAILURE) + if (resolve_typebound_static (c->expr1, &target, &newactual) == FAILURE) return FAILURE; c->ext.actual = newactual; c->symtree = target; c->op = EXEC_CALL; - gcc_assert (!c->expr->ref && !c->expr->value.compcall.actual); - gfc_free_expr (c->expr); - c->expr = NULL; + gcc_assert (!c->expr1->ref && !c->expr1->value.compcall.actual); + gfc_free_expr (c->expr1); + c->expr1 = NULL; return resolve_call (c); } @@ -4819,22 +4819,22 @@ static gfc_try resolve_ppc_call (gfc_code* c) { gfc_component *comp; - gcc_assert (is_proc_ptr_comp (c->expr, &comp)); + gcc_assert (is_proc_ptr_comp (c->expr1, &comp)); - c->resolved_sym = c->expr->symtree->n.sym; - c->expr->expr_type = EXPR_VARIABLE; - c->ext.actual = c->expr->value.compcall.actual; + c->resolved_sym = c->expr1->symtree->n.sym; + c->expr1->expr_type = EXPR_VARIABLE; + c->ext.actual = c->expr1->value.compcall.actual; if (!comp->attr.subroutine) - gfc_add_subroutine (&comp->attr, comp->name, &c->expr->where); + gfc_add_subroutine (&comp->attr, comp->name, &c->expr1->where); if (resolve_actual_arglist (c->ext.actual, comp->attr.proc, comp->formal == NULL) == FAILURE) return FAILURE; /* TODO: Check actual arguments. - gfc_procedure_use (stree->n.sym, &c->expr->value.compcall.actual, - &c->expr->where);*/ + gfc_procedure_use (stree->n.sym, &c->expr1->value.compcall.actual, + &c->expr1->where);*/ return SUCCESS; } @@ -5412,7 +5412,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) init_st = gfc_get_code (); init_st->loc = code->loc; init_st->op = EXEC_INIT_ASSIGN; - init_st->expr = expr_to_initialize (e); + init_st->expr1 = expr_to_initialize (e); init_st->expr2 = init_e; init_st->next = code->next; code->next = init_st; @@ -5492,7 +5492,7 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) gfc_expr *stat, *errmsg, *pe, *qe; gfc_alloc *a, *p, *q; - stat = code->expr ? code->expr : NULL; + stat = code->expr1 ? code->expr1 : NULL; errmsg = code->expr2 ? code->expr2 : NULL; @@ -5843,7 +5843,7 @@ resolve_select (gfc_code *code) bt type; gfc_try t; - if (code->expr == NULL) + if (code->expr1 == NULL) { /* This was actually a computed GOTO statement. */ case_expr = code->expr2; @@ -5856,12 +5856,12 @@ resolve_select (gfc_code *code) by the compiler, so it should always be OK. Just move the case_expr from expr2 to expr so that we can handle computed GOTOs as normal SELECTs from here on. */ - code->expr = code->expr2; + code->expr1 = code->expr2; code->expr2 = NULL; return; } - case_expr = code->expr; + case_expr = code->expr1; type = case_expr->ts.type; if (type != BT_LOGICAL && type != BT_INTEGER && type != BT_CHARACTER) @@ -6114,7 +6114,7 @@ resolve_transfer (gfc_code *code) gfc_ref *ref; gfc_expr *exp; - exp = code->expr; + exp = code->expr1; if (exp->expr_type != EXPR_VARIABLE && exp->expr_type != EXPR_FUNCTION) return; @@ -6123,7 +6123,7 @@ resolve_transfer (gfc_code *code) ts = &sym->ts; /* Go to actual component transferred. */ - for (ref = code->expr->ref; ref; ref = ref->next) + for (ref = code->expr1->ref; ref; ref = ref->next) if (ref->type == REF_COMPONENT) ts = &ref->u.c.component->ts; @@ -6319,19 +6319,19 @@ resolve_where (gfc_code *code, gfc_expr *mask) /* Store the first WHERE mask-expr of the WHERE statement or construct. In case of nested WHERE, only the outmost one is stored. */ if (mask == NULL) /* outmost WHERE */ - e = cblock->expr; + e = cblock->expr1; else /* inner WHERE */ e = mask; while (cblock) { - if (cblock->expr) + if (cblock->expr1) { /* Check if the mask-expr has a consistent shape with the outmost WHERE mask-expr. */ - if (resolve_where_shape (cblock->expr, e) == FAILURE) + if (resolve_where_shape (cblock->expr1, e) == FAILURE) gfc_error ("WHERE mask at %L has inconsistent shape", - &cblock->expr->where); + &cblock->expr1->where); } /* the assignment statement of a WHERE statement, or the first @@ -6345,9 +6345,9 @@ resolve_where (gfc_code *code, gfc_expr *mask) case EXEC_ASSIGN: /* Check shape consistent for WHERE assignment target. */ - if (e && resolve_where_shape (cnext->expr, e) == FAILURE) + if (e && resolve_where_shape (cnext->expr1, e) == FAILURE) gfc_error ("WHERE assignment target at %L has " - "inconsistent shape", &cnext->expr->where); + "inconsistent shape", &cnext->expr1->where); break; @@ -6393,21 +6393,21 @@ gfc_resolve_assign_in_forall (gfc_code *code, int nvar, gfc_expr **var_expr) /* Check whether the assignment target is one of the FORALL index variable. */ - if ((code->expr->expr_type == EXPR_VARIABLE) - && (code->expr->symtree->n.sym == forall_index)) + if ((code->expr1->expr_type == EXPR_VARIABLE) + && (code->expr1->symtree->n.sym == forall_index)) gfc_error ("Assignment to a FORALL index variable at %L", - &code->expr->where); + &code->expr1->where); else { /* If one of the FORALL index variables doesn't appear in the assignment variable, then there could be a many-to-one assignment. Emit a warning rather than an error because the mask could be resolving this problem. */ - if (find_forall_index (code->expr, forall_index, 0) == FAILURE) + if (find_forall_index (code->expr1, forall_index, 0) == FAILURE) gfc_warning ("The FORALL with index '%s' is not used on the " "left side of the assignment at %L and so might " "cause multiple assignment to this object", - var_expr[n]->symtree->name, &code->expr->where); + var_expr[n]->symtree->name, &code->expr1->where); } } } @@ -6623,25 +6623,25 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) for (; b; b = b->block) { - t = gfc_resolve_expr (b->expr); + t = gfc_resolve_expr (b->expr1); if (gfc_resolve_expr (b->expr2) == FAILURE) t = FAILURE; switch (b->op) { case EXEC_IF: - if (t == SUCCESS && b->expr != NULL - && (b->expr->ts.type != BT_LOGICAL || b->expr->rank != 0)) + if (t == SUCCESS && b->expr1 != NULL + && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0)) gfc_error ("IF clause at %L requires a scalar LOGICAL expression", - &b->expr->where); + &b->expr1->where); break; case EXEC_WHERE: if (t == SUCCESS - && b->expr != NULL - && (b->expr->ts.type != BT_LOGICAL || b->expr->rank == 0)) + && b->expr1 != NULL + && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank == 0)) gfc_error ("WHERE/ELSEWHERE clause at %L requires a LOGICAL array", - &b->expr->where); + &b->expr1->where); break; case EXEC_GOTO: @@ -6719,7 +6719,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) return true; } - lhs = code->expr; + lhs = code->expr1; rhs = code->expr2; if (rhs->is_boz @@ -6888,7 +6888,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) t = SUCCESS; if (code->op != EXEC_COMPCALL && code->op != EXEC_CALL_PPC) - t = gfc_resolve_expr (code->expr); + t = gfc_resolve_expr (code->expr1); forall_flag = forall_save; if (gfc_resolve_expr (code->expr2) == FAILURE) @@ -6916,25 +6916,25 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_GOTO: - if (code->expr != NULL) + if (code->expr1 != NULL) { - if (code->expr->ts.type != BT_INTEGER) + if (code->expr1->ts.type != BT_INTEGER) gfc_error ("ASSIGNED GOTO statement at %L requires an " - "INTEGER variable", &code->expr->where); - else if (code->expr->symtree->n.sym->attr.assign != 1) + "INTEGER variable", &code->expr1->where); + else if (code->expr1->symtree->n.sym->attr.assign != 1) gfc_error ("Variable '%s' has not been assigned a target " - "label at %L", code->expr->symtree->n.sym->name, - &code->expr->where); + "label at %L", code->expr1->symtree->n.sym->name, + &code->expr1->where); } else resolve_branch (code->label1, code); break; case EXEC_RETURN: - if (code->expr != NULL - && (code->expr->ts.type != BT_INTEGER || code->expr->rank)) + if (code->expr1 != NULL + && (code->expr1->ts.type != BT_INTEGER || code->expr1->rank)) gfc_error ("Alternate RETURN statement at %L requires a SCALAR-" - "INTEGER return specifier", &code->expr->where); + "INTEGER return specifier", &code->expr1->where); break; case EXEC_INIT_ASSIGN: @@ -6955,28 +6955,28 @@ resolve_code (gfc_code *code, gfc_namespace *ns) gfc_error ("Label %d referenced at %L is never defined", code->label1->value, &code->label1->where); if (t == SUCCESS - && (code->expr->expr_type != EXPR_VARIABLE - || code->expr->symtree->n.sym->ts.type != BT_INTEGER - || code->expr->symtree->n.sym->ts.kind + && (code->expr1->expr_type != EXPR_VARIABLE + || code->expr1->symtree->n.sym->ts.type != BT_INTEGER + || code->expr1->symtree->n.sym->ts.kind != gfc_default_integer_kind - || code->expr->symtree->n.sym->as != NULL)) + || code->expr1->symtree->n.sym->as != NULL)) gfc_error ("ASSIGN statement at %L requires a scalar " - "default INTEGER variable", &code->expr->where); + "default INTEGER variable", &code->expr1->where); break; case EXEC_POINTER_ASSIGN: if (t == FAILURE) break; - gfc_check_pointer_assign (code->expr, code->expr2); + gfc_check_pointer_assign (code->expr1, code->expr2); break; case EXEC_ARITHMETIC_IF: if (t == SUCCESS - && code->expr->ts.type != BT_INTEGER - && code->expr->ts.type != BT_REAL) + && code->expr1->ts.type != BT_INTEGER + && code->expr1->ts.type != BT_REAL) gfc_error ("Arithmetic IF statement at %L requires a numeric " - "expression", &code->expr->where); + "expression", &code->expr1->where); resolve_branch (code->label1, code); resolve_branch (code->label2, code); @@ -6984,11 +6984,11 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_IF: - if (t == SUCCESS && code->expr != NULL - && (code->expr->ts.type != BT_LOGICAL - || code->expr->rank != 0)) + if (t == SUCCESS && code->expr1 != NULL + && (code->expr1->ts.type != BT_LOGICAL + || code->expr1->rank != 0)) gfc_error ("IF clause at %L requires a scalar LOGICAL expression", - &code->expr->where); + &code->expr1->where); break; case EXEC_CALL: @@ -7020,13 +7020,13 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_DO_WHILE: - if (code->expr == NULL) + if (code->expr1 == NULL) gfc_internal_error ("resolve_code(): No expression on DO WHILE"); if (t == SUCCESS - && (code->expr->rank != 0 - || code->expr->ts.type != BT_LOGICAL)) + && (code->expr1->rank != 0 + || code->expr1->ts.type != BT_LOGICAL)) gfc_error ("Exit condition of DO WHILE loop at %L must be " - "a scalar LOGICAL expression", &code->expr->where); + "a scalar LOGICAL expression", &code->expr1->where); break; case EXEC_ALLOCATE: @@ -7106,9 +7106,9 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_FORALL: resolve_forall_iterators (code->ext.forall_iterator); - if (code->expr != NULL && code->expr->ts.type != BT_LOGICAL) + if (code->expr1 != NULL && code->expr1->ts.type != BT_LOGICAL) gfc_error ("FORALL mask clause at %L requires a LOGICAL " - "expression", &code->expr->where); + "expression", &code->expr1->where); break; case EXEC_OMP_ATOMIC: @@ -7479,7 +7479,7 @@ build_init_assign (gfc_symbol *sym, gfc_expr *init) /* Assign the default initializer to the l-value. */ init_st->loc = sym->declared_at; init_st->op = EXEC_INIT_ASSIGN; - init_st->expr = lval; + init_st->expr1 = lval; init_st->expr2 = init; } diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 866f9bfbdf2..d77ef81822c 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -80,8 +80,8 @@ gfc_append_code (gfc_code *tail, gfc_code *new_code) void gfc_free_statement (gfc_code *p) { - if (p->expr) - gfc_free_expr (p->expr); + if (p->expr1) + gfc_free_expr (p->expr1); if (p->expr2) gfc_free_expr (p->expr2); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 14f64c96ab8..70c44f32968 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4014,7 +4014,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) tree gfc_trans_pointer_assign (gfc_code * code) { - return gfc_trans_pointer_assignment (code->expr, code->expr2); + return gfc_trans_pointer_assignment (code->expr1, code->expr2); } @@ -4839,11 +4839,11 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) tree gfc_trans_init_assign (gfc_code * code) { - return gfc_trans_assignment (code->expr, code->expr2, true); + return gfc_trans_assignment (code->expr1, code->expr2, true); } tree gfc_trans_assign (gfc_code * code) { - return gfc_trans_assignment (code->expr, code->expr2, false); + return gfc_trans_assignment (code->expr1, code->expr2, false); } diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index b1543051259..09f35b79c90 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -2149,7 +2149,7 @@ gfc_trans_transfer (gfc_code * code) gfc_start_block (&block); gfc_init_block (&body); - expr = code->expr; + expr = code->expr1; ss = gfc_walk_expr (expr); ref = NULL; @@ -2209,7 +2209,7 @@ gfc_trans_transfer (gfc_code * code) /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &code->expr->where); + gfc_conv_loop_setup (&loop, &code->expr1->where); /* The main loop body. */ gfc_mark_ss_chain_used (ss, 1); diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 5ad2f9cc669..88bfe3c4bf2 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -952,13 +952,13 @@ gfc_trans_omp_atomic (gfc_code *code) code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); gcc_assert (code->next == NULL); - var = code->expr->symtree->n.sym; + var = code->expr1->symtree->n.sym; gfc_init_se (&lse, NULL); gfc_init_se (&rse, NULL); gfc_start_block (&block); - gfc_conv_expr (&lse, code->expr); + gfc_conv_expr (&lse, code->expr1); gfc_add_block_to_block (&block, &lse.pre); type = TREE_TYPE (lse.expr); lhsaddr = gfc_build_addr_expr (NULL, lse.expr); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 1f05738dac5..1a1352de8dd 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -104,7 +104,7 @@ gfc_trans_label_assign (gfc_code * code) /* Start a new block. */ gfc_init_se (&se, NULL); gfc_start_block (&se.pre); - gfc_conv_label_variable (&se, code->expr); + gfc_conv_label_variable (&se, code->expr1); len = GFC_DECL_STRING_LEN (se.expr); addr = GFC_DECL_ASSIGN_ADDR (se.expr); @@ -150,7 +150,7 @@ gfc_trans_goto (gfc_code * code) /* ASSIGNED GOTO. */ gfc_init_se (&se, NULL); gfc_start_block (&se.pre); - gfc_conv_label_variable (&se, code->expr); + gfc_conv_label_variable (&se, code->expr1); tmp = GFC_DECL_STRING_LEN (se.expr); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), -1)); @@ -363,7 +363,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check, /* Translate the call. */ has_alternate_specifier = gfc_conv_procedure_call (&se, code->resolved_sym, code->ext.actual, - code->expr, NULL_TREE); + code->expr1, NULL_TREE); /* A subroutine without side-effect, by definition, does nothing! */ TREE_SIDE_EFFECTS (se.expr) = 1; @@ -375,7 +375,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check, gfc_symbol *sym; select_code = code->next; gcc_assert(select_code->op == EXEC_SELECT); - sym = select_code->expr->symtree->n.sym; + sym = select_code->expr1->symtree->n.sym; se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr); if (sym->backend_decl == NULL) sym->backend_decl = gfc_get_symbol_decl (sym); @@ -411,7 +411,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check, subscripts. This could be prevented in the elemental case as temporaries are handled separatedly (below in gfc_conv_elemental_dependencies). */ - gfc_conv_loop_setup (&loop, &code->expr->where); + gfc_conv_loop_setup (&loop, &code->expr1->where); gfc_mark_ss_chain_used (ss, 1); /* Convert the arguments, checking for dependencies. */ @@ -447,7 +447,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check, /* Add the subroutine call to the block. */ gfc_conv_procedure_call (&loopse, code->resolved_sym, - code->ext.actual, code->expr, + code->ext.actual, code->expr1, NULL_TREE); if (mask && count1) @@ -483,7 +483,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check, tree gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED) { - if (code->expr) + if (code->expr1) { gfc_se se; tree tmp; @@ -497,7 +497,7 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED) if (!result) { gfc_warning ("An alternate return at %L without a * dummy argument", - &code->expr->where); + &code->expr1->where); return build1_v (GOTO_EXPR, gfc_get_return_label ()); } @@ -505,7 +505,7 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED) gfc_init_se (&se, NULL); gfc_start_block (&se.pre); - gfc_conv_expr (&se, code->expr); + gfc_conv_expr (&se, code->expr1); tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (result), result, fold_convert (TREE_TYPE (result), se.expr)); @@ -536,14 +536,14 @@ gfc_trans_pause (gfc_code * code) gfc_start_block (&se.pre); - if (code->expr == NULL) + if (code->expr1 == NULL) { tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code); tmp = build_call_expr (gfor_fndecl_pause_numeric, 1, tmp); } else { - gfc_conv_expr_reference (&se, code->expr); + gfc_conv_expr_reference (&se, code->expr1); tmp = build_call_expr (gfor_fndecl_pause_string, 2, se.expr, se.string_length); } @@ -571,14 +571,14 @@ gfc_trans_stop (gfc_code * code) gfc_start_block (&se.pre); - if (code->expr == NULL) + if (code->expr1 == NULL) { tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code); tmp = build_call_expr (gfor_fndecl_stop_numeric, 1, tmp); } else { - gfc_conv_expr_reference (&se, code->expr); + gfc_conv_expr_reference (&se, code->expr1); tmp = build_call_expr (gfor_fndecl_stop_string, 2, se.expr, se.string_length); } @@ -638,7 +638,7 @@ gfc_trans_if_1 (gfc_code * code) tree stmt, elsestmt; /* Check for an unconditional ELSE clause. */ - if (!code->expr) + if (!code->expr1) return gfc_trans_code (code->next); /* Initialize a statement builder for each block. Puts in NULL_TREEs. */ @@ -646,7 +646,7 @@ gfc_trans_if_1 (gfc_code * code) gfc_start_block (&if_se.pre); /* Calculate the IF condition expression. */ - gfc_conv_expr_val (&if_se, code->expr); + gfc_conv_expr_val (&if_se, code->expr1); /* Translate the THEN clause. */ stmt = gfc_trans_code (code->next); @@ -713,7 +713,7 @@ gfc_trans_arithmetic_if (gfc_code * code) gfc_start_block (&se.pre); /* Pre-evaluate COND. */ - gfc_conv_expr_val (&se, code->expr); + gfc_conv_expr_val (&se, code->expr1); se.expr = gfc_evaluate_now (se.expr, &se.pre); /* Build something to compare with. */ @@ -1160,7 +1160,7 @@ gfc_trans_do_while (gfc_code * code) /* Create a GIMPLE version of the exit condition. */ gfc_init_se (&cond, NULL); - gfc_conv_expr_val (&cond, code->expr); + gfc_conv_expr_val (&cond, code->expr1); gfc_add_block_to_block (&block, &cond.pre); cond.expr = fold_build1 (TRUTH_NOT_EXPR, boolean_type_node, cond.expr); @@ -1258,7 +1258,7 @@ gfc_trans_integer_select (gfc_code * code) /* Calculate the switch expression. */ gfc_init_se (&se, NULL); - gfc_conv_expr_val (&se, code->expr); + gfc_conv_expr_val (&se, code->expr1); gfc_add_block_to_block (&block, &se.pre); end_label = gfc_build_label_decl (NULL_TREE); @@ -1399,7 +1399,7 @@ gfc_trans_logical_select (gfc_code * code) /* Calculate the switch expression. We always need to do this because it may have side effects. */ gfc_init_se (&se, NULL); - gfc_conv_expr_val (&se, code->expr); + gfc_conv_expr_val (&se, code->expr1); gfc_add_block_to_block (&block, &se.pre); if (t == f && t != NULL) @@ -1472,11 +1472,11 @@ gfc_trans_character_select (gfc_code *code) static tree ss_string2[2], ss_string2_len[2]; static tree ss_target[2]; - tree pchartype = gfc_get_pchar_type (code->expr->ts.kind); + tree pchartype = gfc_get_pchar_type (code->expr1->ts.kind); - if (code->expr->ts.kind == 1) + if (code->expr1->ts.kind == 1) k = 0; - else if (code->expr->ts.kind == 4) + else if (code->expr1->ts.kind == 4) k = 1; else gcc_unreachable (); @@ -1485,9 +1485,9 @@ gfc_trans_character_select (gfc_code *code) { select_struct[k] = make_node (RECORD_TYPE); - if (code->expr->ts.kind == 1) + if (code->expr1->ts.kind == 1) TYPE_NAME (select_struct[k]) = get_identifier ("_jump_struct_char1"); - else if (code->expr->ts.kind == 4) + else if (code->expr1->ts.kind == 4) TYPE_NAME (select_struct[k]) = get_identifier ("_jump_struct_char4"); else gcc_unreachable (); @@ -1603,13 +1603,13 @@ gfc_trans_character_select (gfc_code *code) init = gfc_build_addr_expr (pvoid_type_node, init); gfc_init_se (&se, NULL); - gfc_conv_expr_reference (&se, code->expr); + gfc_conv_expr_reference (&se, code->expr1); gfc_add_block_to_block (&block, &se.pre); - if (code->expr->ts.kind == 1) + if (code->expr1->ts.kind == 1) fndecl = gfor_fndecl_select_string; - else if (code->expr->ts.kind == 4) + else if (code->expr1->ts.kind == 4) fndecl = gfor_fndecl_select_string_char4; else gcc_unreachable (); @@ -1649,14 +1649,14 @@ gfc_trans_character_select (gfc_code *code) tree gfc_trans_select (gfc_code * code) { - gcc_assert (code && code->expr); + gcc_assert (code && code->expr1); /* Empty SELECT constructs are legal. */ if (code->block == NULL) return build_empty_stmt (); /* Select the correct translation function. */ - switch (code->expr->ts.type) + switch (code->expr1->ts.type) { case BT_LOGICAL: return gfc_trans_logical_select (code); case BT_INTEGER: return gfc_trans_integer_select (code); @@ -1732,7 +1732,7 @@ forall_make_variable_temp (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) tree tmp; /* Build a copy of the lvalue. */ - old_symtree = c->expr->symtree; + old_symtree = c->expr1->symtree; old_sym = old_symtree->n.sym; e = gfc_lval_expr_from_sym (old_sym); if (old_sym->attr.dimension) @@ -1797,7 +1797,7 @@ forall_make_variable_temp (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) /* Go through the expression reference replacing the old_symtree with the new. */ - forall_replace_symtree (c->expr, old_sym, 2); + forall_replace_symtree (c->expr1, old_sym, 2); /* Now we have made this temporary, we might as well use it for the right hand side. */ @@ -1814,8 +1814,8 @@ check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) int need_temp; gfc_symbol *lsym; - lsym = c->expr->symtree->n.sym; - need_temp = gfc_check_dependency (c->expr, c->expr2, 0); + lsym = c->expr1->symtree->n.sym; + need_temp = gfc_check_dependency (c->expr1, c->expr2, 0); /* Now check for dependencies within the 'variable' expression itself. These are treated by making a complete @@ -1829,7 +1829,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) return need_temp; new_symtree = NULL; - if (find_forall_index (c->expr, lsym, 2) == SUCCESS) + if (find_forall_index (c->expr1, lsym, 2) == SUCCESS) { forall_make_variable_temp (c, pre, post); need_temp = 0; @@ -1837,12 +1837,12 @@ check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) /* Substrings with dependencies are treated in the same way. */ - if (c->expr->ts.type == BT_CHARACTER - && c->expr->ref + if (c->expr1->ts.type == BT_CHARACTER + && c->expr1->ref && c->expr2->expr_type == EXPR_VARIABLE && lsym == c->expr2->symtree->n.sym) { - for (lref = c->expr->ref; lref; lref = lref->next) + for (lref = c->expr1->ref; lref; lref = lref->next) if (lref->type == REF_SUBSTRING) break; for (rref = c->expr2->ref; rref; rref = rref->next) @@ -1863,7 +1863,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) static void cleanup_forall_symtrees (gfc_code *c) { - forall_restore_symtree (c->expr); + forall_restore_symtree (c->expr1); forall_restore_symtree (c->expr2); gfc_free (new_symtree->n.sym); gfc_free (new_symtree); @@ -2813,9 +2813,9 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) bool need_mask; /* Do nothing if the mask is false. */ - if (code->expr - && code->expr->expr_type == EXPR_CONSTANT - && !code->expr->value.logical) + if (code->expr1 + && code->expr1->expr_type == EXPR_CONSTANT + && !code->expr1->value.logical) return build_empty_stmt (); n = 0; @@ -2918,11 +2918,11 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) info->nvar = nvar; info->size = size; - if (code->expr) + if (code->expr1) { /* If the mask is .true., consider the FORALL unconditional. */ - if (code->expr->expr_type == EXPR_CONSTANT - && code->expr->value.logical) + if (code->expr1->expr_type == EXPR_CONSTANT + && code->expr1->value.logical) need_mask = false; else need_mask = true; @@ -2968,7 +2968,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) /* Evaluate the mask expression. */ gfc_init_se (&se, NULL); - gfc_conv_expr_val (&se, code->expr); + gfc_conv_expr_val (&se, code->expr1); gfc_add_block_to_block (&body, &se.pre); /* Store the mask. */ @@ -3005,12 +3005,12 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) /* Temporaries due to array assignment data dependencies introduce no end of problems. */ if (need_temp) - gfc_trans_assign_need_temp (c->expr, c->expr2, NULL, false, + gfc_trans_assign_need_temp (c->expr1, c->expr2, NULL, false, nested_forall_info, &block); else { /* Use the normal assignment copying routines. */ - assign = gfc_trans_assignment (c->expr, c->expr2, false); + assign = gfc_trans_assignment (c->expr1, c->expr2, false); /* Generate body and loops. */ tmp = gfc_trans_nested_forall_loop (nested_forall_info, @@ -3032,14 +3032,14 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) /* Pointer assignment inside FORALL. */ case EXEC_POINTER_ASSIGN: - need_temp = gfc_check_dependency (c->expr, c->expr2, 0); + need_temp = gfc_check_dependency (c->expr1, c->expr2, 0); if (need_temp) - gfc_trans_pointer_assign_need_temp (c->expr, c->expr2, + gfc_trans_pointer_assign_need_temp (c->expr1, c->expr2, nested_forall_info, &block); else { /* Use the normal assignment copying routines. */ - assign = gfc_trans_pointer_assignment (c->expr, c->expr2); + assign = gfc_trans_pointer_assignment (c->expr1, c->expr2); /* Generate body and loops. */ tmp = gfc_trans_nested_forall_loop (nested_forall_info, @@ -3519,7 +3519,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert, /* Two clauses, the first empty, the second non-empty. */ else if (mask) { - need_cmask = (cblock->block->expr != 0); + need_cmask = (cblock->block->expr1 != 0); need_pmask = true; } else @@ -3532,7 +3532,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert, { /* Calculate the size of temporary needed by the mask-expr. */ gfc_init_block (&inner_size_body); - inner_size = compute_inner_temp_size (cblock->expr, cblock->expr, + inner_size = compute_inner_temp_size (cblock->expr1, cblock->expr1, &inner_size_body, &lss, &rss); /* Calculate the total size of temporary needed. */ @@ -3564,7 +3564,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert, bottom of the loop. */ /* Has mask-expr. */ - if (cblock->expr) + if (cblock->expr1) { /* Ensure that the WHERE mask will be evaluated exactly once. If there are no statements in this WHERE/ELSEWHERE clause, @@ -3572,13 +3572,13 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert, If this is the last clause of the WHERE construct, then we don't need to update the pending control mask (pmask). */ if (mask) - gfc_evaluate_where_mask (cblock->expr, nested_forall_info, + gfc_evaluate_where_mask (cblock->expr1, nested_forall_info, mask, invert, cblock->next ? cmask : NULL_TREE, cblock->block ? pmask : NULL_TREE, mask_type, block); else - gfc_evaluate_where_mask (cblock->expr, nested_forall_info, + gfc_evaluate_where_mask (cblock->expr1, nested_forall_info, NULL_TREE, false, (cblock->next || cblock->block) ? cmask : NULL_TREE, @@ -3617,7 +3617,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert, goto evaluate; case EXEC_ASSIGN: - expr1 = cnext->expr; + expr1 = cnext->expr1; expr2 = cnext->expr2; evaluate: if (nested_forall_info != NULL) @@ -3729,10 +3729,10 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock) if (ompws_flags & OMPWS_WORKSHARE_FLAG) ompws_flags |= OMPWS_SCALARIZER_WS; - cond = cblock->expr; - tdst = cblock->next->expr; + cond = cblock->expr1; + tdst = cblock->next->expr1; tsrc = cblock->next->expr2; - edst = eblock ? eblock->next->expr : NULL; + edst = eblock ? eblock->next->expr1 : NULL; esrc = eblock ? eblock->next->expr2 : NULL; gfc_start_block (&block); @@ -3868,13 +3868,13 @@ gfc_trans_where (gfc_code * code) /* A simple "WHERE (cond) x = y" statement or block is dependence free if cond is not dependent upon writing x, and the source y is unaffected by the destination x. */ - if (!gfc_check_dependency (cblock->next->expr, - cblock->expr, 0) - && !gfc_check_dependency (cblock->next->expr, + if (!gfc_check_dependency (cblock->next->expr1, + cblock->expr1, 0) + && !gfc_check_dependency (cblock->next->expr1, cblock->next->expr2, 0)) return gfc_trans_where_3 (cblock, NULL); } - else if (!eblock->expr + else if (!eblock->expr1 && !eblock->block && eblock->next && eblock->next->op == EXEC_ASSIGN @@ -3890,22 +3890,22 @@ gfc_trans_where (gfc_code * code) are the same. In short, this is VERY conservative and this is needed because the two loops, required by the standard are coalesced in gfc_trans_where_3. */ - if (!gfc_check_dependency(cblock->next->expr, - cblock->expr, 0) - && !gfc_check_dependency(eblock->next->expr, - cblock->expr, 0) - && !gfc_check_dependency(cblock->next->expr, + if (!gfc_check_dependency(cblock->next->expr1, + cblock->expr1, 0) + && !gfc_check_dependency(eblock->next->expr1, + cblock->expr1, 0) + && !gfc_check_dependency(cblock->next->expr1, eblock->next->expr2, 1) - && !gfc_check_dependency(eblock->next->expr, + && !gfc_check_dependency(eblock->next->expr1, cblock->next->expr2, 1) - && !gfc_check_dependency(cblock->next->expr, + && !gfc_check_dependency(cblock->next->expr1, cblock->next->expr2, 1) - && !gfc_check_dependency(eblock->next->expr, + && !gfc_check_dependency(eblock->next->expr1, eblock->next->expr2, 1) - && !gfc_check_dependency(cblock->next->expr, - eblock->next->expr, 0) - && !gfc_check_dependency(eblock->next->expr, - cblock->next->expr, 0)) + && !gfc_check_dependency(cblock->next->expr1, + eblock->next->expr1, 0) + && !gfc_check_dependency(eblock->next->expr1, + cblock->next->expr1, 0)) return gfc_trans_where_3 (cblock, eblock); } } @@ -3971,7 +3971,7 @@ gfc_trans_allocate (gfc_code * code) gfc_start_block (&block); /* Either STAT= and/or ERRMSG is present. */ - if (code->expr || code->expr2) + if (code->expr1 || code->expr2) { tree gfc_int4_type_node = gfc_get_int_type (4); @@ -4006,7 +4006,7 @@ gfc_trans_allocate (gfc_code * code) fold_convert (TREE_TYPE (se.expr), tmp)); gfc_add_expr_to_block (&se.pre, tmp); - if (code->expr || code->expr2) + if (code->expr1 || code->expr2) { tmp = build1_v (GOTO_EXPR, error_label); parm = fold_build2 (NE_EXPR, boolean_type_node, @@ -4030,13 +4030,13 @@ gfc_trans_allocate (gfc_code * code) } /* STAT block. */ - if (code->expr) + if (code->expr1) { tmp = build1_v (LABEL_EXPR, error_label); gfc_add_expr_to_block (&block, tmp); gfc_init_se (&se, NULL); - gfc_conv_expr_lhs (&se, code->expr); + gfc_conv_expr_lhs (&se, code->expr1); tmp = convert (TREE_TYPE (se.expr), stat); gfc_add_modify (&block, se.expr, tmp); } @@ -4094,7 +4094,7 @@ gfc_trans_deallocate (gfc_code *code) /* Count the number of failed deallocations. If deallocate() was called with STAT= , then set STAT to the count. If deallocate was called with ERRMSG, then set ERRMG to a string. */ - if (code->expr || code->expr2) + if (code->expr1 || code->expr2) { tree gfc_int4_type_node = gfc_get_int_type (4); @@ -4155,7 +4155,7 @@ gfc_trans_deallocate (gfc_code *code) /* Keep track of the number of failed deallocations by adding stat of the last deallocation to the running total. */ - if (code->expr || code->expr2) + if (code->expr1 || code->expr2) { apstat = fold_build2 (PLUS_EXPR, TREE_TYPE (stat), astat, stat); gfc_add_modify (&se.pre, astat, apstat); @@ -4167,10 +4167,10 @@ gfc_trans_deallocate (gfc_code *code) } /* Set STAT. */ - if (code->expr) + if (code->expr1) { gfc_init_se (&se, NULL); - gfc_conv_expr_lhs (&se, code->expr); + gfc_conv_expr_lhs (&se, code->expr1); tmp = convert (TREE_TYPE (se.expr), astat); gfc_add_modify (&block, se.expr, tmp); }