diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 042d057a393..a4f0276c973 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2011-09-08 Mikael Morin + + * trans-array.h (gfc_get_array_ss): New prototype. + * trans-array.c (gfc_get_array_ss): New function. + (gfc_walk_variable_expr, gfc_walk_function_expr, + gfc_walk_array_constructor): Re-use gfc_get_array_ss. + * trans-expr.c (gfc_trans_subarray_assign): Ditto. + * trans-intrinsic.c (gfc_walk_intrinsic_bound, + gfc_walk_intrinsic_libfunc): Ditto. + * trans-io.c (transfer_array_component): Ditto. + 2011-09-08 Tobias Burnus PR fortran/44646 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 6dc1e17a7d4..107f6296c23 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -511,6 +511,29 @@ gfc_free_ss (gfc_ss * ss) } +/* Creates and initializes an array type gfc_ss struct. */ + +gfc_ss * +gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) +{ + gfc_ss *ss; + gfc_ss_info *info; + int i; + + ss = gfc_get_ss (); + ss->next = next; + ss->type = type; + ss->expr = expr; + info = &ss->data.info; + info->dimen = dimen; + info->codimen = 0; + for (i = 0; i < info->dimen; i++) + info->dim[i] = i; + + return ss; +} + + /* Free all the SS associated with a loop. */ void @@ -7605,12 +7628,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) break; case AR_FULL: - newss = gfc_get_ss (); - newss->type = GFC_SS_SECTION; - newss->expr = expr; - newss->next = ss; - newss->data.info.dimen = ar->as->rank; - newss->data.info.codimen = 0; + newss = gfc_get_array_ss (ss, expr, ar->as->rank, GFC_SS_SECTION); newss->data.info.ref = ref; /* Make sure array is the same as array(:,:), this way @@ -7619,7 +7637,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) ar->codimen = 0; for (n = 0; n < ar->dimen; n++) { - newss->data.info.dim[n] = n; ar->dimen_type[n] = DIMEN_RANGE; gcc_assert (ar->start[n] == NULL); @@ -7638,15 +7655,10 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) break; case AR_SECTION: - newss = gfc_get_ss (); - newss->type = GFC_SS_SECTION; - newss->expr = expr; - newss->next = ss; - newss->data.info.dimen = 0; - newss->data.info.codimen = 0; + newss = gfc_get_array_ss (ss, expr, 0, GFC_SS_SECTION); newss->data.info.ref = ref; - /* We add SS chains for all the subscripts in the section. */ + /* We add SS chains for all the subscripts in the section. */ for (n = 0; n < ar->dimen + ar->codimen; n++) { gfc_ss *indexss; @@ -7678,10 +7690,8 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) case DIMEN_VECTOR: /* Create a GFC_SS_VECTOR index in which we can store the vector's descriptor. */ - indexss = gfc_get_ss (); - indexss->type = GFC_SS_VECTOR; - indexss->expr = ar->start[n]; - indexss->next = gfc_ss_terminator; + indexss = gfc_get_array_ss (gfc_ss_terminator, ar->start[n], + 1, GFC_SS_VECTOR); indexss->loop_chain = gfc_ss_terminator; newss->data.info.subscript[n] = indexss; newss->data.info.dim[newss->data.info.dimen @@ -7852,11 +7862,9 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, static gfc_ss * gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) { - gfc_ss *newss; gfc_intrinsic_sym *isym; gfc_symbol *sym; gfc_component *comp = NULL; - int n; isym = expr->value.function.isym; @@ -7872,16 +7880,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) gfc_is_proc_ptr_comp (expr, &comp); if ((!comp && gfc_return_by_reference (sym) && sym->result->attr.dimension) || (comp && comp->attr.dimension)) - { - newss = gfc_get_ss (); - newss->type = GFC_SS_FUNCTION; - newss->expr = expr; - newss->next = ss; - newss->data.info.dimen = expr->rank; - for (n = 0; n < newss->data.info.dimen; n++) - newss->data.info.dim[n] = n; - return newss; - } + return gfc_get_array_ss (ss, expr, expr->rank, GFC_SS_FUNCTION); /* Walk the parameters of an elemental function. For now we always pass by reference. */ @@ -7900,18 +7899,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) static gfc_ss * gfc_walk_array_constructor (gfc_ss * ss, gfc_expr * expr) { - gfc_ss *newss; - int n; - - newss = gfc_get_ss (); - newss->type = GFC_SS_CONSTRUCTOR; - newss->expr = expr; - newss->next = ss; - newss->data.info.dimen = expr->rank; - for (n = 0; n < expr->rank; n++) - newss->data.info.dim[n] = n; - - return newss; + return gfc_get_array_ss (ss, expr, expr->rank, GFC_SS_CONSTRUCTOR); } diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 61f7042c9c0..26d02ece3d3 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -87,6 +87,8 @@ void gfc_add_ss_to_loop (gfc_loopinfo *, gfc_ss *); void gfc_mark_ss_chain_used (gfc_ss *, unsigned); /* Free a gfc_ss chain. */ void gfc_free_ss_chain (gfc_ss *); +/* Allocate a new array type ss. */ +gfc_ss *gfc_get_array_ss (gfc_ss *, gfc_expr *, int, gfc_ss_type); /* Calculates the lower bound and stride of array sections. */ void gfc_conv_ss_startstride (gfc_loopinfo *); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index ea65c022cf5..04cf4dd45b3 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4367,18 +4367,14 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) } /* Create a SS for the destination. */ - lss = gfc_get_ss (); - lss->type = GFC_SS_COMPONENT; - lss->expr = NULL; + lss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank, + GFC_SS_COMPONENT); lss->shape = gfc_get_shape (cm->as->rank); - lss->next = gfc_ss_terminator; - lss->data.info.dimen = cm->as->rank; lss->data.info.descriptor = dest; lss->data.info.data = gfc_conv_array_data (dest); lss->data.info.offset = gfc_conv_array_offset (dest); for (n = 0; n < cm->as->rank; n++) { - lss->data.info.dim[n] = n; lss->data.info.start[n] = gfc_conv_array_lbound (dest, n); lss->data.info.stride[n] = gfc_index_one_node; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 0c8abc6ca0d..de5a809c81a 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6801,19 +6801,11 @@ gfc_add_intrinsic_ss_code (gfc_loopinfo * loop ATTRIBUTE_UNUSED, gfc_ss * ss) static gfc_ss * gfc_walk_intrinsic_bound (gfc_ss * ss, gfc_expr * expr) { - gfc_ss *newss; - /* The two argument version returns a scalar. */ if (expr->value.function.actual->next->expr) return ss; - newss = gfc_get_ss (); - newss->type = GFC_SS_INTRINSIC; - newss->expr = expr; - newss->next = ss; - newss->data.info.dimen = 1; - - return newss; + return gfc_get_array_ss (ss, expr, 1, GFC_SS_INTRINSIC); } @@ -6822,20 +6814,8 @@ gfc_walk_intrinsic_bound (gfc_ss * ss, gfc_expr * expr) static gfc_ss * gfc_walk_intrinsic_libfunc (gfc_ss * ss, gfc_expr * expr) { - gfc_ss *newss; - int n; - gcc_assert (expr->rank > 0); - - newss = gfc_get_ss (); - newss->type = GFC_SS_FUNCTION; - newss->expr = expr; - newss->next = ss; - newss->data.info.dimen = expr->rank; - for (n = 0; n < newss->data.info.dimen; n++) - newss->data.info.dim[n] = n; - - return newss; + return gfc_get_array_ss (ss, expr, expr->rank, GFC_SS_FUNCTION); } diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 931565d72fe..bbf5a02eff4 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1946,18 +1946,14 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) care of this task, because we don't have a gfc_expr at hand. Build one manually, as in gfc_trans_subarray_assign. */ - ss = gfc_get_ss (); - ss->type = GFC_SS_COMPONENT; - ss->expr = NULL; + ss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank, + GFC_SS_COMPONENT); ss->shape = gfc_get_shape (cm->as->rank); - ss->next = gfc_ss_terminator; - ss->data.info.dimen = cm->as->rank; ss->data.info.descriptor = expr; ss->data.info.data = gfc_conv_array_data (expr); ss->data.info.offset = gfc_conv_array_offset (expr); for (n = 0; n < cm->as->rank; n++) { - ss->data.info.dim[n] = n; ss->data.info.start[n] = gfc_conv_array_lbound (expr, n); ss->data.info.stride[n] = gfc_index_one_node;