From 38adfa471c5125c67cf712e91f01635f22d547cf Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:04:27 +0000 Subject: [PATCH] * trans-expr.c (gfc_conv_procedure_call): Handle temporaries for arguments to elemental calls. * trans-stmt.c (replace_ss): New function. (gfc_conv_elemental_dependencies): Remove temporary loop handling. Create a new ss for the temporary and replace the original one with it. Remove fake array references. Recalculate all offsets. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180906 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 ++++ gcc/fortran/trans-expr.c | 13 +++++- gcc/fortran/trans-stmt.c | 112 +++++++++++++++++++---------------------------- 3 files changed, 67 insertions(+), 67 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9a8fee0..0cebe5f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,14 @@ 2011-11-04 Mikael Morin + * trans-expr.c (gfc_conv_procedure_call): Handle temporaries for + arguments to elemental calls. + * trans-stmt.c (replace_ss): New function. + (gfc_conv_elemental_dependencies): Remove temporary loop handling. + Create a new ss for the temporary and replace the original one with it. + Remove fake array references. Recalculate all offsets. + +2011-11-04 Mikael Morin + * trans-array.h (gfc_free_ss, gfc_set_delta): New prototypes. * trans-array.c (gfc_free_ss): Remove forward declaration. Make non-static. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 4cfdc3e..cf9f0f7 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2997,8 +2997,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { /* An elemental function inside a scalarized loop. */ gfc_init_se (&parmse, se); - gfc_conv_expr_reference (&parmse, e); parm_kind = ELEMENTAL; + + if (se->ss->dimen > 0 + && se->ss->info->data.array.ref == NULL) + { + gfc_conv_tmp_array_ref (&parmse); + if (e->ts.type == BT_CHARACTER) + gfc_conv_string_parameter (&parmse); + else + parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr); + } + else + gfc_conv_expr_reference (&parmse, e); } else { diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 2e02320..0d793f9 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -178,6 +178,41 @@ gfc_trans_entry (gfc_code * code) } +/* Replace a gfc_ss structure by another both in the gfc_se struct + and the gfc_loopinfo struct. This is used in gfc_conv_elemental_dependencies + to replace a variable ss by the corresponding temporary. */ + +static void +replace_ss (gfc_se *se, gfc_ss *old_ss, gfc_ss *new_ss) +{ + gfc_ss **sess, **loopss; + + /* The old_ss is a ss for a single variable. */ + gcc_assert (old_ss->info->type == GFC_SS_SECTION); + + for (sess = &(se->ss); *sess != gfc_ss_terminator; sess = &((*sess)->next)) + if (*sess == old_ss) + break; + gcc_assert (*sess != gfc_ss_terminator); + + *sess = new_ss; + new_ss->next = old_ss->next; + + + for (loopss = &(se->loop->ss); *loopss != gfc_ss_terminator; + loopss = &((*loopss)->loop_chain)) + if (*loopss == old_ss) + break; + gcc_assert (*loopss != gfc_ss_terminator); + + *loopss = new_ss; + new_ss->loop_chain = old_ss->loop_chain; + new_ss->loop = old_ss->loop; + + gfc_free_ss (old_ss); +} + + /* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of elemental subroutines. Make temporaries for output arguments if any such dependencies are found. Output arguments are chosen because internal_unpack @@ -190,15 +225,10 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, gfc_actual_arglist *arg0; gfc_expr *e; gfc_formal_arglist *formal; - gfc_loopinfo tmp_loop; gfc_se parmse; gfc_ss *ss; - gfc_array_info *info; gfc_symbol *fsym; - gfc_ref *ref; - int n; tree data; - tree offset; tree size; tree tmp; @@ -217,14 +247,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, continue; /* Obtain the info structure for the current argument. */ - info = NULL; for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next) - { - if (ss->info->expr != e) - continue; - info = &ss->info->data.array; + if (ss->info->expr == e) break; - } /* If there is a dependency, create a temporary and use it instead of the variable. */ @@ -237,49 +262,17 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, { tree initial, temptype; stmtblock_t temp_post; + gfc_ss *tmp_ss; - /* Make a local loopinfo for the temporary creation, so that - none of the other ss->info's have to be renormalized. */ - gfc_init_loopinfo (&tmp_loop); - tmp_loop.dimen = ss->dimen; - for (n = 0; n < ss->dimen; n++) - { - tmp_loop.to[n] = loopse->loop->to[n]; - tmp_loop.from[n] = loopse->loop->from[n]; - tmp_loop.order[n] = loopse->loop->order[n]; - } + tmp_ss = gfc_get_array_ss (gfc_ss_terminator, NULL, ss->dimen, + GFC_SS_SECTION); + gfc_mark_ss_chain_used (tmp_ss, 1); + tmp_ss->info->expr = ss->info->expr; + replace_ss (loopse, ss, tmp_ss); /* Obtain the argument descriptor for unpacking. */ gfc_init_se (&parmse, NULL); parmse.want_pointer = 1; - - /* The scalarizer introduces some specific peculiarities when - handling elemental subroutines; the stride can be needed up to - the dim_array - 1, rather than dim_loop - 1 to calculate - offsets outside the loop. For this reason, we make sure that - the descriptor has the dimensionality of the array by converting - trailing elements into ranges with end = start. */ - for (ref = e->ref; ref; ref = ref->next) - if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION) - break; - - if (ref) - { - bool seen_range = false; - for (n = 0; n < ref->u.ar.dimen; n++) - { - if (ref->u.ar.dimen_type[n] == DIMEN_RANGE) - seen_range = true; - - if (!seen_range - || ref->u.ar.dimen_type[n] != DIMEN_ELEMENT) - continue; - - ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]); - ref->u.ar.dimen_type[n] = DIMEN_RANGE; - } - } - gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e)); gfc_add_block_to_block (&se->pre, &parmse.pre); @@ -309,28 +302,15 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, size = gfc_create_var (gfc_array_index_type, NULL); data = gfc_create_var (pvoid_type_node, NULL); gfc_init_block (&temp_post); - ss->loop = &tmp_loop; - tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss, + tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss, temptype, initial, false, true, false, &arg->expr->where); gfc_add_modify (&se->pre, size, tmp); - tmp = fold_convert (pvoid_type_node, info->data); + tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data); gfc_add_modify (&se->pre, data, tmp); - /* Calculate the offset for the temporary. */ - offset = gfc_index_zero_node; - for (n = 0; n < ss->dimen; n++) - { - tmp = gfc_conv_descriptor_stride_get (info->descriptor, - gfc_rank_cst[n]); - tmp = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, - loopse->loop->from[n], tmp); - offset = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, offset, tmp); - } - info->offset = gfc_create_var (gfc_array_index_type, NULL); - gfc_add_modify (&se->pre, info->offset, offset); + /* Update other ss' delta. */ + gfc_set_delta (loopse->loop); /* Copy the result back using unpack. */ tmp = build_call_expr_loc (input_location, -- 2.7.4