This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[gfortran] Use MAX/MIN_EXPR to convert intrinsic min/max
- From: Canqun Yang <canqun at nudt dot edu dot cn>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Fri, 30 Jan 2004 10:21:23 +0800 (HKT)
- Subject: [gfortran] Use MAX/MIN_EXPR to convert intrinsic min/max
- Reply-to: Canqun Yang <canqun at nudt dot edu dot cn>
Hi, all
Use MAX_EXPR or MIN_EXPR to convert the intrinsics
min/max and minval/maxval, compared with former
implementation which use if-then-else constructs, seems
more straightforward, it will avoid the overhead for
GCC backend to do if-conversion.
2004-01-30 Canqun Yang <canqun@nudt.edu.cn>
* trans-intrinsic.c
(gfc_conv_intrinsic_minmax): Use MAX_EXPR
or MIN_EXPR to get the min/max value.
(gfc_conv_intrinsic_minmaxval): Likewise.
Canqun Yang
*** ChangeLog.save 2004-01-30 09:42:18.000000000 +0800
--- ChangeLog 2004-01-30 09:44:03.000000000 +0800
***************
*** 1,3 ****
--- 1,9 ----
+ 2004-01-30 Canqun Yang <canqun@nudt.edu.cn>
+
+ * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Use MAX_EXPR
+ or MIN_EXPR to get the min/max value.
+ (gfc_conv_intrinsic_minmaxval): Likewise.
+
2004-01-17 Paul Brook <paul@codesourcery.com>
* lang-specs.h: Remove %<fixed-form.
*** trans-intrinsic.c.save 2004-01-30 08:44:14.000000000 +0800
--- trans-intrinsic.c 2004-01-30 09:41:58.000000000 +0800
***************
*** 970,1012 ****
/* Get the minimum/maximum value of all the parameters.
minmax (a1, a2, a3, ...)
{
! if (a2 .op. a1)
! mvar = a2;
! else
! mvar = a1;
! if (a3 .op. mvar)
! mvar = a3;
! ...
! return mvar
! }
! */
/* TODO: Mismatching types can occur when specific names are used.
These should be handled during resolution. */
static void
gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
{
! tree limit;
! tree tmp;
! tree mvar;
tree val;
- tree thencase;
- tree elsecase;
tree arg;
tree type;
arg = gfc_conv_intrinsic_function_args (se, expr);
type = gfc_typenode_for_spec (&expr->ts);
! limit = TREE_VALUE (arg);
! if (TREE_TYPE (limit) != type)
! limit = convert (type, limit);
/* Only evaluate the argument once. */
! if (TREE_CODE (limit) != VAR_DECL && !TREE_CONSTANT (limit))
! limit = gfc_evaluate_now(limit, &se->pre);
- mvar = gfc_create_var (type, "M");
- elsecase = build_v (MODIFY_EXPR, mvar, limit);
for (arg = TREE_CHAIN (arg); arg != NULL_TREE; arg = TREE_CHAIN (arg))
{
val = TREE_VALUE (arg);
--- 970,1003 ----
/* Get the minimum/maximum value of all the parameters.
minmax (a1, a2, a3, ...)
{
! mval = a1;
! for each ai except a1
! mval = MAX/MIN (mval, ai);
! return mval;
! } */
/* TODO: Mismatching types can occur when specific names are used.
These should be handled during resolution. */
+
static void
gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
{
! tree mval;
tree val;
tree arg;
tree type;
arg = gfc_conv_intrinsic_function_args (se, expr);
type = gfc_typenode_for_spec (&expr->ts);
! mval = TREE_VALUE (arg);
! if (TREE_TYPE (mval) != type)
! mval = convert (type, mval);
!
/* Only evaluate the argument once. */
! if (TREE_CODE (mval) != VAR_DECL && !TREE_CONSTANT (mval))
! mval = gfc_evaluate_now (mval, &se->pre);
for (arg = TREE_CHAIN (arg); arg != NULL_TREE; arg = TREE_CHAIN (arg))
{
val = TREE_VALUE (arg);
***************
*** 1015,1031 ****
/* Only evaluate the argument once. */
if (TREE_CODE (val) != VAR_DECL && !TREE_CONSTANT (val))
! val = gfc_evaluate_now(val, &se->pre);
! thencase = build_v (MODIFY_EXPR, mvar, convert (type, val));
!
! tmp = build (op, boolean_type_node, val, limit);
! tmp = build_v (COND_EXPR, tmp, thencase, elsecase);
! gfc_add_expr_to_block (&se->pre, tmp);
! elsecase = build_empty_stmt ();
! limit = mvar;
}
! se->expr = mvar;
}
--- 1006,1019 ----
/* Only evaluate the argument once. */
if (TREE_CODE (val) != VAR_DECL && !TREE_CONSTANT (val))
! val = gfc_evaluate_now (val, &se->pre);
! if (op == GT_EXPR)
! mval = build (MAX_EXPR, type, mval, val);
! else
! mval = build (MIN_EXPR, type, mval, val);
}
! se->expr = mval;
}
***************
*** 1526,1535 ****
static void
gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op)
{
! tree limit;
tree type;
tree tmp;
- tree ifbody;
stmtblock_t body;
stmtblock_t block;
gfc_loopinfo loop;
--- 1514,1522 ----
static void
gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op)
{
! tree mval;
tree type;
tree tmp;
stmtblock_t body;
stmtblock_t block;
gfc_loopinfo loop;
***************
*** 1549,1556 ****
}
type = gfc_typenode_for_spec (&expr->ts);
/* Initialize the result. */
! limit = gfc_create_var (type, "limit");
n = gfc_validate_kind (expr->ts.type, expr->ts.kind);
switch (expr->ts.type)
{
--- 1536,1545 ----
}
type = gfc_typenode_for_spec (&expr->ts);
+
/* Initialize the result. */
! mval = gfc_create_var (type, "mval");
!
n = gfc_validate_kind (expr->ts.type, expr->ts.kind);
switch (expr->ts.type)
{
***************
*** 1569,1575 ****
/* Most negative(-HUGE) for maxval, most positive (-HUGE) for minval. */
if (op == GT_EXPR)
tmp = fold (build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp));
! gfc_add_modify_expr (&se->pre, limit, tmp);
/* Walk the arguments. */
actual = expr->value.function.actual;
--- 1558,1564 ----
/* Most negative(-HUGE) for maxval, most positive (-HUGE) for minval. */
if (op == GT_EXPR)
tmp = fold (build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp));
! gfc_add_modify_expr (&se->pre, mval, tmp);
/* Walk the arguments. */
actual = expr->value.function.actual;
***************
*** 1601,1606 ****
--- 1590,1596 ----
gfc_mark_ss_chain_used (arrayss, 1);
if (maskss)
gfc_mark_ss_chain_used (maskss, 1);
+
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
***************
*** 1618,1639 ****
else
gfc_init_block (&block);
- /* Compare with the current limit. */
gfc_init_se (&arrayse, NULL);
gfc_copy_loopinfo_to_se (&arrayse, &loop);
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
! /* Assign the value to the limit... */
! ifbody = build_v (MODIFY_EXPR, limit, arrayse.expr);
!
! /* If it is a more extreme value. */
! tmp = build (op, boolean_type_node, arrayse.expr, limit);
! tmp = build_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
! gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &arrayse.post);
!
tmp = gfc_finish_block (&block);
if (maskss)
{
--- 1608,1627 ----
else
gfc_init_block (&block);
gfc_init_se (&arrayse, NULL);
gfc_copy_loopinfo_to_se (&arrayse, &loop);
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
! /* Compared with the current min/max value. */
! if (op == GT_EXPR)
! mval = build (MAX_EXPR, type, mval, arrayse.expr);
! else
! mval = build (MIN_EXPR, type, mval, arrayse.expr);
!
gfc_add_block_to_block (&block, &arrayse.post);
!
tmp = gfc_finish_block (&block);
if (maskss)
{
***************
*** 1648,1654 ****
gfc_add_block_to_block (&se->pre, &loop.post);
gfc_cleanup_loop (&loop);
! se->expr = limit;
}
/* BTEST (i, pos) = (i & (1 << pos)) != 0. */
--- 1636,1642 ----
gfc_add_block_to_block (&se->pre, &loop.post);
gfc_cleanup_loop (&loop);
! se->expr = mval;
}
/* BTEST (i, pos) = (i & (1 << pos)) != 0. */