This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Fortran] Cleanup patch.
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Wed, 6 May 2009 23:16:41 -0700
- Subject: [Fortran] Cleanup patch.
The attached patch was regression tested on i686-*-freebsd.
It renames the expr and label members of the gfc_code structure
to expr1 and label1, which are then consistent with expr2, label2,
label3, and the soon to be added expr3.
Note, there is one functional change in dump-parse-tree.c.
2009-05-06 Steven G. Kargl <kargl@gcc.gnu.org>
* gfortran.h (gfc_code): Rename member expr to expr1 and
member label to label1.
* trans-stmt.c (gfc_trans_label_assign, gfc_trans_goto, gfc_trans_call,
gfc_trans_return, gfc_trans_stop, gfc_trans_if_1, gfc_trans_do_while,
gfc_trans_arithmetic_if, gfc_trans_integer_select, gfc_trans_forall_1,
gfc_trans_logical_select, gfc_trans_character_select, gfc_trans_where,
forall_make_variable_temp, check_forall_dependencies,
gfc_trans_where_2, gfc_trans_where_3, gfc_trans_allocate,
gfc_trans_deallocate): Change expr to expr1 and label to label1.
* trans-openmp.c (gfc_trans_omp_atomic): Ditto.
* st.c (gfc_free_statement): Ditto.
* trans-io.c (gfc_trans_transfer): 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,
gfc_match_allocate, gfc_match_deallocate, match_typebound_call,
gfc_match_call, gfc_match_select, match_simple_where, gfc_match_where,
gfc_match_elsewhere, match_simple_forall): Ditto.
* parse.c (parse_where_block, parse_if_block, parse_do_block): Ditto.
* io.c (match_io_element): Ditto.
* resolve.c (resolve_typebound_call, resolve_select, resolve_transfer,
resolve_allocate_expr, resolve_allocate_deallocate, resolve_where,
gfc_resolve_assign_in_forall, gfc_resolve_blocks,
resolve_ordinary_assign, resolve_code, build_init_assign): Ditto.
* openmp.c (resolve_omp_atomic): Ditto.
* interface.c (gfc_extend_assign): Ditto.
* trans-expr.c (gfc_trans_pointer_assign, gfc_trans_init_assign,
gfc_trans_assign): Ditto.
* dump-parse-tree.c (show_code_node): Ditto. Add dumping of
ERRMSG in ALLOCATE and DEALLOCATE.
OK for trunk?
--
Steve
Index: openmp.c
===================================================================
--- openmp.c (revision 147131)
+++ openmp.c (working copy)
@@ -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;
Index: interface.c
===================================================================
--- interface.c (revision 147131)
+++ interface.c (working copy)
@@ -2590,7 +2590,7 @@ gfc_extend_assign (gfc_code *c, gfc_name
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. */
@@ -2625,7 +2625,7 @@ gfc_extend_assign (gfc_code *c, gfc_name
/* 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;
Index: trans-expr.c
===================================================================
--- trans-expr.c (revision 147131)
+++ trans-expr.c (working copy)
@@ -4028,7 +4028,7 @@ gfc_conv_expr_reference (gfc_se * se, gf
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);
}
@@ -4853,11 +4853,11 @@ gfc_trans_assignment (gfc_expr * expr1,
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);
}
Index: dump-parse-tree.c
===================================================================
--- dump-parse-tree.c (revision 147131)
+++ dump-parse-tree.c (working copy)
@@ -1154,38 +1154,38 @@ 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);
- fprintf (dumpfile, " %d", c->label->value);
+ 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;
case EXEC_GOTO:
fputs ("GOTO ", dumpfile);
- if (c->label)
- fprintf (dumpfile, "%d", c->label->value);
+ if (c->label1)
+ fprintf (dumpfile, "%d", c->label1->value);
else
{
- show_expr (c->expr);
+ show_expr (c->expr1);
d = c->block;
if (d != NULL)
{
fputs (", (", dumpfile);
for (; d; d = d ->block)
{
- code_indent (level, d->label);
+ code_indent (level, d->label1);
if (d->block != NULL)
fputc (',', dumpfile);
else
@@ -1209,20 +1209,20 @@ 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_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);
@@ -1231,8 +1231,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);
@@ -1240,15 +1240,15 @@ 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->label->value, c->label2->value, c->label3->value);
+ c->label1->value, c->label2->value, c->label3->value);
break;
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);
@@ -1257,19 +1257,19 @@ 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);
}
show_code (level + 1, d->next);
}
- code_indent (level, c->label);
+ code_indent (level, c->label1);
fputs ("ENDIF", dumpfile);
break;
@@ -1277,7 +1277,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)
@@ -1299,7 +1299,7 @@ show_code_node (int level, gfc_code *c)
show_code (level + 1, d->next);
}
- code_indent (level, c->label);
+ code_indent (level, c->label1);
fputs ("END SELECT", dumpfile);
break;
@@ -1307,7 +1307,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);
@@ -1316,7 +1316,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);
}
@@ -1342,10 +1342,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);
@@ -1375,12 +1375,12 @@ 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);
- code_indent (level, c->label);
+ code_indent (level, c->label1);
fputs ("END DO", dumpfile);
break;
@@ -1398,10 +1398,16 @@ 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);
+ }
+
+ if (c->expr2)
+ {
+ fputs (" ERRMSG=", dumpfile);
+ show_expr (c->expr2);
}
for (a = c->ext.alloc_list; a; a = a->next)
@@ -1414,10 +1420,16 @@ 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);
+ }
+
+ if (c->expr2)
+ {
+ fputs (" ERRMSG=", dumpfile);
+ show_expr (c->expr2);
}
for (a = c->ext.alloc_list; a; a = a->next)
@@ -1780,7 +1792,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;
@@ -1889,7 +1901,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:
Index: trans-openmp.c
===================================================================
--- trans-openmp.c (revision 147131)
+++ trans-openmp.c (working copy)
@@ -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);
Index: gfortran.h
===================================================================
--- gfortran.h (revision 147131)
+++ gfortran.h (working copy)
@@ -1904,9 +1904,9 @@ typedef struct gfc_code
struct gfc_code *block, *next;
locus loc;
- gfc_st_label *here, *label, *label2, *label3;
+ 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; */
Index: trans-stmt.c
===================================================================
--- trans-stmt.c (revision 147131)
+++ trans-stmt.c (working copy)
@@ -104,21 +104,21 @@ 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);
- label_tree = gfc_get_label_decl (code->label);
+ label_tree = gfc_get_label_decl (code->label1);
- if (code->label->defined == ST_LABEL_TARGET)
+ if (code->label1->defined == ST_LABEL_TARGET)
{
label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
len_tree = integer_minus_one_node;
}
else
{
- gfc_expr *format = code->label->format;
+ gfc_expr *format = code->label1->format;
label_len = format->value.character.length;
len_tree = build_int_cst (NULL_TREE, label_len);
@@ -144,13 +144,13 @@ gfc_trans_goto (gfc_code * code)
tree tmp;
gfc_se se;
- if (code->label != NULL)
- return build1_v (GOTO_EXPR, gfc_get_label_decl (code->label));
+ if (code->label1 != NULL)
+ return build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1));
/* 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));
@@ -170,7 +170,7 @@ gfc_trans_goto (gfc_code * code)
/* Check the label list. */
do
{
- target = gfc_get_label_decl (code->label);
+ target = gfc_get_label_decl (code->label1);
tmp = gfc_build_addr_expr (pvoid_type_node, target);
tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, assigned_goto);
tmp = build3_v (COND_EXPR, tmp,
@@ -369,7 +369,7 @@ gfc_trans_call (gfc_code * code, bool de
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);
@@ -405,7 +405,7 @@ gfc_trans_call (gfc_code * code, bool de
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. */
@@ -455,7 +455,7 @@ gfc_trans_call (gfc_code * code, bool de
tree
gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
{
- if (code->expr)
+ if (code->expr1)
{
gfc_se se;
tree tmp;
@@ -469,7 +469,7 @@ gfc_trans_return (gfc_code * code ATTRIB
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 ());
}
@@ -477,7 +477,7 @@ gfc_trans_return (gfc_code * code ATTRIB
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));
@@ -508,14 +508,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);
}
@@ -543,14 +543,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);
}
@@ -610,7 +610,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. */
@@ -618,7 +618,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);
@@ -685,20 +685,20 @@ 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. */
zero = gfc_build_const (TREE_TYPE (se.expr), integer_zero_node);
- if (code->label->value != code->label2->value)
+ if (code->label1->value != code->label2->value)
{
/* If (cond < 0) take branch1 else take branch2.
First build jumps to the COND .LT. 0 and the COND .EQ. 0 cases. */
- branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label));
+ branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1));
branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label2));
- if (code->label->value != code->label3->value)
+ if (code->label1->value != code->label3->value)
tmp = fold_build2 (LT_EXPR, boolean_type_node, se.expr, zero);
else
tmp = fold_build2 (NE_EXPR, boolean_type_node, se.expr, zero);
@@ -706,9 +706,9 @@ gfc_trans_arithmetic_if (gfc_code * code
branch1 = fold_build3 (COND_EXPR, void_type_node, tmp, branch1, branch2);
}
else
- branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label));
+ branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1));
- if (code->label->value != code->label3->value
+ if (code->label1->value != code->label3->value
&& code->label2->value != code->label3->value)
{
/* if (cond <= 0) take branch1 else take branch2. */
@@ -1132,7 +1132,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);
@@ -1230,7 +1230,7 @@ gfc_trans_integer_select (gfc_code * cod
/* 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);
@@ -1371,7 +1371,7 @@ gfc_trans_logical_select (gfc_code * cod
/* 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)
@@ -1444,11 +1444,11 @@ gfc_trans_character_select (gfc_code *co
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 ();
@@ -1457,9 +1457,9 @@ gfc_trans_character_select (gfc_code *co
{
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 ();
@@ -1575,13 +1575,13 @@ gfc_trans_character_select (gfc_code *co
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 ();
@@ -1621,14 +1621,14 @@ gfc_trans_character_select (gfc_code *co
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);
@@ -1704,7 +1704,7 @@ forall_make_variable_temp (gfc_code *c,
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)
@@ -1769,7 +1769,7 @@ forall_make_variable_temp (gfc_code *c,
/* 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. */
@@ -1786,8 +1786,8 @@ check_forall_dependencies (gfc_code *c,
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
@@ -1801,7 +1801,7 @@ check_forall_dependencies (gfc_code *c,
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;
@@ -1809,12 +1809,12 @@ check_forall_dependencies (gfc_code *c,
/* 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)
@@ -1835,7 +1835,7 @@ check_forall_dependencies (gfc_code *c,
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);
@@ -2785,9 +2785,9 @@ gfc_trans_forall_1 (gfc_code * code, for
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;
@@ -2890,11 +2890,11 @@ gfc_trans_forall_1 (gfc_code * code, for
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;
@@ -2940,7 +2940,7 @@ gfc_trans_forall_1 (gfc_code * code, for
/* 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. */
@@ -2977,12 +2977,12 @@ gfc_trans_forall_1 (gfc_code * code, for
/* 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,
@@ -3004,14 +3004,14 @@ gfc_trans_forall_1 (gfc_code * code, for
/* 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,
@@ -3490,7 +3490,7 @@ gfc_trans_where_2 (gfc_code * code, tree
/* 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
@@ -3503,7 +3503,7 @@ gfc_trans_where_2 (gfc_code * code, tree
{
/* 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. */
@@ -3535,7 +3535,7 @@ gfc_trans_where_2 (gfc_code * code, tree
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,
@@ -3543,13 +3543,13 @@ gfc_trans_where_2 (gfc_code * code, tree
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,
@@ -3588,7 +3588,7 @@ gfc_trans_where_2 (gfc_code * code, tree
goto evaluate;
case EXEC_ASSIGN:
- expr1 = cnext->expr;
+ expr1 = cnext->expr1;
expr2 = cnext->expr2;
evaluate:
if (nested_forall_info != NULL)
@@ -3700,10 +3700,10 @@ gfc_trans_where_3 (gfc_code * cblock, gf
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);
@@ -3839,13 +3839,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
@@ -3861,22 +3861,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);
}
}
@@ -3942,7 +3942,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);
@@ -3977,7 +3977,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,
@@ -4001,13 +4001,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);
}
@@ -4065,7 +4065,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);
@@ -4126,7 +4126,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);
@@ -4138,10 +4138,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);
}
Index: io.c
===================================================================
--- io.c (revision 147131)
+++ io.c (working copy)
@@ -2830,7 +2830,7 @@ match_io_element (io_kind k, gfc_code **
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))
Index: resolve.c
===================================================================
--- resolve.c (revision 147131)
+++ resolve.c (working copy)
@@ -4723,37 +4723,37 @@ success:
/* Resolve a call to a type-bound subroutine. */
static gfc_try
-resolve_typebound_call (gfc_code* c)
+resolve_typebound_call (gfc_code *c)
{
gfc_actual_arglist* newactual;
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);
}
@@ -5344,7 +5344,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_
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;
@@ -5424,7 +5424,7 @@ resolve_allocate_deallocate (gfc_code *c
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;
@@ -5775,7 +5775,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;
@@ -5788,12 +5788,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)
@@ -6046,7 +6046,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;
@@ -6055,7 +6055,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;
@@ -6251,19 +6251,19 @@ resolve_where (gfc_code *code, gfc_expr
/* 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
@@ -6277,9 +6277,9 @@ resolve_where (gfc_code *code, gfc_expr
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;
@@ -6325,21 +6325,21 @@ gfc_resolve_assign_in_forall (gfc_code *
/* 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);
}
}
}
@@ -6555,29 +6555,29 @@ gfc_resolve_blocks (gfc_code *b, gfc_nam
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:
- resolve_branch (b->label, b);
+ resolve_branch (b->label1, b);
break;
case EXEC_SELECT:
@@ -6651,7 +6651,7 @@ resolve_ordinary_assign (gfc_code *code,
return true;
}
- lhs = code->expr;
+ lhs = code->expr1;
rhs = code->expr2;
if (rhs->is_boz
@@ -6820,7 +6820,7 @@ resolve_code (gfc_code *code, gfc_namesp
t = SUCCESS;
if (code->op != EXEC_COMPCALL)
- t = gfc_resolve_expr (code->expr);
+ t = gfc_resolve_expr (code->expr1);
forall_flag = forall_save;
if (gfc_resolve_expr (code->expr2) == FAILURE)
@@ -6848,25 +6848,25 @@ resolve_code (gfc_code *code, gfc_namesp
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->label, code);
+ 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:
@@ -6882,44 +6882,44 @@ resolve_code (gfc_code *code, gfc_namesp
break;
case EXEC_LABEL_ASSIGN:
- if (code->label->defined == ST_LABEL_UNKNOWN)
+ if (code->label1->defined == ST_LABEL_UNKNOWN)
gfc_error ("Label %d referenced at %L is never defined",
- code->label->value, &code->label->where);
+ 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->label, code);
+ resolve_branch (code->label1, code);
resolve_branch (code->label2, code);
resolve_branch (code->label3, code);
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:
@@ -6947,13 +6947,13 @@ resolve_code (gfc_code *code, gfc_namesp
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:
@@ -7033,9 +7033,9 @@ resolve_code (gfc_code *code, gfc_namesp
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:
@@ -7406,7 +7406,7 @@ build_init_assign (gfc_symbol *sym, gfc_
/* 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;
}
Index: st.c
===================================================================
--- st.c (revision 147131)
+++ st.c (working copy)
@@ -80,8 +80,8 @@ gfc_append_code (gfc_code *tail, gfc_cod
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);
Index: trans-io.c
===================================================================
--- trans-io.c (revision 147131)
+++ trans-io.c (working copy)
@@ -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);
Index: match.c
===================================================================
--- match.c (revision 147131)
+++ match.c (working copy)
@@ -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);
@@ -1345,7 +1345,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;
@@ -1387,8 +1387,8 @@ match_arithmetic_if (void)
return MATCH_ERROR;
new_st.op = EXEC_ARITHMETIC_IF;
- new_st.expr = expr;
- new_st.label = l1;
+ new_st.expr1 = expr;
+ new_st.label1 = l1;
new_st.label2 = l2;
new_st.label3 = l3;
@@ -1468,8 +1468,8 @@ gfc_match_if (gfc_statement *if_type)
return MATCH_ERROR;
new_st.op = EXEC_ARITHMETIC_IF;
- new_st.expr = expr;
- new_st.label = l1;
+ new_st.expr1 = expr;
+ new_st.label1 = l1;
new_st.label2 = l2;
new_st.label3 = l3;
@@ -1480,7 +1480,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;
}
@@ -1600,7 +1600,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 ();
@@ -1676,7 +1676,7 @@ gfc_match_elseif (void)
done:
new_st.op = EXEC_IF;
- new_st.expr = expr;
+ new_st.expr1 = expr;
return MATCH_YES;
cleanup:
@@ -1788,10 +1788,10 @@ done:
&& gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
goto cleanup;
- new_st.label = label;
+ 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 ();
@@ -1951,7 +1951,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;
@@ -2032,8 +2032,8 @@ gfc_match_assign (void)
expr->symtree->n.sym->attr.assign = 1;
new_st.op = EXEC_LABEL_ASSIGN;
- new_st.label = label;
- new_st.expr = expr;
+ new_st.label1 = label;
+ new_st.expr1 = expr;
return MATCH_YES;
}
}
@@ -2062,7 +2062,7 @@ gfc_match_goto (void)
return MATCH_ERROR;
new_st.op = EXEC_GOTO;
- new_st.label = label;
+ new_st.label1 = label;
return MATCH_YES;
}
@@ -2076,7 +2076,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;
@@ -2107,7 +2107,7 @@ gfc_match_goto (void)
tail = tail->block;
}
- tail->label = label;
+ tail->label1 = label;
tail->op = EXEC_GOTO;
}
while (gfc_match_char (',') == MATCH_YES);
@@ -2160,7 +2160,7 @@ gfc_match_goto (void)
tail->next = gfc_get_code ();
tail->next->op = EXEC_GOTO;
- tail->next->label = label;
+ tail->next->label1 = label;
}
while (gfc_match_char (',') == MATCH_YES);
@@ -2183,7 +2183,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
@@ -2336,7 +2336,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;
@@ -2401,7 +2401,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)
@@ -2537,7 +2537,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;
@@ -2605,7 +2605,7 @@ done:
return MATCH_ERROR;
new_st.op = EXEC_RETURN;
- new_st.expr = e;
+ new_st.expr1 = e;
return MATCH_YES;
}
@@ -2648,7 +2648,7 @@ match_typebound_call (gfc_symtree* varst
}
new_st.op = EXEC_COMPCALL;
- new_st.expr = base;
+ new_st.expr1 = base;
return MATCH_YES;
}
@@ -2751,11 +2751,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)
@@ -2778,7 +2778,7 @@ gfc_match_call (void)
c->next = gfc_get_code ();
c->next->op = EXEC_GOTO;
- c->next->label = a->label;
+ c->next->label1 = a->label;
}
}
@@ -3651,7 +3651,7 @@ gfc_match_select (void)
return m;
new_st.op = EXEC_SELECT;
- new_st.expr = expr;
+ new_st.expr1 = expr;
return MATCH_YES;
}
@@ -3756,7 +3756,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;
@@ -3797,7 +3797,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;
}
@@ -3816,7 +3816,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;
@@ -3886,7 +3886,7 @@ gfc_match_elsewhere (void)
}
new_st.op = EXEC_WHERE;
- new_st.expr = expr;
+ new_st.expr1 = expr;
return MATCH_YES;
syntax:
@@ -4103,7 +4103,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 ();
@@ -4155,7 +4155,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;
}
@@ -4178,7 +4178,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;
Index: parse.c
===================================================================
--- parse.c (revision 147131)
+++ parse.c (working copy)
@@ -2494,10 +2494,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;
@@ -2527,12 +2527,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);
@@ -2637,8 +2637,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
@@ -2662,7 +2662,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);
@@ -2853,7 +2853,7 @@ parse_do_block (void)
gfc_state_data s;
gfc_symtree *stree;
- s.ext.end_do_label = new_st.label;
+ s.ext.end_do_label = new_st.label1;
if (new_st.ext.iterator != NULL)
stree = new_st.ext.iterator->var->symtree;