From 11e5274a4bb2ae1338c8b447c9880ace43aac129 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Fri, 9 Aug 2013 21:26:07 +0200 Subject: [PATCH] gfortran.h (gfc_get_code): Modified prototype. 2013-08-09 Janus Weil * 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 --- gcc/fortran/ChangeLog | 22 +++++ gcc/fortran/class.c | 182 +++++++++++---------------------------- gcc/fortran/gfortran.h | 2 +- gcc/fortran/io.c | 18 ++-- gcc/fortran/match.c | 58 +++++-------- gcc/fortran/parse.c | 4 +- gcc/fortran/resolve.c | 30 +++---- gcc/fortran/st.c | 6 +- gcc/fortran/trans-expr.c | 3 +- gcc/fortran/trans-stmt.c | 3 +- 10 files changed, 119 insertions(+), 209 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8aa70a3adbe..c1adb88d1bc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2013-08-09 Janus Weil + + * 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 PR fortran/58058 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index fb16682e51c..629b052fb32 100644 --- 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 = block->next; /* BLOCK ... END BLOCK. */ - block->op = EXEC_BLOCK; - block->loc = gfc_current_locus; + block->next = gfc_get_code (EXEC_BLOCK); + block = block->next; + 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 af7b5b99f9b..5c617cad4f2 100644 --- 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 678bc5d844e..cc5ce12781e 100644 --- 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 29ac77e9cda..213a5a2effb 100644 --- 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 737f3d61889..512babfd450 100644 --- 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 90b7c0aebd8..837bf1512bf 100644 --- 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 836dac790a2..f8b341c0b6c 100644 --- 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 0801eee8b28..dd4c8fc62c1 100644 --- 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 e2d0110ba96..edd2dacf579 100644 --- 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);