Hello world,
this patch fixes Fortran's handling of common subexpression elimination
across ieee_set_rouding_mode calls. It does so using a rather big
hammer, by issuing a memory barrier to force reload from memory
(and thus a recomputation).
This is a rather big hammer, so if there are more elegant ways
to fix it, I am very much open to suggestions.
If PR 34678 is fixed, then this solution can also be applied here.
OK for trunk? How do you feel about a backport?
Best regards
Thomas
Add memory barrier for calls to ieee_set_rounding_mode.
gcc/fortran/ChangeLog:
PR fortran/108329
* trans-expr.cc (trans_memory_barrier): New functions.
(gfc_conv_procedure_call): Insert memory barrier for
ieee_set_rounding_mode.
gcc/testsuite/ChangeLog:
PR fortran/108329
* gfortran.dg/rounding_4.f90: New test.diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4f3ae82d39c..29be7804e11 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5981,6 +5981,20 @@ post_call:
gfc_add_block_to_block (&parmse->post, &block);
}
+/* Helper function - generate a memory barrier. */
+
+static tree
+trans_memory_barrier (void)
+{
+ tree tmp;
+
+ tmp = gfc_build_string_const (sizeof ("memory"), "memory");
+ tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
+ gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE,
+ tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE);
+ ASM_VOLATILE_P (tmp) = 1;
+ return tmp;
+}
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
@@ -7692,6 +7706,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else
conv_base_obj_fcn_val (se, base_object, expr);
+ /* FIXME: Special handing of ieee_set_rounding_mode - we clobber
+ memory here to avoid common subexpression moving code past calls
+ to ieee_set_rounding_mode. This should only be done for
+ floating point, but currently gcc offers no other possibility.
+ See PR 108329. */
+
+ if (sym->from_intmod == INTMOD_IEEE_ARITHMETIC
+ && strcmp (sym->name, "ieee_set_rounding_mode") == 0)
+ {
+ tree tmp = trans_memory_barrier ();
+ gfc_add_expr_to_block (&post, tmp);
+ }
+
/* If there are alternate return labels, function type should be
integer. Can't modify the type in place though, since it can be shared
with other functions. For dummy arguments, the typing is done to
diff --git a/gcc/testsuite/gfortran.dg/rounding_4.f90 b/gcc/testsuite/gfortran.dg/rounding_4.f90
new file mode 100644
index 00000000000..e8799da67dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/rounding_4.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+module y
+ implicit none
+ integer, parameter :: wp = selected_real_kind(15)
+contains
+ subroutine foo(a,b,c)
+ use ieee_arithmetic
+ real(kind=wp), dimension(4), intent(out) :: a
+ real(kind=wp), intent(in) :: b, c
+ type (ieee_round_type), dimension(4), parameter :: mode = &
+ [ieee_nearest, ieee_to_zero, ieee_up, ieee_down]
+ call ieee_set_rounding_mode (mode(1))
+ a(1) = b + c
+ call ieee_set_rounding_mode (mode(2))
+ a(2) = b + c
+ call ieee_set_rounding_mode (mode(3))
+ a(3) = b + c
+ call ieee_set_rounding_mode (mode(4))
+ a(4) = b + c
+ end subroutine foo
+end module y
+
+program main
+ use y
+ real(kind=wp), dimension(4) :: a
+ call foo(a,0.1_wp,0.2_wp)
+ if (a(1) <= a(2)) stop 1
+ if (a(3) <= a(4)) stop 2
+ if (a(1) /= a(3)) stop 3
+ if (a(2) /= a(4)) stop 4
+end program main
