diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a17f431..fb9cbc4 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2427,6 +2427,41 @@ set_vector_loop_bounds (gfc_ss * ss) } +/* Tells whether a scalar argument to an elemental procedure is saved out + of a scalarization loop as a value or as a reference. */ + +bool +gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info) +{ + if (ss_info->type != GFC_SS_REFERENCE) + return false; + + /* If the actual argument can be absent (in other words, it can + be a NULL reference), don't try to evaluate it; pass instead + the reference directly. */ + if (ss_info->can_be_null_ref) + return true; + + /* If the expression is of polymorphic type, it's actual size is not known, + so we avoid copying it anywhere. */ + if (ss_info->data.scalar.dummy_arg + && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS + && ss_info->expr->ts.type == BT_CLASS) + return true; + + /* If the expression is a data reference of aggregate type, + avoid a copy by saving a reference to the content. */ + if (ss_info->expr->expr_type == EXPR_VARIABLE + && (ss_info->expr->ts.type == BT_DERIVED + || ss_info->expr->ts.type == BT_CLASS)) + return true; + + /* Otherwise the expression is evaluated to a temporary variable before the + scalarization loop. */ + return false; +} + + /* Add the pre and post chains for all the scalar expressions in a SS chain to loop. This is called after the loop parameters have been calculated, but before the actual scalarizing loops. */ @@ -2495,19 +2530,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, case GFC_SS_REFERENCE: /* Scalar argument to elemental procedure. */ gfc_init_se (&se, NULL); - if (ss_info->can_be_null_ref || (expr->symtree - && (expr->symtree->n.sym->ts.type == BT_DERIVED - || expr->symtree->n.sym->ts.type == BT_CLASS))) - { - /* If the actual argument can be absent (in other words, it can - be a NULL reference), don't try to evaluate it; pass instead - the reference directly. The reference is also needed when - expr is of type class or derived. */ - gfc_conv_expr_reference (&se, expr); - } + if (gfc_scalar_elemental_arg_saved_as_reference (ss_info)) + gfc_conv_expr_reference (&se, expr); else { - /* Otherwise, evaluate the argument outside the loop and pass + /* Evaluate the argument outside the loop and pass a reference to the value. */ gfc_conv_expr (&se, expr); } @@ -9101,7 +9128,8 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE); newss = gfc_get_scalar_ss (head, arg->expr); newss->info->type = type; - + if (dummy_arg) + newss->info->data.scalar.dummy_arg = dummy_arg->sym; } else scalar = 0; diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 76bad2a..ad9a292 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -105,6 +105,8 @@ gfc_ss *gfc_get_temp_ss (tree, tree, int); /* Allocate a new scalar type ss. */ gfc_ss *gfc_get_scalar_ss (gfc_ss *, gfc_expr *); +bool gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info *); + /* 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 9c5ce7d..c71037f 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4735,19 +4735,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_init_se (&parmse, se); parm_kind = ELEMENTAL; - /* For all value functions or polymorphic scalar non-pointer - non-allocatable variables use the expression in e directly. This - ensures, that initializers of polymorphic entities are correctly - copied. */ - if (fsym && (fsym->attr.value - || (e->expr_type == EXPR_VARIABLE - && fsym->ts.type == BT_DERIVED - && e->ts.type == BT_DERIVED - && !e->ts.u.derived->attr.dimension - && !e->rank - && (!e->symtree - || (!e->symtree->n.sym->attr.allocatable - && !e->symtree->n.sym->attr.pointer))))) + if (fsym && fsym->attr.value) gfc_conv_expr (&parmse, e); else gfc_conv_expr_reference (&parmse, e); @@ -7310,11 +7298,9 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) ss_info = ss->info; /* Substitute a scalar expression evaluated outside the scalarization - loop. */ + loop. */ se->expr = ss_info->data.scalar.value; - /* If the reference can be NULL, the value field contains the reference, - not the value the reference points to (see gfc_add_loop_ss_code). */ - if (ss_info->can_be_null_ref) + if (gfc_scalar_elemental_arg_saved_as_reference (ss_info)) se->expr = build_fold_indirect_ref_loc (input_location, se->expr); se->string_length = ss_info->string_length; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index e2a1fea..570b5b8 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -206,6 +206,9 @@ typedef struct gfc_ss_info /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */ struct { + /* If the scalar is passed as actual argument to an (elemental) procedure, + this is the symbol of the corresponding dummy argument. */ + gfc_symbol *dummy_arg; tree value; } scalar;