Commit 11e5274a by Janus Weil

gfortran.h (gfc_get_code): Modified prototype.

2013-08-09  Janus Weil  <janus@gcc.gnu.org>

	* gfortran.h (gfc_get_code): Modified prototype.
	* class.c (finalize_component, finalization_scalarizer,
	finalization_get_offset, finalizer_insert_packed_call,
	generate_finalization_wrapper, gfc_find_derived_vtab,
	gfc_find_intrinsic_vtab): Use 'gfc_get_code'.
	* io.c (match_io_iterator, match_io_element, terminate_io, get_io_list,
	gfc_match_inquire): Call 'gfc_get_code' with argument.
	* match.c (match_simple_forall, gfc_match_forall, gfc_match_goto,
	gfc_match_nullify, gfc_match_call, match_simple_where, gfc_match_where):
	Ditto.
	* parse.c (new_level): Ditto.
	(add_statement): Use XCNEW.
	* resolve.c (resolve_entries, resolve_allocate_expr,
	resolve_select_type, build_assignment, build_init_assign): Call
	'gfc_get_code' with argument.
	* st.c (gfc_get_code): Add argument 'op'.
	* trans-expr.c (gfc_trans_class_array_init_assign): Call 'gfc_get_code'
	with argument.
	* trans-stmt.c (gfc_trans_allocate): Ditto.

From-SVN: r201635
parent 2fa3d31b
2013-08-09 Janus Weil <janus@gcc.gnu.org> 2013-08-09 Janus Weil <janus@gcc.gnu.org>
* gfortran.h (gfc_get_code): Modified prototype.
* class.c (finalize_component, finalization_scalarizer,
finalization_get_offset, finalizer_insert_packed_call,
generate_finalization_wrapper, gfc_find_derived_vtab,
gfc_find_intrinsic_vtab): Use 'gfc_get_code'.
* io.c (match_io_iterator, match_io_element, terminate_io, get_io_list,
gfc_match_inquire): Call 'gfc_get_code' with argument.
* match.c (match_simple_forall, gfc_match_forall, gfc_match_goto,
gfc_match_nullify, gfc_match_call, match_simple_where, gfc_match_where):
Ditto.
* parse.c (new_level): Ditto.
(add_statement): Use XCNEW.
* resolve.c (resolve_entries, resolve_allocate_expr,
resolve_select_type, build_assignment, build_init_assign): Call
'gfc_get_code' with argument.
* st.c (gfc_get_code): Add argument 'op'.
* trans-expr.c (gfc_trans_class_array_init_assign): Call 'gfc_get_code'
with argument.
* trans-stmt.c (gfc_trans_allocate): Ditto.
2013-08-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/58058 PR fortran/58058
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Free the temporary * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Free the temporary
string, if necessary. string, if necessary.
......
...@@ -863,7 +863,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, ...@@ -863,7 +863,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
|| (comp->ts.type == BT_CLASS && CLASS_DATA (comp) || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
&& CLASS_DATA (comp)->attr.allocatable)) && CLASS_DATA (comp)->attr.allocatable))
{ {
block = XCNEW (gfc_code); block = gfc_get_code (EXEC_IF);
if (*code) if (*code)
{ {
(*code)->next = block; (*code)->next = block;
...@@ -872,19 +872,12 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, ...@@ -872,19 +872,12 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
else else
(*code) = block; (*code) = block;
block->loc = gfc_current_locus; block->block = gfc_get_code (EXEC_IF);
block->op = EXEC_IF;
block->block = XCNEW (gfc_code);
block = block->block; block = block->block;
block->loc = gfc_current_locus;
block->op = EXEC_IF;
block->expr1 = gfc_lval_expr_from_sym (fini_coarray); block->expr1 = gfc_lval_expr_from_sym (fini_coarray);
} }
dealloc = XCNEW (gfc_code); dealloc = gfc_get_code (EXEC_DEALLOCATE);
dealloc->op = EXEC_DEALLOCATE;
dealloc->loc = gfc_current_locus;
dealloc->ext.alloc.list = gfc_get_alloc (); dealloc->ext.alloc.list = gfc_get_alloc ();
dealloc->ext.alloc.list->expr = e; dealloc->ext.alloc.list->expr = e;
...@@ -915,10 +908,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, ...@@ -915,10 +908,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
break; break;
gcc_assert (c); gcc_assert (c);
final_wrap = XCNEW (gfc_code); final_wrap = gfc_get_code (EXEC_CALL);
final_wrap->op = EXEC_CALL;
final_wrap->loc = gfc_current_locus;
final_wrap->loc = gfc_current_locus;
final_wrap->symtree = c->initializer->symtree; final_wrap->symtree = c->initializer->symtree;
final_wrap->resolved_sym = c->initializer->symtree->n.sym; final_wrap->resolved_sym = c->initializer->symtree->n.sym;
final_wrap->ext.actual = gfc_get_actual_arglist (); final_wrap->ext.actual = gfc_get_actual_arglist ();
...@@ -955,9 +945,7 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, ...@@ -955,9 +945,7 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr,
gfc_expr *expr, *expr2; gfc_expr *expr, *expr2;
/* C_F_POINTER(). */ /* C_F_POINTER(). */
block = XCNEW (gfc_code); block = gfc_get_code (EXEC_CALL);
block->op = EXEC_CALL;
block->loc = gfc_current_locus;
gfc_get_sym_tree ("c_f_pointer", sub_ns, &block->symtree, true); gfc_get_sym_tree ("c_f_pointer", sub_ns, &block->symtree, true);
block->resolved_sym = block->symtree->n.sym; block->resolved_sym = block->symtree->n.sym;
block->resolved_sym->attr.flavor = FL_PROCEDURE; block->resolved_sym->attr.flavor = FL_PROCEDURE;
...@@ -1037,10 +1025,8 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, ...@@ -1037,10 +1025,8 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset,
gfc_expr *expr, *expr2; gfc_expr *expr, *expr2;
/* offset = 0. */ /* offset = 0. */
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_ASSIGN);
block = block->next; block = block->next;
block->op = EXEC_ASSIGN;
block->loc = gfc_current_locus;
block->expr1 = gfc_lval_expr_from_sym (offset); block->expr1 = gfc_lval_expr_from_sym (offset);
block->expr2 = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0); block->expr2 = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
...@@ -1050,13 +1036,10 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, ...@@ -1050,13 +1036,10 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset,
iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
iter->end = gfc_copy_expr (rank); iter->end = gfc_copy_expr (rank);
iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_DO);
block = block->next; block = block->next;
block->op = EXEC_DO;
block->loc = gfc_current_locus;
block->ext.iterator = iter; block->ext.iterator = iter;
block->block = gfc_get_code (); block->block = gfc_get_code (EXEC_DO);
block->block->op = EXEC_DO;
/* Loop body: offset = offset + mod (idx, sizes(idx2)) / sizes(idx2-1) /* Loop body: offset = offset + mod (idx, sizes(idx2)) / sizes(idx2-1)
* strides(idx2). */ * strides(idx2). */
...@@ -1115,9 +1098,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, ...@@ -1115,9 +1098,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset,
expr->ts = idx->ts; expr->ts = idx->ts;
/* offset = offset + ... */ /* offset = offset + ... */
block->block->next = XCNEW (gfc_code); block->block->next = gfc_get_code (EXEC_ASSIGN);
block->block->next->op = EXEC_ASSIGN;
block->block->next->loc = gfc_current_locus;
block->block->next->expr1 = gfc_lval_expr_from_sym (offset); block->block->next->expr1 = gfc_lval_expr_from_sym (offset);
block->block->next->expr2 = gfc_get_expr (); block->block->next->expr2 = gfc_get_expr ();
block->block->next->expr2->expr_type = EXPR_OP; block->block->next->expr2->expr_type = EXPR_OP;
...@@ -1127,10 +1108,8 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, ...@@ -1127,10 +1108,8 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset,
block->block->next->expr2->ts = idx->ts; block->block->next->expr2->ts = idx->ts;
/* After the loop: offset = offset * byte_stride. */ /* After the loop: offset = offset * byte_stride. */
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_ASSIGN);
block = block->next; block = block->next;
block->op = EXEC_ASSIGN;
block->loc = gfc_current_locus;
block->expr1 = gfc_lval_expr_from_sym (offset); block->expr1 = gfc_lval_expr_from_sym (offset);
block->expr2 = gfc_get_expr (); block->expr2 = gfc_get_expr ();
block->expr2->expr_type = EXPR_OP; block->expr2->expr_type = EXPR_OP;
...@@ -1189,15 +1168,11 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, ...@@ -1189,15 +1168,11 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
gfc_code *block2; gfc_code *block2;
int i; int i;
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_IF);
block = block->next; block = block->next;
block->loc = gfc_current_locus;
block->op = EXEC_IF;
block->block = XCNEW (gfc_code); block->block = gfc_get_code (EXEC_IF);
block = block->block; block = block->block;
block->loc = gfc_current_locus;
block->op = EXEC_IF;
/* size_expr = STORAGE_SIZE (...) / NUMERIC_STORAGE_SIZE. */ /* size_expr = STORAGE_SIZE (...) / NUMERIC_STORAGE_SIZE. */
size_expr = gfc_get_expr (); size_expr = gfc_get_expr ();
...@@ -1274,9 +1249,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, ...@@ -1274,9 +1249,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
block->expr1->value.op.op2->value.op.op2 = gfc_copy_expr (size_expr); block->expr1->value.op.op2->value.op.op2 = gfc_copy_expr (size_expr);
/* IF body: call final subroutine. */ /* IF body: call final subroutine. */
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_CALL);
block->next->op = EXEC_CALL;
block->next->loc = gfc_current_locus;
block->next->symtree = fini->proc_tree; block->next->symtree = fini->proc_tree;
block->next->resolved_sym = fini->proc_tree->n.sym; block->next->resolved_sym = fini->proc_tree->n.sym;
block->next->ext.actual = gfc_get_actual_arglist (); block->next->ext.actual = gfc_get_actual_arglist ();
...@@ -1284,17 +1257,13 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, ...@@ -1284,17 +1257,13 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
/* ELSE. */ /* ELSE. */
block->block = XCNEW (gfc_code); block->block = gfc_get_code (EXEC_IF);
block = block->block; block = block->block;
block->loc = gfc_current_locus;
block->op = EXEC_IF;
block->next = XCNEW (gfc_code); /* BLOCK ... END BLOCK. */
block->next = gfc_get_code (EXEC_BLOCK);
block = block->next; block = block->next;
/* BLOCK ... END BLOCK. */
block->op = EXEC_BLOCK;
block->loc = gfc_current_locus;
ns = gfc_build_block_ns (sub_ns); ns = gfc_build_block_ns (sub_ns);
block->ext.block.ns = ns; block->ext.block.ns = ns;
block->ext.block.assoc = NULL; block->ext.block.assoc = NULL;
...@@ -1347,13 +1316,10 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, ...@@ -1347,13 +1316,10 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
iter->end = gfc_lval_expr_from_sym (nelem); iter->end = gfc_lval_expr_from_sym (nelem);
iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
block = XCNEW (gfc_code); block = gfc_get_code (EXEC_DO);
ns->code = block; ns->code = block;
block->op = EXEC_DO;
block->loc = gfc_current_locus;
block->ext.iterator = iter; block->ext.iterator = iter;
block->block = gfc_get_code (); block->block = gfc_get_code (EXEC_DO);
block->block->op = EXEC_DO;
/* Offset calculation for the new array: idx * size of type (in bytes). */ /* Offset calculation for the new array: idx * size of type (in bytes). */
offset2 = gfc_get_expr (); offset2 = gfc_get_expr ();
...@@ -1378,18 +1344,14 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, ...@@ -1378,18 +1344,14 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
block2 = block2->next; block2 = block2->next;
/* ptr2 = ptr. */ /* ptr2 = ptr. */
block2->next = XCNEW (gfc_code); block2->next = gfc_get_code (EXEC_ASSIGN);
block2 = block2->next; block2 = block2->next;
block2->op = EXEC_ASSIGN;
block2->loc = gfc_current_locus;
block2->expr1 = gfc_lval_expr_from_sym (ptr2); block2->expr1 = gfc_lval_expr_from_sym (ptr2);
block2->expr2 = gfc_lval_expr_from_sym (ptr); block2->expr2 = gfc_lval_expr_from_sym (ptr);
/* Call now the user's final subroutine. */ /* Call now the user's final subroutine. */
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_CALL);
block = block->next; block = block->next;
block->op = EXEC_CALL;
block->loc = gfc_current_locus;
block->symtree = fini->proc_tree; block->symtree = fini->proc_tree;
block->resolved_sym = fini->proc_tree->n.sym; block->resolved_sym = fini->proc_tree->n.sym;
block->ext.actual = gfc_get_actual_arglist (); block->ext.actual = gfc_get_actual_arglist ();
...@@ -1407,13 +1369,10 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, ...@@ -1407,13 +1369,10 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
iter->end = gfc_lval_expr_from_sym (nelem); iter->end = gfc_lval_expr_from_sym (nelem);
iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_DO);
block = block->next; block = block->next;
block->op = EXEC_DO;
block->loc = gfc_current_locus;
block->ext.iterator = iter; block->ext.iterator = iter;
block->block = gfc_get_code (); block->block = gfc_get_code (EXEC_DO);
block->block->op = EXEC_DO;
/* Offset calculation of "array". */ /* Offset calculation of "array". */
block2 = finalization_get_offset (idx, idx2, offset, strides, sizes, block2 = finalization_get_offset (idx, idx2, offset, strides, sizes,
...@@ -1431,9 +1390,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, ...@@ -1431,9 +1390,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
block2 = block2->next; block2 = block2->next;
/* ptr = ptr2. */ /* ptr = ptr2. */
block2->next = XCNEW (gfc_code); block2->next = gfc_get_code (EXEC_ASSIGN);
block2->next->op = EXEC_ASSIGN;
block2->next->loc = gfc_current_locus;
block2->next->expr1 = gfc_lval_expr_from_sym (ptr); block2->next->expr1 = gfc_lval_expr_from_sym (ptr);
block2->next->expr2 = gfc_lval_expr_from_sym (ptr2); block2->next->expr2 = gfc_lval_expr_from_sym (ptr2);
} }
...@@ -1695,27 +1652,21 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1695,27 +1652,21 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
/* Set return value to 0. */ /* Set return value to 0. */
last_code = XCNEW (gfc_code); last_code = gfc_get_code (EXEC_ASSIGN);
last_code->op = EXEC_ASSIGN;
last_code->loc = gfc_current_locus;
last_code->expr1 = gfc_lval_expr_from_sym (final); last_code->expr1 = gfc_lval_expr_from_sym (final);
last_code->expr2 = gfc_get_int_expr (4, NULL, 0); last_code->expr2 = gfc_get_int_expr (4, NULL, 0);
sub_ns->code = last_code; sub_ns->code = last_code;
/* Set: is_contiguous = .true. */ /* Set: is_contiguous = .true. */
last_code->next = XCNEW (gfc_code); last_code->next = gfc_get_code (EXEC_ASSIGN);
last_code = last_code->next; last_code = last_code->next;
last_code->op = EXEC_ASSIGN;
last_code->loc = gfc_current_locus;
last_code->expr1 = gfc_lval_expr_from_sym (is_contiguous); last_code->expr1 = gfc_lval_expr_from_sym (is_contiguous);
last_code->expr2 = gfc_get_logical_expr (gfc_default_logical_kind, last_code->expr2 = gfc_get_logical_expr (gfc_default_logical_kind,
&gfc_current_locus, true); &gfc_current_locus, true);
/* Set: sizes(0) = 1. */ /* Set: sizes(0) = 1. */
last_code->next = XCNEW (gfc_code); last_code->next = gfc_get_code (EXEC_ASSIGN);
last_code = last_code->next; last_code = last_code->next;
last_code->op = EXEC_ASSIGN;
last_code->loc = gfc_current_locus;
last_code->expr1 = gfc_lval_expr_from_sym (sizes); last_code->expr1 = gfc_lval_expr_from_sym (sizes);
last_code->expr1->ref = gfc_get_ref (); last_code->expr1->ref = gfc_get_ref ();
last_code->expr1->ref->type = REF_ARRAY; last_code->expr1->ref->type = REF_ARRAY;
...@@ -1740,19 +1691,14 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1740,19 +1691,14 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
iter->end = gfc_copy_expr (rank); iter->end = gfc_copy_expr (rank);
iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
last_code->next = XCNEW (gfc_code); last_code->next = gfc_get_code (EXEC_DO);
last_code = last_code->next; last_code = last_code->next;
last_code->op = EXEC_DO;
last_code->loc = gfc_current_locus;
last_code->ext.iterator = iter; last_code->ext.iterator = iter;
last_code->block = gfc_get_code (); last_code->block = gfc_get_code (EXEC_DO);
last_code->block->op = EXEC_DO;
/* strides(idx) = _F._stride(array,dim=idx). */ /* strides(idx) = _F._stride(array,dim=idx). */
last_code->block->next = XCNEW (gfc_code); last_code->block->next = gfc_get_code (EXEC_ASSIGN);
block = last_code->block->next; block = last_code->block->next;
block->op = EXEC_ASSIGN;
block->loc = gfc_current_locus;
block->expr1 = gfc_lval_expr_from_sym (strides); block->expr1 = gfc_lval_expr_from_sym (strides);
block->expr1->ref = gfc_get_ref (); block->expr1->ref = gfc_get_ref ();
...@@ -1769,10 +1715,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1769,10 +1715,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
gfc_lval_expr_from_sym (idx)); gfc_lval_expr_from_sym (idx));
/* sizes(idx) = sizes(idx-1) * size(array,dim=idx, kind=index_kind). */ /* sizes(idx) = sizes(idx-1) * size(array,dim=idx, kind=index_kind). */
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_ASSIGN);
block = block->next; block = block->next;
block->op = EXEC_ASSIGN;
block->loc = gfc_current_locus;
/* sizes(idx) = ... */ /* sizes(idx) = ... */
block->expr1 = gfc_lval_expr_from_sym (sizes); block->expr1 = gfc_lval_expr_from_sym (sizes);
...@@ -1819,15 +1763,11 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1819,15 +1763,11 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
block->expr2->ts = idx->ts; block->expr2->ts = idx->ts;
/* if (strides (idx) /= sizes(idx-1)) is_contiguous = .false. */ /* if (strides (idx) /= sizes(idx-1)) is_contiguous = .false. */
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_IF);
block = block->next; block = block->next;
block->loc = gfc_current_locus;
block->op = EXEC_IF;
block->block = XCNEW (gfc_code); block->block = gfc_get_code (EXEC_IF);
block = block->block; block = block->block;
block->loc = gfc_current_locus;
block->op = EXEC_IF;
/* if condition: strides(idx) /= sizes(idx-1). */ /* if condition: strides(idx) /= sizes(idx-1). */
block->expr1 = gfc_get_expr (); block->expr1 = gfc_get_expr ();
...@@ -1864,10 +1804,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1864,10 +1804,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
= block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1->ts; = block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1->ts;
/* if body: is_contiguous = .false. */ /* if body: is_contiguous = .false. */
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_ASSIGN);
block = block->next; block = block->next;
block->op = EXEC_ASSIGN;
block->loc = gfc_current_locus;
block->expr1 = gfc_lval_expr_from_sym (is_contiguous); block->expr1 = gfc_lval_expr_from_sym (is_contiguous);
block->expr2 = gfc_get_logical_expr (gfc_default_logical_kind, block->expr2 = gfc_get_logical_expr (gfc_default_logical_kind,
&gfc_current_locus, false); &gfc_current_locus, false);
...@@ -1883,10 +1821,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1883,10 +1821,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
gfc_commit_symbol (nelem); gfc_commit_symbol (nelem);
/* nelem = sizes (rank) - 1. */ /* nelem = sizes (rank) - 1. */
last_code->next = XCNEW (gfc_code); last_code->next = gfc_get_code (EXEC_ASSIGN);
last_code = last_code->next; last_code = last_code->next;
last_code->op = EXEC_ASSIGN;
last_code->loc = gfc_current_locus;
last_code->expr1 = gfc_lval_expr_from_sym (nelem); last_code->expr1 = gfc_lval_expr_from_sym (nelem);
...@@ -1938,10 +1874,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1938,10 +1874,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
gfc_commit_symbol (ptr); gfc_commit_symbol (ptr);
/* SELECT CASE (RANK (array)). */ /* SELECT CASE (RANK (array)). */
last_code->next = XCNEW (gfc_code); last_code->next = gfc_get_code (EXEC_SELECT);
last_code = last_code->next; last_code = last_code->next;
last_code->op = EXEC_SELECT;
last_code->loc = gfc_current_locus;
last_code->expr1 = gfc_copy_expr (rank); last_code->expr1 = gfc_copy_expr (rank);
block = NULL; block = NULL;
...@@ -1956,16 +1890,14 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1956,16 +1890,14 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
/* CASE (fini_rank). */ /* CASE (fini_rank). */
if (block) if (block)
{ {
block->block = XCNEW (gfc_code); block->block = gfc_get_code (EXEC_SELECT);
block = block->block; block = block->block;
} }
else else
{ {
block = XCNEW (gfc_code); block = gfc_get_code (EXEC_SELECT);
last_code->block = block; last_code->block = block;
} }
block->loc = gfc_current_locus;
block->op = EXEC_SELECT;
block->ext.block.case_list = gfc_get_case (); block->ext.block.case_list = gfc_get_case ();
block->ext.block.case_list->where = gfc_current_locus; block->ext.block.case_list->where = gfc_current_locus;
if (fini->proc_tree->n.sym->formal->sym->attr.dimension) if (fini->proc_tree->n.sym->formal->sym->attr.dimension)
...@@ -1986,9 +1918,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -1986,9 +1918,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
rank, sub_ns); rank, sub_ns);
else else
{ {
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_CALL);
block->next->op = EXEC_CALL;
block->next->loc = gfc_current_locus;
block->next->symtree = fini->proc_tree; block->next->symtree = fini->proc_tree;
block->next->resolved_sym = fini->proc_tree->n.sym; block->next->resolved_sym = fini->proc_tree->n.sym;
block->next->ext.actual = gfc_get_actual_arglist (); block->next->ext.actual = gfc_get_actual_arglist ();
...@@ -2002,16 +1932,14 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -2002,16 +1932,14 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
/* CASE DEFAULT. */ /* CASE DEFAULT. */
if (block) if (block)
{ {
block->block = XCNEW (gfc_code); block->block = gfc_get_code (EXEC_SELECT);
block = block->block; block = block->block;
} }
else else
{ {
block = XCNEW (gfc_code); block = gfc_get_code (EXEC_SELECT);
last_code->block = block; last_code->block = block;
} }
block->loc = gfc_current_locus;
block->op = EXEC_SELECT;
block->ext.block.case_list = gfc_get_case (); block->ext.block.case_list = gfc_get_case ();
/* Create loop. */ /* Create loop. */
...@@ -2020,13 +1948,10 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -2020,13 +1948,10 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0); iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
iter->end = gfc_lval_expr_from_sym (nelem); iter->end = gfc_lval_expr_from_sym (nelem);
iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_DO);
block = block->next; block = block->next;
block->op = EXEC_DO;
block->loc = gfc_current_locus;
block->ext.iterator = iter; block->ext.iterator = iter;
block->block = gfc_get_code (); block->block = gfc_get_code (EXEC_DO);
block->block->op = EXEC_DO;
/* Offset calculation. */ /* Offset calculation. */
block = finalization_get_offset (idx, idx2, offset, strides, sizes, block = finalization_get_offset (idx, idx2, offset, strides, sizes,
...@@ -2043,10 +1968,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -2043,10 +1968,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
block = block->next; block = block->next;
/* CALL final_elemental (array). */ /* CALL final_elemental (array). */
block->next = XCNEW (gfc_code); block->next = gfc_get_code (EXEC_CALL);
block = block->next; block = block->next;
block->op = EXEC_CALL;
block->loc = gfc_current_locus;
block->symtree = fini_elem->proc_tree; block->symtree = fini_elem->proc_tree;
block->resolved_sym = fini_elem->proc_sym; block->resolved_sym = fini_elem->proc_sym;
block->ext.actual = gfc_get_actual_arglist (); block->ext.actual = gfc_get_actual_arglist ();
...@@ -2088,13 +2011,10 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -2088,13 +2011,10 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0); iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
iter->end = gfc_lval_expr_from_sym (nelem); iter->end = gfc_lval_expr_from_sym (nelem);
iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); iter->step = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
last_code->next = XCNEW (gfc_code); last_code->next = gfc_get_code (EXEC_DO);
last_code = last_code->next; last_code = last_code->next;
last_code->op = EXEC_DO;
last_code->loc = gfc_current_locus;
last_code->ext.iterator = iter; last_code->ext.iterator = iter;
last_code->block = gfc_get_code (); last_code->block = gfc_get_code (EXEC_DO);
last_code->block->op = EXEC_DO;
/* Offset calculation. */ /* Offset calculation. */
block = finalization_get_offset (idx, idx2, offset, strides, sizes, block = finalization_get_offset (idx, idx2, offset, strides, sizes,
...@@ -2126,10 +2046,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, ...@@ -2126,10 +2046,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
/* Call the finalizer of the ancestor. */ /* Call the finalizer of the ancestor. */
if (ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL) if (ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL)
{ {
last_code->next = XCNEW (gfc_code); last_code->next = gfc_get_code (EXEC_CALL);
last_code = last_code->next; last_code = last_code->next;
last_code->op = EXEC_CALL;
last_code->loc = gfc_current_locus;
last_code->symtree = ancestor_wrapper->symtree; last_code->symtree = ancestor_wrapper->symtree;
last_code->resolved_sym = ancestor_wrapper->symtree->n.sym; last_code->resolved_sym = ancestor_wrapper->symtree->n.sym;
...@@ -2375,8 +2293,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ...@@ -2375,8 +2293,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
copy->formal->next = gfc_get_formal_arglist (); copy->formal->next = gfc_get_formal_arglist ();
copy->formal->next->sym = dst; copy->formal->next->sym = dst;
/* Set up code. */ /* Set up code. */
sub_ns->code = gfc_get_code (); sub_ns->code = gfc_get_code (EXEC_INIT_ASSIGN);
sub_ns->code->op = EXEC_INIT_ASSIGN;
sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst); sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
sub_ns->code->expr2 = gfc_lval_expr_from_sym (src); sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
/* Set initializer. */ /* Set initializer. */
...@@ -2659,8 +2576,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) ...@@ -2659,8 +2576,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
copy->formal->next = gfc_get_formal_arglist (); copy->formal->next = gfc_get_formal_arglist ();
copy->formal->next->sym = dst; copy->formal->next->sym = dst;
/* Set up code. */ /* Set up code. */
sub_ns->code = gfc_get_code (); sub_ns->code = gfc_get_code (EXEC_INIT_ASSIGN);
sub_ns->code->op = EXEC_INIT_ASSIGN;
sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst); sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
sub_ns->code->expr2 = gfc_lval_expr_from_sym (src); sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
got_char_copy: got_char_copy:
......
...@@ -2820,7 +2820,7 @@ bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*); ...@@ -2820,7 +2820,7 @@ bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
extern gfc_code new_st; extern gfc_code new_st;
void gfc_clear_new_st (void); void gfc_clear_new_st (void);
gfc_code *gfc_get_code (void); gfc_code *gfc_get_code (gfc_exec_op);
gfc_code *gfc_append_code (gfc_code *, gfc_code *); gfc_code *gfc_append_code (gfc_code *, gfc_code *);
void gfc_free_statement (gfc_code *); void gfc_free_statement (gfc_code *);
void gfc_free_statements (gfc_code *); void gfc_free_statements (gfc_code *);
......
...@@ -3055,12 +3055,10 @@ match_io_iterator (io_kind k, gfc_code **result) ...@@ -3055,12 +3055,10 @@ match_io_iterator (io_kind k, gfc_code **result)
if (gfc_match_char (')') != MATCH_YES) if (gfc_match_char (')') != MATCH_YES)
goto syntax; goto syntax;
new_code = gfc_get_code (); new_code = gfc_get_code (EXEC_DO);
new_code->op = EXEC_DO;
new_code->ext.iterator = iter; new_code->ext.iterator = iter;
new_code->block = gfc_get_code (); new_code->block = gfc_get_code (EXEC_DO);
new_code->block->op = EXEC_DO;
new_code->block->next = head; new_code->block->next = head;
*result = new_code; *result = new_code;
...@@ -3117,8 +3115,7 @@ match_io_element (io_kind k, gfc_code **cpp) ...@@ -3117,8 +3115,7 @@ match_io_element (io_kind k, gfc_code **cpp)
return MATCH_ERROR; return MATCH_ERROR;
} }
cp = gfc_get_code (); cp = gfc_get_code (EXEC_TRANSFER);
cp->op = EXEC_TRANSFER;
cp->expr1 = expr; cp->expr1 = expr;
if (k != M_INQUIRE) if (k != M_INQUIRE)
cp->ext.dt = current_dt; cp->ext.dt = current_dt;
...@@ -3180,8 +3177,7 @@ terminate_io (gfc_code *io_code) ...@@ -3180,8 +3177,7 @@ terminate_io (gfc_code *io_code)
if (io_code == NULL) if (io_code == NULL)
io_code = new_st.block; io_code = new_st.block;
c = gfc_get_code (); c = gfc_get_code (EXEC_DT_END);
c->op = EXEC_DT_END;
/* Point to structure that is already there */ /* Point to structure that is already there */
c->ext.dt = new_st.ext.dt; c->ext.dt = new_st.ext.dt;
...@@ -3751,8 +3747,7 @@ get_io_list: ...@@ -3751,8 +3747,7 @@ get_io_list:
new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE; new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE;
new_st.ext.dt = dt; new_st.ext.dt = dt;
new_st.block = gfc_get_code (); new_st.block = gfc_get_code (new_st.op);
new_st.block->op = new_st.op;
new_st.block->next = io_code; new_st.block->next = io_code;
terminate_io (io_code); terminate_io (io_code);
...@@ -3961,8 +3956,7 @@ gfc_match_inquire (void) ...@@ -3961,8 +3956,7 @@ gfc_match_inquire (void)
if (gfc_implicit_pure (NULL)) if (gfc_implicit_pure (NULL))
gfc_current_ns->proc_name->attr.implicit_pure = 0; gfc_current_ns->proc_name->attr.implicit_pure = 0;
new_st.block = gfc_get_code (); new_st.block = gfc_get_code (EXEC_IOLENGTH);
new_st.block->op = EXEC_IOLENGTH;
terminate_io (code); terminate_io (code);
new_st.block->next = code; new_st.block->next = code;
return MATCH_YES; return MATCH_YES;
......
...@@ -1608,13 +1608,12 @@ got_match: ...@@ -1608,13 +1608,12 @@ got_match:
is in new_st. Rearrange things so that the IF statement appears is in new_st. Rearrange things so that the IF statement appears
in new_st. */ in new_st. */
p = gfc_get_code (); p = gfc_get_code (EXEC_IF);
p->next = gfc_get_code (); p->next = XCNEW (gfc_code);
*p->next = new_st; *p->next = new_st;
p->next->loc = gfc_current_locus; p->next->loc = gfc_current_locus;
p->expr1 = expr; p->expr1 = expr;
p->op = EXEC_IF;
gfc_clear_new_st (); gfc_clear_new_st ();
...@@ -2224,7 +2223,7 @@ match_simple_forall (void) ...@@ -2224,7 +2223,7 @@ match_simple_forall (void)
goto syntax; goto syntax;
} }
c = gfc_get_code (); c = XCNEW (gfc_code);
*c = new_st; *c = new_st;
c->loc = gfc_current_locus; c->loc = gfc_current_locus;
...@@ -2235,9 +2234,7 @@ match_simple_forall (void) ...@@ -2235,9 +2234,7 @@ match_simple_forall (void)
new_st.op = EXEC_FORALL; new_st.op = EXEC_FORALL;
new_st.expr1 = 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 (EXEC_FORALL);
new_st.block->op = EXEC_FORALL;
new_st.block->next = c; new_st.block->next = c;
return MATCH_YES; return MATCH_YES;
...@@ -2302,7 +2299,7 @@ gfc_match_forall (gfc_statement *st) ...@@ -2302,7 +2299,7 @@ gfc_match_forall (gfc_statement *st)
goto syntax; goto syntax;
} }
c = gfc_get_code (); c = XCNEW (gfc_code);
*c = new_st; *c = new_st;
c->loc = gfc_current_locus; c->loc = gfc_current_locus;
...@@ -2310,8 +2307,7 @@ gfc_match_forall (gfc_statement *st) ...@@ -2310,8 +2307,7 @@ gfc_match_forall (gfc_statement *st)
new_st.op = EXEC_FORALL; new_st.op = EXEC_FORALL;
new_st.expr1 = 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 (EXEC_FORALL);
new_st.block->op = EXEC_FORALL;
new_st.block->next = c; new_st.block->next = c;
*st = ST_FORALL; *st = ST_FORALL;
...@@ -3283,15 +3279,14 @@ gfc_match_goto (void) ...@@ -3283,15 +3279,14 @@ gfc_match_goto (void)
goto cleanup; goto cleanup;
if (head == NULL) if (head == NULL)
head = tail = gfc_get_code (); head = tail = gfc_get_code (EXEC_GOTO);
else else
{ {
tail->block = gfc_get_code (); tail->block = gfc_get_code (EXEC_GOTO);
tail = tail->block; tail = tail->block;
} }
tail->label1 = label; tail->label1 = label;
tail->op = EXEC_GOTO;
} }
while (gfc_match_char (',') == MATCH_YES); while (gfc_match_char (',') == MATCH_YES);
...@@ -3328,10 +3323,10 @@ gfc_match_goto (void) ...@@ -3328,10 +3323,10 @@ gfc_match_goto (void)
goto cleanup; goto cleanup;
if (head == NULL) if (head == NULL)
head = tail = gfc_get_code (); head = tail = gfc_get_code (EXEC_SELECT);
else else
{ {
tail->block = gfc_get_code (); tail->block = gfc_get_code (EXEC_SELECT);
tail = tail->block; tail = tail->block;
} }
...@@ -3339,11 +3334,9 @@ gfc_match_goto (void) ...@@ -3339,11 +3334,9 @@ gfc_match_goto (void)
cp->low = cp->high = gfc_get_int_expr (gfc_default_integer_kind, cp->low = cp->high = gfc_get_int_expr (gfc_default_integer_kind,
NULL, i++); NULL, i++);
tail->op = EXEC_SELECT;
tail->ext.block.case_list = cp; tail->ext.block.case_list = cp;
tail->next = gfc_get_code (); tail->next = gfc_get_code (EXEC_GOTO);
tail->next->op = EXEC_GOTO;
tail->next->label1 = label; tail->next->label1 = label;
} }
while (gfc_match_char (',') == MATCH_YES); while (gfc_match_char (',') == MATCH_YES);
...@@ -3800,14 +3793,16 @@ gfc_match_nullify (void) ...@@ -3800,14 +3793,16 @@ gfc_match_nullify (void)
/* Chain to list. */ /* Chain to list. */
if (tail == NULL) if (tail == NULL)
tail = &new_st; {
tail = &new_st;
tail->op = EXEC_POINTER_ASSIGN;
}
else else
{ {
tail->next = gfc_get_code (); tail->next = gfc_get_code (EXEC_POINTER_ASSIGN);
tail = tail->next; tail = tail->next;
} }
tail->op = EXEC_POINTER_ASSIGN;
tail->expr1 = p; tail->expr1 = p;
tail->expr2 = e; tail->expr2 = e;
...@@ -4199,8 +4194,7 @@ gfc_match_call (void) ...@@ -4199,8 +4194,7 @@ gfc_match_call (void)
gfc_symbol *select_sym; gfc_symbol *select_sym;
char name[GFC_MAX_SYMBOL_LEN + 1]; char name[GFC_MAX_SYMBOL_LEN + 1];
new_st.next = c = gfc_get_code (); new_st.next = c = gfc_get_code (EXEC_SELECT);
c->op = EXEC_SELECT;
sprintf (name, "_result_%s", sym->name); sprintf (name, "_result_%s", sym->name);
gfc_get_ha_sym_tree (name, &select_st); /* Can't fail. */ gfc_get_ha_sym_tree (name, &select_st); /* Can't fail. */
...@@ -4225,17 +4219,15 @@ gfc_match_call (void) ...@@ -4225,17 +4219,15 @@ gfc_match_call (void)
i++; i++;
c->block = gfc_get_code (); c->block = gfc_get_code (EXEC_SELECT);
c = c->block; c = c->block;
c->op = EXEC_SELECT;
new_case = gfc_get_case (); new_case = gfc_get_case ();
new_case->high = gfc_get_int_expr (gfc_default_integer_kind, NULL, i); new_case->high = gfc_get_int_expr (gfc_default_integer_kind, NULL, i);
new_case->low = new_case->high; new_case->low = new_case->high;
c->ext.block.case_list = new_case; c->ext.block.case_list = new_case;
c->next = gfc_get_code (); c->next = gfc_get_code (EXEC_GOTO);
c->next->op = EXEC_GOTO;
c->next->label1 = a->label; c->next->label1 = a->label;
} }
} }
...@@ -5639,12 +5631,10 @@ match_simple_where (void) ...@@ -5639,12 +5631,10 @@ match_simple_where (void)
if (gfc_match_eos () != MATCH_YES) if (gfc_match_eos () != MATCH_YES)
goto syntax; goto syntax;
c = gfc_get_code (); c = gfc_get_code (EXEC_WHERE);
c->op = EXEC_WHERE;
c->expr1 = expr; c->expr1 = expr;
c->next = gfc_get_code ();
c->next = XCNEW (gfc_code);
*c->next = new_st; *c->next = new_st;
gfc_clear_new_st (); gfc_clear_new_st ();
...@@ -5699,12 +5689,10 @@ gfc_match_where (gfc_statement *st) ...@@ -5699,12 +5689,10 @@ gfc_match_where (gfc_statement *st)
/* We've got a simple WHERE statement. */ /* We've got a simple WHERE statement. */
*st = ST_WHERE; *st = ST_WHERE;
c = gfc_get_code (); c = gfc_get_code (EXEC_WHERE);
c->op = EXEC_WHERE;
c->expr1 = expr; c->expr1 = expr;
c->next = gfc_get_code ();
c->next = XCNEW (gfc_code);
*c->next = new_st; *c->next = new_st;
gfc_clear_new_st (); gfc_clear_new_st ();
......
...@@ -1095,7 +1095,7 @@ new_level (gfc_code *q) ...@@ -1095,7 +1095,7 @@ new_level (gfc_code *q)
{ {
gfc_code *p; gfc_code *p;
p = q->block = gfc_get_code (); p = q->block = gfc_get_code (EXEC_NOP);
gfc_state_stack->head = gfc_state_stack->tail = p; gfc_state_stack->head = gfc_state_stack->tail = p;
...@@ -1111,7 +1111,7 @@ add_statement (void) ...@@ -1111,7 +1111,7 @@ add_statement (void)
{ {
gfc_code *p; gfc_code *p;
p = gfc_get_code (); p = XCNEW (gfc_code);
*p = new_st; *p = new_st;
p->loc = gfc_current_locus; p->loc = gfc_current_locus;
......
...@@ -723,8 +723,7 @@ resolve_entries (gfc_namespace *ns) ...@@ -723,8 +723,7 @@ resolve_entries (gfc_namespace *ns)
el = ns->entries; el = ns->entries;
/* Add an entry statement for it. */ /* Add an entry statement for it. */
c = gfc_get_code (); c = gfc_get_code (EXEC_ENTRY);
c->op = EXEC_ENTRY;
c->ext.entry = el; c->ext.entry = el;
c->next = ns->code; c->next = ns->code;
ns->code = c; ns->code = c;
...@@ -6880,9 +6879,8 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) ...@@ -6880,9 +6879,8 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
if (ts.type == BT_DERIVED && (init_e = gfc_default_initializer (&ts))) if (ts.type == BT_DERIVED && (init_e = gfc_default_initializer (&ts)))
{ {
gfc_code *init_st = gfc_get_code (); gfc_code *init_st = gfc_get_code (EXEC_INIT_ASSIGN);
init_st->loc = code->loc; init_st->loc = code->loc;
init_st->op = EXEC_INIT_ASSIGN;
init_st->expr1 = gfc_expr_to_initialize (e); init_st->expr1 = gfc_expr_to_initialize (e);
init_st->expr2 = init_e; init_st->expr2 = init_e;
init_st->next = code->next; init_st->next = code->next;
...@@ -8020,8 +8018,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) ...@@ -8020,8 +8018,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
code->ext.block.assoc = NULL; code->ext.block.assoc = NULL;
/* Add EXEC_SELECT to switch on type. */ /* Add EXEC_SELECT to switch on type. */
new_st = gfc_get_code (); new_st = gfc_get_code (code->op);
new_st->op = code->op;
new_st->expr1 = code->expr1; new_st->expr1 = code->expr1;
new_st->expr2 = code->expr2; new_st->expr2 = code->expr2;
new_st->block = code->block; new_st->block = code->block;
...@@ -8087,8 +8084,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) ...@@ -8087,8 +8084,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
if (c->ts.type != BT_CLASS && c->ts.type != BT_UNKNOWN) if (c->ts.type != BT_CLASS && c->ts.type != BT_UNKNOWN)
gfc_add_data_component (st->n.sym->assoc->target); gfc_add_data_component (st->n.sym->assoc->target);
new_st = gfc_get_code (); new_st = gfc_get_code (EXEC_BLOCK);
new_st->op = EXEC_BLOCK;
new_st->ext.block.ns = gfc_build_block_ns (ns); new_st->ext.block.ns = gfc_build_block_ns (ns);
new_st->ext.block.ns->code = body->next; new_st->ext.block.ns->code = body->next;
body->next = new_st; body->next = new_st;
...@@ -8139,9 +8135,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) ...@@ -8139,9 +8135,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
{ {
/* Add a default case to hold the CLASS IS cases. */ /* Add a default case to hold the CLASS IS cases. */
for (tail = code; tail->block; tail = tail->block) ; for (tail = code; tail->block; tail = tail->block) ;
tail->block = gfc_get_code (); tail->block = gfc_get_code (EXEC_SELECT_TYPE);
tail = tail->block; tail = tail->block;
tail->op = EXEC_SELECT_TYPE;
tail->ext.block.case_list = gfc_get_case (); tail->ext.block.case_list = gfc_get_case ();
tail->ext.block.case_list->ts.type = BT_UNKNOWN; tail->ext.block.case_list->ts.type = BT_UNKNOWN;
tail->next = NULL; tail->next = NULL;
...@@ -8184,14 +8179,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) ...@@ -8184,14 +8179,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
} }
/* Generate IF chain. */ /* Generate IF chain. */
if_st = gfc_get_code (); if_st = gfc_get_code (EXEC_IF);
if_st->op = EXEC_IF;
new_st = if_st; new_st = if_st;
for (body = class_is; body; body = body->block) for (body = class_is; body; body = body->block)
{ {
new_st->block = gfc_get_code (); new_st->block = gfc_get_code (EXEC_IF);
new_st = new_st->block; new_st = new_st->block;
new_st->op = EXEC_IF;
/* Set up IF condition: Call _gfortran_is_extension_of. */ /* Set up IF condition: Call _gfortran_is_extension_of. */
new_st->expr1 = gfc_get_expr (); new_st->expr1 = gfc_get_expr ();
new_st->expr1->expr_type = EXPR_FUNCTION; new_st->expr1->expr_type = EXPR_FUNCTION;
...@@ -8213,9 +8206,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) ...@@ -8213,9 +8206,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
} }
if (default_case->next) if (default_case->next)
{ {
new_st->block = gfc_get_code (); new_st->block = gfc_get_code (EXEC_IF);
new_st = new_st->block; new_st = new_st->block;
new_st->op = EXEC_IF;
new_st->next = default_case->next; new_st->next = default_case->next;
} }
...@@ -9241,8 +9233,7 @@ build_assignment (gfc_exec_op op, gfc_expr *expr1, gfc_expr *expr2, ...@@ -9241,8 +9233,7 @@ build_assignment (gfc_exec_op op, gfc_expr *expr1, gfc_expr *expr2,
{ {
gfc_code *this_code; gfc_code *this_code;
this_code = gfc_get_code (); this_code = gfc_get_code (op);
this_code->op = op;
this_code->next = NULL; this_code->next = NULL;
this_code->expr1 = gfc_copy_expr (expr1); this_code->expr1 = gfc_copy_expr (expr1);
this_code->expr2 = gfc_copy_expr (expr2); this_code->expr2 = gfc_copy_expr (expr2);
...@@ -10281,13 +10272,12 @@ build_init_assign (gfc_symbol *sym, gfc_expr *init) ...@@ -10281,13 +10272,12 @@ build_init_assign (gfc_symbol *sym, gfc_expr *init)
lval = gfc_lval_expr_from_sym (sym); lval = gfc_lval_expr_from_sym (sym);
/* Add the code at scope entry. */ /* Add the code at scope entry. */
init_st = gfc_get_code (); init_st = gfc_get_code (EXEC_INIT_ASSIGN);
init_st->next = ns->code; init_st->next = ns->code;
ns->code = init_st; ns->code = init_st;
/* 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->expr1 = lval; init_st->expr1 = lval;
init_st->expr2 = init; init_st->expr2 = init;
} }
......
...@@ -41,14 +41,16 @@ gfc_clear_new_st (void) ...@@ -41,14 +41,16 @@ gfc_clear_new_st (void)
} }
/* Get a gfc_code structure. */ /* Get a gfc_code structure, initialized with the current locus
and a statement code 'op'. */
gfc_code * gfc_code *
gfc_get_code (void) gfc_get_code (gfc_exec_op op)
{ {
gfc_code *c; gfc_code *c;
c = XCNEW (gfc_code); c = XCNEW (gfc_code);
c->op = op;
c->loc = gfc_current_locus; c->loc = gfc_current_locus;
return c; return c;
} }
......
...@@ -895,14 +895,13 @@ gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj) ...@@ -895,14 +895,13 @@ gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj)
ppc = gfc_copy_expr (obj); ppc = gfc_copy_expr (obj);
gfc_add_vptr_component (ppc); gfc_add_vptr_component (ppc);
gfc_add_component_ref (ppc, "_copy"); gfc_add_component_ref (ppc, "_copy");
ppc_code = gfc_get_code (); ppc_code = gfc_get_code (EXEC_CALL);
ppc_code->resolved_sym = ppc->symtree->n.sym; ppc_code->resolved_sym = ppc->symtree->n.sym;
/* Although '_copy' is set to be elemental in class.c, it is /* Although '_copy' is set to be elemental in class.c, it is
not staying that way. Find out why, sometime.... */ not staying that way. Find out why, sometime.... */
ppc_code->resolved_sym->attr.elemental = 1; ppc_code->resolved_sym->attr.elemental = 1;
ppc_code->ext.actual = actual; ppc_code->ext.actual = actual;
ppc_code->expr1 = ppc; ppc_code->expr1 = ppc;
ppc_code->op = EXEC_CALL;
/* Since '_copy' is elemental, the scalarizer will take care /* Since '_copy' is elemental, the scalarizer will take care
of arrays in gfc_trans_call. */ of arrays in gfc_trans_call. */
res = gfc_trans_call (ppc_code, false, NULL, NULL, false); res = gfc_trans_call (ppc_code, false, NULL, NULL, false);
......
...@@ -5232,14 +5232,13 @@ gfc_trans_allocate (gfc_code * code) ...@@ -5232,14 +5232,13 @@ gfc_trans_allocate (gfc_code * code)
(gfc_find_intrinsic_vtab (&rhs->ts)); (gfc_find_intrinsic_vtab (&rhs->ts));
gfc_add_component_ref (ppc, "_copy"); gfc_add_component_ref (ppc, "_copy");
ppc_code = gfc_get_code (); ppc_code = gfc_get_code (EXEC_CALL);
ppc_code->resolved_sym = ppc->symtree->n.sym; ppc_code->resolved_sym = ppc->symtree->n.sym;
/* Although '_copy' is set to be elemental in class.c, it is /* Although '_copy' is set to be elemental in class.c, it is
not staying that way. Find out why, sometime.... */ not staying that way. Find out why, sometime.... */
ppc_code->resolved_sym->attr.elemental = 1; ppc_code->resolved_sym->attr.elemental = 1;
ppc_code->ext.actual = actual; ppc_code->ext.actual = actual;
ppc_code->expr1 = ppc; ppc_code->expr1 = ppc;
ppc_code->op = EXEC_CALL;
/* Since '_copy' is elemental, the scalarizer will take care /* Since '_copy' is elemental, the scalarizer will take care
of arrays in gfc_trans_call. */ of arrays in gfc_trans_call. */
tmp = gfc_trans_call (ppc_code, true, NULL, NULL, false); tmp = gfc_trans_call (ppc_code, true, NULL, NULL, false);
......
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