From 58b6e04789a04563418234e753835ee6248bf4d8 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 5 Nov 2006 06:27:48 +0000 Subject: 2006-11-05 Francois-Xavier Coudert Paul Thomas PR fortran/24518 * trans-intrinsic.c (gfc_conv_intrinsic_mod): Use built_in fmod for both MOD and MODULO, if it is available. PR fortran/29565 * trans-expr.c (gfc_conv_aliased_arg): For an INTENT(OUT), save the declarations from the unused loops by merging the block scope for each; this ensures that the temporary is declared. 2006-11-05 Paul Thomas PR fortran/29565 * gfortran.dg/gfortran.dg/aliasing_dummy_3.f90: New test. From-SVN: r118492 --- gcc/fortran/trans-intrinsic.c | 67 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 63 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/trans-intrinsic.c') diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index d031878..5389c0b 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -976,14 +976,15 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) int n, ikind; arg = gfc_conv_intrinsic_function_args (se, expr); - arg2 = TREE_VALUE (TREE_CHAIN (arg)); - arg = TREE_VALUE (arg); - type = TREE_TYPE (arg); switch (expr->ts.type) { case BT_INTEGER: /* Integer case is easy, we've got a builtin op. */ + arg2 = TREE_VALUE (TREE_CHAIN (arg)); + arg = TREE_VALUE (arg); + type = TREE_TYPE (arg); + if (modulo) se->expr = build2 (FLOOR_MOD_EXPR, type, arg, arg2); else @@ -991,11 +992,69 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) break; case BT_REAL: - /* Real values we have to do the hard way. */ + n = END_BUILTINS; + /* Check if we have a builtin fmod. */ + switch (expr->ts.kind) + { + case 4: + n = BUILT_IN_FMODF; + break; + + case 8: + n = BUILT_IN_FMOD; + break; + + case 10: + case 16: + n = BUILT_IN_FMODL; + break; + + default: + break; + } + + /* Use it if it exists. */ + if (n != END_BUILTINS) + { + tmp = built_in_decls[n]; + se->expr = build_function_call_expr (tmp, arg); + if (modulo == 0) + return; + } + + arg2 = TREE_VALUE (TREE_CHAIN (arg)); + arg = TREE_VALUE (arg); + type = TREE_TYPE (arg); + arg = gfc_evaluate_now (arg, &se->pre); arg2 = gfc_evaluate_now (arg2, &se->pre); + /* Definition: + modulo = arg - floor (arg/arg2) * arg2, so + = test ? fmod (arg, arg2) : fmod (arg, arg2) + arg2, + where + test = (fmod (arg, arg2) != 0) && ((arg < 0) xor (arg2 < 0)) + thereby avoiding another division and retaining the accuracy + of the builtin function. */ + if (n != END_BUILTINS && modulo) + { + tree zero = gfc_build_const (type, integer_zero_node); + tmp = gfc_evaluate_now (se->expr, &se->pre); + test = build2 (LT_EXPR, boolean_type_node, arg, zero); + test2 = build2 (LT_EXPR, boolean_type_node, arg2, zero); + test2 = build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2); + test = build2 (NE_EXPR, boolean_type_node, tmp, zero); + test = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2); + test = gfc_evaluate_now (test, &se->pre); + se->expr = build3 (COND_EXPR, type, test, + build2 (PLUS_EXPR, type, tmp, arg2), tmp); + return; + } + + /* If we do not have a built_in fmod, the calculation is going to + have to be done longhand. */ tmp = build2 (RDIV_EXPR, type, arg, arg2); + /* Test if the value is too large to handle sensibly. */ gfc_set_model_kind (expr->ts.kind); mpfr_init (huge); -- cgit v1.1