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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@201635 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8aa70a3adbeba9f9c2d608991c8f876964e0a5ea..c1adb88d1bc02c171201f26b96cd3af04fc47fe7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,25 @@
+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

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index fb16682e51c0a8a08573ec9403930e90f48c3af3..629b052fb32dddc9cd0601cfe7238d868178a11f 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -863,7 +863,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
          || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
              && CLASS_DATA (comp)->attr.allocatable))
        {
-         block = XCNEW (gfc_code);
+         block = gfc_get_code (EXEC_IF);
          if (*code)
            {
              (*code)->next = block;
@@ -872,19 +872,12 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
          else
              (*code) = block;
 
-         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->loc = gfc_current_locus;
-         block->op = EXEC_IF;
          block->expr1 = gfc_lval_expr_from_sym (fini_coarray);
        }
 
-      dealloc = XCNEW (gfc_code);
-      dealloc->op = EXEC_DEALLOCATE;
-      dealloc->loc = gfc_current_locus;
+      dealloc = gfc_get_code (EXEC_DEALLOCATE);
 
       dealloc->ext.alloc.list = gfc_get_alloc ();
       dealloc->ext.alloc.list->expr = e;
@@ -915,10 +908,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
          break;
 
       gcc_assert (c);
-      final_wrap = XCNEW (gfc_code);
-      final_wrap->op = EXEC_CALL;
-      final_wrap->loc = gfc_current_locus;
-      final_wrap->loc = gfc_current_locus;
+      final_wrap = gfc_get_code (EXEC_CALL);
       final_wrap->symtree = c->initializer->symtree;
       final_wrap->resolved_sym = c->initializer->symtree->n.sym;
       final_wrap->ext.actual = gfc_get_actual_arglist ();
@@ -955,9 +945,7 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr,
   gfc_expr *expr, *expr2;
 
   /* C_F_POINTER().  */
-  block = XCNEW (gfc_code);
-  block->op = EXEC_CALL;
-  block->loc = gfc_current_locus;
+  block = gfc_get_code (EXEC_CALL);
   gfc_get_sym_tree ("c_f_pointer", sub_ns, &block->symtree, true);
   block->resolved_sym = block->symtree->n.sym;
   block->resolved_sym->attr.flavor = FL_PROCEDURE;
@@ -1037,10 +1025,8 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset,
   gfc_expr *expr, *expr2;
 
   /* offset = 0.  */
-  block->next = XCNEW (gfc_code);
+  block->next = gfc_get_code (EXEC_ASSIGN);
   block = block->next;
-  block->op = EXEC_ASSIGN;
-  block->loc = gfc_current_locus;
   block->expr1 = gfc_lval_expr_from_sym (offset);
   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,
   iter->start = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
   iter->end = gfc_copy_expr (rank);
   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->op = EXEC_DO;
-  block->loc = gfc_current_locus;
   block->ext.iterator = iter;
-  block->block = gfc_get_code ();
-  block->block->op = EXEC_DO;
+  block->block = gfc_get_code (EXEC_DO);
 
   /* Loop body: offset = offset + mod (idx, sizes(idx2)) / sizes(idx2-1)
                                  * strides(idx2).  */
@@ -1115,9 +1098,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset,
   expr->ts = idx->ts;
 
   /* offset = offset + ...  */
-  block->block->next = XCNEW (gfc_code);
-  block->block->next->op = EXEC_ASSIGN;
-  block->block->next->loc = gfc_current_locus;
+  block->block->next = gfc_get_code (EXEC_ASSIGN);
   block->block->next->expr1 = gfc_lval_expr_from_sym (offset);
   block->block->next->expr2 = gfc_get_expr ();
   block->block->next->expr2->expr_type = EXPR_OP;
@@ -1127,10 +1108,8 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset,
   block->block->next->expr2->ts = idx->ts;
 
   /* After the loop:  offset = offset * byte_stride.  */
-  block->next = XCNEW (gfc_code);
+  block->next = gfc_get_code (EXEC_ASSIGN);
   block = block->next;
-  block->op = EXEC_ASSIGN;
-  block->loc = gfc_current_locus;
   block->expr1 = gfc_lval_expr_from_sym (offset);
   block->expr2 = gfc_get_expr ();
   block->expr2->expr_type = EXPR_OP;
@@ -1189,15 +1168,11 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
   gfc_code *block2;
   int i;
 
-  block->next = XCNEW (gfc_code);
+  block->next = gfc_get_code (EXEC_IF);
   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->loc = gfc_current_locus;
-  block->op = EXEC_IF;
 
   /* size_expr = STORAGE_SIZE (...) / NUMERIC_STORAGE_SIZE.  */
   size_expr = gfc_get_expr ();
@@ -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);
 
   /* IF body: call final subroutine.  */
-  block->next = XCNEW (gfc_code);
-  block->next->op = EXEC_CALL;
-  block->next->loc = gfc_current_locus;
+  block->next = gfc_get_code (EXEC_CALL);
   block->next->symtree = fini->proc_tree;
   block->next->resolved_sym = fini->proc_tree->n.sym;
   block->next->ext.actual = gfc_get_actual_arglist ();
@@ -1284,17 +1257,13 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
 
   /* ELSE.  */
 
-  block->block = XCNEW (gfc_code);
+  block->block = gfc_get_code (EXEC_IF);
   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 ... END BLOCK.  */
-  block->op = EXEC_BLOCK;
-  block->loc = gfc_current_locus;
   ns = gfc_build_block_ns (sub_ns);
   block->ext.block.ns = ns;
   block->ext.block.assoc = NULL;
@@ -1347,13 +1316,10 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
   iter->end = gfc_lval_expr_from_sym (nelem);
   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;
-  block->op = EXEC_DO;
-  block->loc = gfc_current_locus;
   block->ext.iterator = iter;
-  block->block = gfc_get_code ();
-  block->block->op = EXEC_DO;
+  block->block = gfc_get_code (EXEC_DO);
 
   /* Offset calculation for the new array: idx * size of type (in bytes).  */
   offset2 = gfc_get_expr ();
@@ -1378,18 +1344,14 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
   block2 = block2->next;
 
   /* ptr2 = ptr.  */
-  block2->next = XCNEW (gfc_code);
+  block2->next = gfc_get_code (EXEC_ASSIGN);
   block2 = block2->next;
-  block2->op = EXEC_ASSIGN;
-  block2->loc = gfc_current_locus;
   block2->expr1 = gfc_lval_expr_from_sym (ptr2);
   block2->expr2 = gfc_lval_expr_from_sym (ptr);
 
   /* Call now the user's final subroutine. */
-  block->next  = XCNEW (gfc_code);
+  block->next  = gfc_get_code (EXEC_CALL);
   block = block->next;
-  block->op = EXEC_CALL;
-  block->loc = gfc_current_locus;
   block->symtree = fini->proc_tree;
   block->resolved_sym = fini->proc_tree->n.sym;
   block->ext.actual = gfc_get_actual_arglist ();
@@ -1407,13 +1369,10 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
   iter->end = gfc_lval_expr_from_sym (nelem);
   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->op = EXEC_DO;
-  block->loc = gfc_current_locus;
   block->ext.iterator = iter;
-  block->block = gfc_get_code ();
-  block->block->op = EXEC_DO;
+  block->block = gfc_get_code (EXEC_DO);
 
   /* Offset calculation of "array".  */
   block2 = finalization_get_offset (idx, idx2, offset, strides, sizes,
@@ -1431,9 +1390,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini,
   block2 = block2->next;
 
   /* ptr = ptr2.  */
-  block2->next = XCNEW (gfc_code);
-  block2->next->op = EXEC_ASSIGN;
-  block2->next->loc = gfc_current_locus;
+  block2->next = gfc_get_code (EXEC_ASSIGN);
   block2->next->expr1 = gfc_lval_expr_from_sym (ptr);
   block2->next->expr2 = gfc_lval_expr_from_sym (ptr2);
 }
@@ -1695,27 +1652,21 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
 
 
   /* Set return value to 0.  */
-  last_code = XCNEW (gfc_code);
-  last_code->op = EXEC_ASSIGN;
-  last_code->loc = gfc_current_locus;
+  last_code = gfc_get_code (EXEC_ASSIGN);
   last_code->expr1 = gfc_lval_expr_from_sym (final);
   last_code->expr2 = gfc_get_int_expr (4, NULL, 0);
   sub_ns->code = last_code;
 
   /* 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->op = EXEC_ASSIGN;
-  last_code->loc = gfc_current_locus;
   last_code->expr1 = gfc_lval_expr_from_sym (is_contiguous);
   last_code->expr2 = gfc_get_logical_expr (gfc_default_logical_kind,
                                           &gfc_current_locus, true);
 
   /* 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->op = EXEC_ASSIGN;
-  last_code->loc = gfc_current_locus;
   last_code->expr1 = gfc_lval_expr_from_sym (sizes);
   last_code->expr1->ref = gfc_get_ref ();
   last_code->expr1->ref->type = REF_ARRAY;
@@ -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->end = gfc_copy_expr (rank);
   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->op = EXEC_DO;
-  last_code->loc = gfc_current_locus;
   last_code->ext.iterator = iter;
-  last_code->block = gfc_get_code ();
-  last_code->block->op = EXEC_DO;
+  last_code->block = gfc_get_code (EXEC_DO);
 
   /* 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->op = EXEC_ASSIGN;
-  block->loc = gfc_current_locus;
 
   block->expr1 = gfc_lval_expr_from_sym (strides);
   block->expr1->ref = gfc_get_ref ();
@@ -1769,10 +1715,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
                                           gfc_lval_expr_from_sym (idx));
 
   /* 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->op = EXEC_ASSIGN;
-  block->loc = gfc_current_locus;
 
   /* sizes(idx) = ... */
   block->expr1 = gfc_lval_expr_from_sym (sizes);
@@ -1819,15 +1763,11 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   block->expr2->ts = idx->ts;
 
   /* 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->loc = gfc_current_locus;
-  block->op = EXEC_IF;
 
-  block->block = XCNEW (gfc_code);
+  block->block = gfc_get_code (EXEC_IF);
   block = block->block;
-  block->loc = gfc_current_locus;
-  block->op = EXEC_IF;
 
   /* if condition: strides(idx) /= sizes(idx-1).  */
   block->expr1 = gfc_get_expr ();
@@ -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;
 
   /* if body: is_contiguous = .false.  */
-  block->next = XCNEW (gfc_code);
+  block->next = gfc_get_code (EXEC_ASSIGN);
   block = block->next;
-  block->op = EXEC_ASSIGN;
-  block->loc = gfc_current_locus;
   block->expr1 = gfc_lval_expr_from_sym (is_contiguous);
   block->expr2 = gfc_get_logical_expr (gfc_default_logical_kind,
                                       &gfc_current_locus, false);
@@ -1883,10 +1821,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   gfc_commit_symbol (nelem);
 
   /* 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->op = EXEC_ASSIGN;
-  last_code->loc = gfc_current_locus;
 
   last_code->expr1 = gfc_lval_expr_from_sym (nelem);
 
@@ -1938,10 +1874,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
       gfc_commit_symbol (ptr);
 
       /* 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->op = EXEC_SELECT;
-      last_code->loc = gfc_current_locus;
       last_code->expr1 = gfc_copy_expr (rank);
       block = NULL;
 
@@ -1956,16 +1890,14 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
          /* CASE (fini_rank).  */
          if (block)
            {
-             block->block = XCNEW (gfc_code);
+             block->block = gfc_get_code (EXEC_SELECT);
              block = block->block;
            }
          else
            {
-             block = XCNEW (gfc_code);
+             block = gfc_get_code (EXEC_SELECT);
              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->where = gfc_current_locus;
          if (fini->proc_tree->n.sym->formal->sym->attr.dimension)
@@ -1986,9 +1918,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
                                          rank, sub_ns);
          else
            {
-             block->next = XCNEW (gfc_code);
-             block->next->op = EXEC_CALL;
-             block->next->loc = gfc_current_locus;
+             block->next = gfc_get_code (EXEC_CALL);
              block->next->symtree = fini->proc_tree;
              block->next->resolved_sym = fini->proc_tree->n.sym;
              block->next->ext.actual = gfc_get_actual_arglist ();
@@ -2002,16 +1932,14 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
          /* CASE DEFAULT.  */
          if (block)
            {
-             block->block = XCNEW (gfc_code);
+             block->block = gfc_get_code (EXEC_SELECT);
              block = block->block;
            }
          else
            {
-             block = XCNEW (gfc_code);
+             block = gfc_get_code (EXEC_SELECT);
              last_code->block = block;
            }
-         block->loc = gfc_current_locus;
-         block->op = EXEC_SELECT;
          block->ext.block.case_list = gfc_get_case ();
 
          /* Create loop.  */
@@ -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->end = gfc_lval_expr_from_sym (nelem);
          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->op = EXEC_DO;
-         block->loc = gfc_current_locus;
          block->ext.iterator = iter;
-         block->block = gfc_get_code ();
-         block->block->op = EXEC_DO;
+         block->block = gfc_get_code (EXEC_DO);
 
          /* Offset calculation.  */
          block = finalization_get_offset (idx, idx2, offset, strides, sizes,
@@ -2043,10 +1968,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
          block = block->next;
 
          /* CALL final_elemental (array).  */
-         block->next = XCNEW (gfc_code);
+         block->next = gfc_get_code (EXEC_CALL);
          block = block->next;
-         block->op = EXEC_CALL;
-         block->loc = gfc_current_locus;
          block->symtree = fini_elem->proc_tree;
          block->resolved_sym = fini_elem->proc_sym;
          block->ext.actual = gfc_get_actual_arglist ();
@@ -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->end = gfc_lval_expr_from_sym (nelem);
       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->op = EXEC_DO;
-      last_code->loc = gfc_current_locus;
       last_code->ext.iterator = iter;
-      last_code->block = gfc_get_code ();
-      last_code->block->op = EXEC_DO;
+      last_code->block = gfc_get_code (EXEC_DO);
 
       /* Offset calculation.  */
       block = finalization_get_offset (idx, idx2, offset, strides, sizes,
@@ -2126,10 +2046,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   /* Call the finalizer of the ancestor.  */
   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->op = EXEC_CALL;
-      last_code->loc = gfc_current_locus;
       last_code->symtree = ancestor_wrapper->symtree;
       last_code->resolved_sym = ancestor_wrapper->symtree->n.sym;
 
@@ -2375,8 +2293,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                  copy->formal->next = gfc_get_formal_arglist ();
                  copy->formal->next->sym = dst;
                  /* Set up code.  */
-                 sub_ns->code = gfc_get_code ();
-                 sub_ns->code->op = EXEC_INIT_ASSIGN;
+                 sub_ns->code = gfc_get_code (EXEC_INIT_ASSIGN);
                  sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
                  sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
                  /* Set initializer.  */
@@ -2659,8 +2576,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
              copy->formal->next = gfc_get_formal_arglist ();
              copy->formal->next->sym = dst;
              /* Set up code.  */
-             sub_ns->code = gfc_get_code ();
-             sub_ns->code->op = EXEC_INIT_ASSIGN;
+             sub_ns->code = gfc_get_code (EXEC_INIT_ASSIGN);
              sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
              sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
            got_char_copy:

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index af7b5b99f9ba838568114a321e7e56dea24fe4c5..5c617cad4f29cd28075af2f237cd9e3f1d073209 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2820,7 +2820,7 @@ bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
 extern gfc_code new_st;
 
 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 *);
 void gfc_free_statement (gfc_code *);
 void gfc_free_statements (gfc_code *);

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 678bc5d844e78e4045620b09a5ff5f9da7bd43bb..cc5ce12781ea79a79b331575bd114110a72b8efa 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -3055,12 +3055,10 @@ match_io_iterator (io_kind k, gfc_code **result)
   if (gfc_match_char (')') != MATCH_YES)
     goto syntax;
 
-  new_code = gfc_get_code ();
-  new_code->op = EXEC_DO;
+  new_code = gfc_get_code (EXEC_DO);
   new_code->ext.iterator = iter;
 
-  new_code->block = gfc_get_code ();
-  new_code->block->op = EXEC_DO;
+  new_code->block = gfc_get_code (EXEC_DO);
   new_code->block->next = head;
 
   *result = new_code;
@@ -3117,8 +3115,7 @@ match_io_element (io_kind k, gfc_code **cpp)
       return MATCH_ERROR;
     }
 
-  cp = gfc_get_code ();
-  cp->op = EXEC_TRANSFER;
+  cp = gfc_get_code (EXEC_TRANSFER);
   cp->expr1 = expr;
   if (k != M_INQUIRE)
     cp->ext.dt = current_dt;
@@ -3180,8 +3177,7 @@ terminate_io (gfc_code *io_code)
   if (io_code == NULL)
     io_code = new_st.block;
 
-  c = gfc_get_code ();
-  c->op = EXEC_DT_END;
+  c = gfc_get_code (EXEC_DT_END);
 
   /* Point to structure that is already there */
   c->ext.dt = new_st.ext.dt;
@@ -3751,8 +3747,7 @@ get_io_list:
 
   new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE;
   new_st.ext.dt = dt;
-  new_st.block = gfc_get_code ();
-  new_st.block->op = new_st.op;
+  new_st.block = gfc_get_code (new_st.op);
   new_st.block->next = io_code;
 
   terminate_io (io_code);
@@ -3961,8 +3956,7 @@ gfc_match_inquire (void)
       if (gfc_implicit_pure (NULL))
        gfc_current_ns->proc_name->attr.implicit_pure = 0;
 
-      new_st.block = gfc_get_code ();
-      new_st.block->op = EXEC_IOLENGTH;
+      new_st.block = gfc_get_code (EXEC_IOLENGTH);
       terminate_io (code);
       new_st.block->next = code;
       return MATCH_YES;

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 29ac77e9cdae14a56500b553ab05773dae8dfbf2..213a5a2effbcd1ba747ae1ed2315fee13c9dc528 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1608,13 +1608,12 @@ got_match:
      is in new_st.  Rearrange things so that the IF statement appears
      in new_st.  */
 
-  p = gfc_get_code ();
-  p->next = gfc_get_code ();
+  p = gfc_get_code (EXEC_IF);
+  p->next = XCNEW (gfc_code);
   *p->next = new_st;
   p->next->loc = gfc_current_locus;
 
   p->expr1 = expr;
-  p->op = EXEC_IF;
 
   gfc_clear_new_st ();
 
@@ -2224,7 +2223,7 @@ match_simple_forall (void)
        goto syntax;
     }
 
-  c = gfc_get_code ();
+  c = XCNEW (gfc_code);
   *c = new_st;
   c->loc = gfc_current_locus;
 
@@ -2235,9 +2234,7 @@ match_simple_forall (void)
   new_st.op = EXEC_FORALL;
   new_st.expr1 = mask;
   new_st.ext.forall_iterator = head;
-  new_st.block = gfc_get_code ();
-
-  new_st.block->op = EXEC_FORALL;
+  new_st.block = gfc_get_code (EXEC_FORALL);
   new_st.block->next = c;
 
   return MATCH_YES;
@@ -2302,7 +2299,7 @@ gfc_match_forall (gfc_statement *st)
        goto syntax;
     }
 
-  c = gfc_get_code ();
+  c = XCNEW (gfc_code);
   *c = new_st;
   c->loc = gfc_current_locus;
 
@@ -2310,8 +2307,7 @@ gfc_match_forall (gfc_statement *st)
   new_st.op = EXEC_FORALL;
   new_st.expr1 = mask;
   new_st.ext.forall_iterator = head;
-  new_st.block = gfc_get_code ();
-  new_st.block->op = EXEC_FORALL;
+  new_st.block = gfc_get_code (EXEC_FORALL);
   new_st.block->next = c;
 
   *st = ST_FORALL;
@@ -3283,15 +3279,14 @@ gfc_match_goto (void)
            goto cleanup;
 
          if (head == NULL)
-           head = tail = gfc_get_code ();
+           head = tail = gfc_get_code (EXEC_GOTO);
          else
            {
-             tail->block = gfc_get_code ();
+             tail->block = gfc_get_code (EXEC_GOTO);
              tail = tail->block;
            }
 
          tail->label1 = label;
-         tail->op = EXEC_GOTO;
        }
       while (gfc_match_char (',') == MATCH_YES);
 
@@ -3328,10 +3323,10 @@ gfc_match_goto (void)
        goto cleanup;
 
       if (head == NULL)
-       head = tail = gfc_get_code ();
+       head = tail = gfc_get_code (EXEC_SELECT);
       else
        {
-         tail->block = gfc_get_code ();
+         tail->block = gfc_get_code (EXEC_SELECT);
          tail = tail->block;
        }
 
@@ -3339,11 +3334,9 @@ gfc_match_goto (void)
       cp->low = cp->high = gfc_get_int_expr (gfc_default_integer_kind,
                                             NULL, i++);
 
-      tail->op = EXEC_SELECT;
       tail->ext.block.case_list = cp;
 
-      tail->next = gfc_get_code ();
-      tail->next->op = EXEC_GOTO;
+      tail->next = gfc_get_code (EXEC_GOTO);
       tail->next->label1 = label;
     }
   while (gfc_match_char (',') == MATCH_YES);
@@ -3800,14 +3793,16 @@ gfc_match_nullify (void)
 
       /* Chain to list.  */
       if (tail == NULL)
-       tail = &new_st;
+       {
+         tail = &new_st;
+         tail->op = EXEC_POINTER_ASSIGN;
+       }
       else
        {
-         tail->next = gfc_get_code ();
+         tail->next = gfc_get_code (EXEC_POINTER_ASSIGN);
          tail = tail->next;
        }
 
-      tail->op = EXEC_POINTER_ASSIGN;
       tail->expr1 = p;
       tail->expr2 = e;
 
@@ -4199,8 +4194,7 @@ gfc_match_call (void)
       gfc_symbol *select_sym;
       char name[GFC_MAX_SYMBOL_LEN + 1];
 
-      new_st.next = c = gfc_get_code ();
-      c->op = EXEC_SELECT;
+      new_st.next = c = gfc_get_code (EXEC_SELECT);
       sprintf (name, "_result_%s", sym->name);
       gfc_get_ha_sym_tree (name, &select_st);   /* Can't fail.  */
 
@@ -4225,17 +4219,15 @@ gfc_match_call (void)
 
          i++;
 
-         c->block = gfc_get_code ();
+         c->block = gfc_get_code (EXEC_SELECT);
          c = c->block;
-         c->op = EXEC_SELECT;
 
          new_case = gfc_get_case ();
          new_case->high = gfc_get_int_expr (gfc_default_integer_kind, NULL, i);
          new_case->low = new_case->high;
          c->ext.block.case_list = new_case;
 
-         c->next = gfc_get_code ();
-         c->next->op = EXEC_GOTO;
+         c->next = gfc_get_code (EXEC_GOTO);
          c->next->label1 = a->label;
        }
     }
@@ -5639,12 +5631,10 @@ match_simple_where (void)
   if (gfc_match_eos () != MATCH_YES)
     goto syntax;
 
-  c = gfc_get_code ();
-
-  c->op = EXEC_WHERE;
+  c = gfc_get_code (EXEC_WHERE);
   c->expr1 = expr;
-  c->next = gfc_get_code ();
 
+  c->next = XCNEW (gfc_code);
   *c->next = new_st;
   gfc_clear_new_st ();
 
@@ -5699,12 +5689,10 @@ gfc_match_where (gfc_statement *st)
 
   /* We've got a simple WHERE statement.  */
   *st = ST_WHERE;
-  c = gfc_get_code ();
-
-  c->op = EXEC_WHERE;
+  c = gfc_get_code (EXEC_WHERE);
   c->expr1 = expr;
-  c->next = gfc_get_code ();
 
+  c->next = XCNEW (gfc_code);
   *c->next = new_st;
   gfc_clear_new_st ();
 

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 737f3d61889fd9f0d31239e12bf29c9e0055f40f..512babfd45041df20ccb74aa86938743f330aac9 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1095,7 +1095,7 @@ new_level (gfc_code *q)
 {
   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;
 
@@ -1111,7 +1111,7 @@ add_statement (void)
 {
   gfc_code *p;
 
-  p = gfc_get_code ();
+  p = XCNEW (gfc_code);
   *p = new_st;
 
   p->loc = gfc_current_locus;

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 90b7c0aebd813cf6695f6ab0b8053de994ff38d3..837bf1512bfd167b53d0955e6f17929f118efd5a 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -723,8 +723,7 @@ resolve_entries (gfc_namespace *ns)
   el = ns->entries;
 
   /* Add an entry statement for it.  */
-  c = gfc_get_code ();
-  c->op = EXEC_ENTRY;
+  c = gfc_get_code (EXEC_ENTRY);
   c->ext.entry = el;
   c->next = ns->code;
   ns->code = c;
@@ -6880,9 +6879,8 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 
       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->op = EXEC_INIT_ASSIGN;
          init_st->expr1 = gfc_expr_to_initialize (e);
          init_st->expr2 = init_e;
          init_st->next = code->next;
@@ -8020,8 +8018,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
     code->ext.block.assoc = NULL;
 
   /* Add EXEC_SELECT to switch on type.  */
-  new_st = gfc_get_code ();
-  new_st->op = code->op;
+  new_st = gfc_get_code (code->op);
   new_st->expr1 = code->expr1;
   new_st->expr2 = code->expr2;
   new_st->block = code->block;
@@ -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)
        gfc_add_data_component (st->n.sym->assoc->target);
 
-      new_st = gfc_get_code ();
-      new_st->op = EXEC_BLOCK;
+      new_st = gfc_get_code (EXEC_BLOCK);
       new_st->ext.block.ns = gfc_build_block_ns (ns);
       new_st->ext.block.ns->code = body->next;
       body->next = new_st;
@@ -8139,9 +8135,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
        {
          /* Add a default case to hold the CLASS IS cases.  */
          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->op = EXEC_SELECT_TYPE;
          tail->ext.block.case_list = gfc_get_case ();
          tail->ext.block.case_list->ts.type = BT_UNKNOWN;
          tail->next = NULL;
@@ -8184,14 +8179,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
        }
 
       /* Generate IF chain.  */
-      if_st = gfc_get_code ();
-      if_st->op = EXEC_IF;
+      if_st = gfc_get_code (EXEC_IF);
       new_st = if_st;
       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->op = EXEC_IF;
          /* Set up IF condition: Call _gfortran_is_extension_of.  */
          new_st->expr1 = gfc_get_expr ();
          new_st->expr1->expr_type = EXPR_FUNCTION;
@@ -8213,9 +8206,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
        }
        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->op = EXEC_IF;
            new_st->next = default_case->next;
          }
 
@@ -9241,8 +9233,7 @@ build_assignment (gfc_exec_op op, gfc_expr *expr1, gfc_expr *expr2,
 {
   gfc_code *this_code;
 
-  this_code = gfc_get_code ();
-  this_code->op = op;
+  this_code = gfc_get_code (op);
   this_code->next = NULL;
   this_code->expr1 = gfc_copy_expr (expr1);
   this_code->expr2 = gfc_copy_expr (expr2);
@@ -10281,13 +10272,12 @@ build_init_assign (gfc_symbol *sym, gfc_expr *init)
   lval = gfc_lval_expr_from_sym (sym);
 
   /* Add the code at scope entry.  */
-  init_st = gfc_get_code ();
+  init_st = gfc_get_code (EXEC_INIT_ASSIGN);
   init_st->next = ns->code;
   ns->code = init_st;
 
   /* Assign the default initializer to the l-value.  */
   init_st->loc = sym->declared_at;
-  init_st->op = EXEC_INIT_ASSIGN;
   init_st->expr1 = lval;
   init_st->expr2 = init;
 }

diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 836dac790a27637b98d58fb4f16637b4f852ab84..f8b341c0b6c0f593c097c315dc48af1a2dbc662d 100644 (file)
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -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_get_code (void)
+gfc_get_code (gfc_exec_op op)
 {
   gfc_code *c;
 
   c = XCNEW (gfc_code);
+  c->op = op;
   c->loc = gfc_current_locus;
   return c;
 }

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 0801eee8b284945b7fc7b58e8f0a1757938a7b98..dd4c8fc62c1fa83d397d64becebb35411ae91f1f 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -895,14 +895,13 @@ gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj)
   ppc = gfc_copy_expr (obj);
   gfc_add_vptr_component (ppc);
   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;
   /* Although '_copy' is set to be elemental in class.c, it is
      not staying that way.  Find out why, sometime....  */
   ppc_code->resolved_sym->attr.elemental = 1;
   ppc_code->ext.actual = actual;
   ppc_code->expr1 = ppc;
-  ppc_code->op = EXEC_CALL;
   /* Since '_copy' is elemental, the scalarizer will take care
      of arrays in gfc_trans_call.  */
   res = gfc_trans_call (ppc_code, false, NULL, NULL, false);

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index e2d0110ba96ed398cfa8ba1b2246f947baae5e65..edd2dacf579f0e7630ff4300c903128f68fc52ca 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5232,14 +5232,13 @@ gfc_trans_allocate (gfc_code * code)
                                (gfc_find_intrinsic_vtab (&rhs->ts));
              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;
              /* Although '_copy' is set to be elemental in class.c, it is
                 not staying that way.  Find out why, sometime....  */
              ppc_code->resolved_sym->attr.elemental = 1;
              ppc_code->ext.actual = actual;
              ppc_code->expr1 = ppc;
-             ppc_code->op = EXEC_CALL;
              /* Since '_copy' is elemental, the scalarizer will take care
                 of arrays in gfc_trans_call.  */
              tmp = gfc_trans_call (ppc_code, true, NULL, NULL, false);