diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2006-11-05 06:27:48 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2006-11-05 06:27:48 +0000 |
commit | 58b6e04789a04563418234e753835ee6248bf4d8 (patch) | |
tree | d03b8048cc4743b2d76e030ab691c2db5c79c4b6 /gcc/fortran/trans-intrinsic.c | |
parent | cb60c134e23d6c8c013ad89a4c1cb6e28cac94b6 (diff) | |
download | gcc-58b6e04789a04563418234e753835ee6248bf4d8.zip gcc-58b6e04789a04563418234e753835ee6248bf4d8.tar.gz gcc-58b6e04789a04563418234e753835ee6248bf4d8.tar.bz2 |
2006-11-05 Francois-Xavier Coudert <fxcoudert@gcc.gnu,org>
Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org>
PR fortran/29565
* gfortran.dg/gfortran.dg/aliasing_dummy_3.f90: New test.
From-SVN: r118492
Diffstat (limited to 'gcc/fortran/trans-intrinsic.c')
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 67 |
1 files changed, 63 insertions, 4 deletions
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); |