diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2025-01-22 22:44:39 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2025-01-23 19:09:39 +0100 |
| commit | 3cef53a4d4ff44a5b61284bb0e6977f7ba7b3aab (patch) | |
| tree | e6d89cce80946b3c6f6fac0f7a2a85ad7bef0f80 /gcc/fortran/trans-intrinsic.cc | |
| parent | 0bb3223097e5ced4f9a13d18c6c65f2a9496437e (diff) | |
| download | gcc-3cef53a4d4ff44a5b61284bb0e6977f7ba7b3aab.zip gcc-3cef53a4d4ff44a5b61284bb0e6977f7ba7b3aab.tar.gz gcc-3cef53a4d4ff44a5b61284bb0e6977f7ba7b3aab.tar.bz2 | |
Fortran: do not evaluate arguments of MAXVAL/MINVAL too often [PR118613]
PR fortran/118613
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxval): Adjust algorithm
for inlined version of MINLOC and MAXLOC so that arguments are only
evaluted once, and create temporaries where necessary. Document
change of algorithm.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxval_arg_eval_count.f90: New test.
Diffstat (limited to 'gcc/fortran/trans-intrinsic.cc')
| -rw-r--r-- | gcc/fortran/trans-intrinsic.cc | 37 |
1 files changed, 33 insertions, 4 deletions
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index afbec5b..51237d0 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -6409,8 +6409,16 @@ gfc_conv_intrinsic_findloc (gfc_se *se, gfc_expr *expr) nonempty = false; S = from; while (S <= to) { - if (mask[S]) { nonempty = true; if (a[S] <= limit) goto lab; } - S++; + if (mask[S]) { + nonempty = true; + if (a[S] <= limit) { + limit = a[S]; + S++; + goto lab; + } + else + S++; + } } limit = nonempty ? NaN : huge (limit); lab: @@ -6419,7 +6427,15 @@ gfc_conv_intrinsic_findloc (gfc_se *se, gfc_expr *expr) at runtime whether array is nonempty or not, rank 1: limit = Infinity; S = from; - while (S <= to) { if (a[S] <= limit) goto lab; S++; } + while (S <= to) { + if (a[S] <= limit) { + limit = a[S]; + S++; + goto lab; + } + else + S++; + } limit = (from <= to) ? NaN : huge (limit); lab: while (S <= to) { limit = min (a[S], limit); S++; } @@ -6710,6 +6726,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_copy_loopinfo_to_se (&arrayse, &loop); arrayse.ss = arrayss; gfc_conv_expr_val (&arrayse, arrayexpr); + arrayse.expr = gfc_evaluate_now (arrayse.expr, &arrayse.pre); gfc_add_block_to_block (&block, &arrayse.pre); gfc_init_block (&block2); @@ -6722,7 +6739,18 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) tmp = fold_build2_loc (input_location, op == GT_EXPR ? GE_EXPR : LE_EXPR, logical_type_node, arrayse.expr, limit); if (lab) - ifbody = build1_v (GOTO_EXPR, lab); + { + stmtblock_t ifblock; + tree inc_loop; + inc_loop = fold_build2_loc (input_location, PLUS_EXPR, + TREE_TYPE (loop.loopvar[0]), + loop.loopvar[0], gfc_index_one_node); + gfc_init_block (&ifblock); + gfc_add_modify (&ifblock, limit, arrayse.expr); + gfc_add_modify (&ifblock, loop.loopvar[0], inc_loop); + gfc_add_expr_to_block (&ifblock, build1_v (GOTO_EXPR, lab)); + ifbody = gfc_finish_block (&ifblock); + } else { stmtblock_t ifblock; @@ -6816,6 +6844,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_copy_loopinfo_to_se (&arrayse, &loop); arrayse.ss = arrayss; gfc_conv_expr_val (&arrayse, arrayexpr); + arrayse.expr = gfc_evaluate_now (arrayse.expr, &arrayse.pre); gfc_add_block_to_block (&block, &arrayse.pre); /* MIN_EXPR/MAX_EXPR has unspecified behavior with NaNs or |