Skip to content

R
riscv-gcc-1
Commit a513927a by Steven G. Kargl
Options

gfortran.h (gfc_code): Rename struct member expr to expr1. 

2009-05-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	* 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.

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