aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog24
-rw-r--r--gcc/ada/fe.h16
-rw-r--r--gcc/ada/gcc-interface/Make-lang.in2
-rw-r--r--gcc/ada/gcc-interface/gigi.h6
-rw-r--r--gcc/ada/gcc-interface/trans.c154
-rw-r--r--gcc/ada/gcc-interface/utils2.c107
-rw-r--r--gcc/testsuite/ChangeLog12
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_1.adb39
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_2.adb45
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_3.adb58
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_4.adb45
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_5.adb38
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_6.adb39
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_7.adb40
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_8.adb37
-rw-r--r--gcc/testsuite/gnat.dg/atomic6_pkg.ads34
16 files changed, 671 insertions, 25 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 51b2719..83b31547 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2011-11-10 Eric Botcazou <ebotcazou@adacore.com>
+
+ * fe.h (Serious_Errors_Detected): New macro.
+ * gcc-interface/gigi.h (build_atomic_load): Declare.
+ (build_atomic_store): Likewise.
+ * gcc-interface/trans.c (atomic_sync_required_p): New predicate.
+ (call_to_gnu): Add ATOMIC_SYNC parameter. Use local variable.
+ Build an atomic load for an In or In Out parameter if needed.
+ Build an atomic store for the assignment of an Out parameter if needed.
+ Build an atomic store to the target if ATOMIC_SYNC is true.
+ (present_in_lhs_or_actual_p): New predicate.
+ (gnat_to_gnu) <N_Identifier>: Build an atomic load if needed.
+ <N_Explicit_Dereference>: Likewise.
+ <N_Indexed_Component>: Likewise.
+ <N_Selected_Component>: Likewise.
+ <N_Assignment_Statement>: Adjust call to call_to_gnu.
+ Build an atomic store to the LHS if needed.
+ <N_Function_Call>: Adjust call to call_to_gnu.
+ * gcc-interface/utils2.c: Include toplev.h.
+ (resolve_atomic_size): New static function.
+ (build_atomic_load): New function.
+ (build_atomic_store): Likewise.
+ * gcc-interface/Make-lang.in (ada/utils2.o): Add toplev.h.
+
2011-11-07 Olivier Hainque <hainque@adacore.com>
* sigtramp-ppcvxw.c: Add general comments.
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 18b1461..fe6b22d 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -92,13 +92,15 @@ extern void Set_Identifier_Casing (Char *, const Char *);
/* err_vars: */
-#define Error_Msg_Node_2 err_vars__error_msg_node_2
-#define Error_Msg_Uint_1 err_vars__error_msg_uint_1
-#define Error_Msg_Uint_2 err_vars__error_msg_uint_2
-
-extern Entity_Id Error_Msg_Node_2;
-extern Uint Error_Msg_Uint_1;
-extern Uint Error_Msg_Uint_2;
+#define Error_Msg_Node_2 err_vars__error_msg_node_2
+#define Error_Msg_Uint_1 err_vars__error_msg_uint_1
+#define Error_Msg_Uint_2 err_vars__error_msg_uint_2
+#define Serious_Errors_Detected err_vars__serious_errors_detected
+
+extern Entity_Id Error_Msg_Node_2;
+extern Uint Error_Msg_Uint_1;
+extern Uint Error_Msg_Uint_2;
+extern Nat Serious_Errors_Detected;
/* exp_ch11: */
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index 221d326..3ff28a6 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -1297,7 +1297,7 @@ ada/utils.o : ada/gcc-interface/utils.c $(CONFIG_H) $(SYSTEM_H) coretypes.h \
$(COMPILER) -c $(ALL_COMPILERFLAGS) -I.. $(ALL_CPPFLAGS) $< -o $@
ada/utils2.o : ada/gcc-interface/utils2.c $(CONFIG_H) $(SYSTEM_H) coretypes.h \
- $(TM_H) $(TREE_H) $(FLAGS_H) output.h $(TREE_INLINE_H) \
+ $(TM_H) $(TREE_H) $(FLAGS_H) toplev.h output.h $(TREE_INLINE_H) \
ada/gcc-interface/ada.h ada/types.h ada/atree.h ada/elists.h ada/namet.h \
ada/nlists.h ada/snames.h ada/stringt.h ada/uintp.h ada/fe.h ada/sinfo.h \
ada/einfo.h $(ADA_TREE_H) ada/gcc-interface/gigi.h
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 1439261..e22c444 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -804,6 +804,12 @@ extern unsigned int known_alignment (tree exp);
of 2. */
extern bool value_factor_p (tree value, HOST_WIDE_INT factor);
+/* Build an atomic load for the underlying atomic object in SRC. */
+extern tree build_atomic_load (tree src);
+
+/* Build an atomic store from SRC to the underlying atomic object in DEST. */
+extern tree build_atomic_store (tree dest, tree src);
+
/* Make a binary operation of kind OP_CODE. RESULT_TYPE is the type
desired for the result. Usually the operation is to be performed
in that type. For MODIFY_EXPR and ARRAY_REF, RESULT_TYPE may be 0
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 1f43f4d..8a74e6c 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -3300,6 +3300,60 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
}
+/* Return true if GNAT_NODE requires atomic synchronization. */
+
+static bool
+atomic_sync_required_p (Node_Id gnat_node)
+{
+ const Node_Id gnat_parent = Parent (gnat_node);
+ Node_Kind kind;
+ unsigned char attr_id;
+
+ /* First, scan the node to find the Atomic_Sync_Required flag. */
+ kind = Nkind (gnat_node);
+ if (kind == N_Type_Conversion || kind == N_Unchecked_Type_Conversion)
+ {
+ gnat_node = Expression (gnat_node);
+ kind = Nkind (gnat_node);
+ }
+
+ switch (kind)
+ {
+ case N_Expanded_Name:
+ case N_Explicit_Dereference:
+ case N_Identifier:
+ case N_Indexed_Component:
+ case N_Selected_Component:
+ if (!Atomic_Sync_Required (gnat_node))
+ return false;
+ break;
+
+ default:
+ return false;
+ }
+
+ /* Then, scan the parent to find out cases where the flag is irrelevant. */
+ kind = Nkind (gnat_parent);
+ switch (kind)
+ {
+ case N_Attribute_Reference:
+ attr_id = Get_Attribute_Id (Attribute_Name (gnat_parent));
+ /* Do not mess up machine code insertions. */
+ if (attr_id == Attr_Asm_Input || attr_id == Attr_Asm_Output)
+ return false;
+ break;
+
+ case N_Object_Renaming_Declaration:
+ /* Do not generate a function call as a renamed object. */
+ return false;
+
+ default:
+ break;
+ }
+
+ return true;
+}
+
/* Create a temporary variable with PREFIX and TYPE, and return it. */
static tree
@@ -3334,10 +3388,13 @@ create_init_temporary (const char *prefix, tree gnu_init, tree *gnu_init_stmt,
or an N_Procedure_Call_Statement, to a GCC tree, which is returned.
GNU_RESULT_TYPE_P is a pointer to where we should place the result type.
If GNU_TARGET is non-null, this must be a function call on the RHS of a
- N_Assignment_Statement and the result is to be placed into that object. */
+ N_Assignment_Statement and the result is to be placed into that object.
+ If, in addition, ATOMIC_SYNC is true, then the assignment to GNU_TARGET
+ requires atomic synchronization. */
static tree
-call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
+call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
+ bool atomic_sync)
{
const bool function_call = (Nkind (gnat_node) == N_Function_Call);
const bool returning_value = (function_call && !gnu_target);
@@ -3433,6 +3490,11 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
const bool is_true_formal_parm
= gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL;
+ const bool is_by_ref_formal_parm
+ = is_true_formal_parm
+ && (DECL_BY_REF_P (gnu_formal)
+ || DECL_BY_COMPONENT_PTR_P (gnu_formal)
+ || DECL_BY_DESCRIPTOR_P (gnu_formal));
/* In the Out or In Out case, we must suppress conversions that yield
an lvalue but can nevertheless cause the creation of a temporary,
because we need the real object in this case, either to pass its
@@ -3462,10 +3524,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
/* If we are passing a non-addressable parameter by reference, pass the
address of a copy. In the Out or In Out case, set up to copy back
out after the call. */
- if (is_true_formal_parm
- && (DECL_BY_REF_P (gnu_formal)
- || DECL_BY_COMPONENT_PTR_P (gnu_formal)
- || DECL_BY_DESCRIPTOR_P (gnu_formal))
+ if (is_by_ref_formal_parm
&& (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name)))
&& !addressable_p (gnu_name, gnu_name_type))
{
@@ -3569,6 +3628,14 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
/* Start from the real object and build the actual. */
gnu_actual = gnu_name;
+ /* If this is an atomic access of an In or In Out parameter for which
+ synchronization is required, build the atomic load. */
+ if (is_true_formal_parm
+ && !is_by_ref_formal_parm
+ && Ekind (gnat_formal) != E_Out_Parameter
+ && atomic_sync_required_p (gnat_actual))
+ gnu_actual = build_atomic_load (gnu_actual);
+
/* If this was a procedure call, we may not have removed any padding.
So do it here for the part we will use as an input, if any. */
if (Ekind (gnat_formal) != E_Out_Parameter
@@ -3865,8 +3932,11 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
gnu_result = convert (TREE_TYPE (gnu_actual), gnu_result);
}
- gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
- gnu_actual, gnu_result);
+ if (atomic_sync_required_p (gnat_actual))
+ gnu_result = build_atomic_store (gnu_actual, gnu_result);
+ else
+ gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
+ gnu_actual, gnu_result);
set_expr_location_from_node (gnu_result, gnat_node);
append_to_statement_list (gnu_result, &gnu_stmt_list);
gnu_cico_list = TREE_CHAIN (gnu_cico_list);
@@ -3919,8 +3989,11 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
else
op_code = MODIFY_EXPR;
- gnu_call
- = build_binary_op (op_code, NULL_TREE, gnu_target, gnu_call);
+ if (atomic_sync)
+ gnu_call = build_atomic_store (gnu_target, gnu_call);
+ else
+ gnu_call
+ = build_binary_op (op_code, NULL_TREE, gnu_target, gnu_call);
set_expr_location_from_node (gnu_call, gnat_parent);
append_to_statement_list (gnu_call, &gnu_stmt_list);
}
@@ -4494,6 +4567,26 @@ lhs_or_actual_p (Node_Id gnat_node)
return false;
}
+/* Return true if either GNAT_NODE or a view of GNAT_NODE is on the LHS
+ of an assignment or an actual parameter of a call. */
+
+static bool
+present_in_lhs_or_actual_p (Node_Id gnat_node)
+{
+ Node_Kind kind;
+
+ if (lhs_or_actual_p (gnat_node))
+ return true;
+
+ kind = Nkind (Parent (gnat_node));
+
+ if ((kind == N_Type_Conversion || kind == N_Unchecked_Type_Conversion)
+ && lhs_or_actual_p (Parent (gnat_node)))
+ return true;
+
+ return false;
+}
+
/* Return true if GNAT_NODE, an unchecked type conversion, is a no-op as far
as gigi is concerned. This is used to avoid conversions on the LHS. */
@@ -4613,6 +4706,12 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Operator_Symbol:
case N_Defining_Identifier:
gnu_result = Identifier_to_gnu (gnat_node, &gnu_result_type);
+
+ /* If this is an atomic access on the RHS for which synchronization is
+ required, build the atomic load. */
+ if (atomic_sync_required_p (gnat_node)
+ && !present_in_lhs_or_actual_p (gnat_node))
+ gnu_result = build_atomic_load (gnu_result);
break;
case N_Integer_Literal:
@@ -4897,6 +4996,12 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = gnat_to_gnu (Prefix (gnat_node));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
+
+ /* If this is an atomic access on the RHS for which synchronization is
+ required, build the atomic load. */
+ if (atomic_sync_required_p (gnat_node)
+ && !present_in_lhs_or_actual_p (gnat_node))
+ gnu_result = build_atomic_load (gnu_result);
break;
case N_Indexed_Component:
@@ -4963,9 +5068,15 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = build_binary_op (ARRAY_REF, NULL_TREE,
gnu_result, gnu_expr);
}
- }
- gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+ /* If this is an atomic access on the RHS for which synchronization is
+ required, build the atomic load. */
+ if (atomic_sync_required_p (gnat_node)
+ && !present_in_lhs_or_actual_p (gnat_node))
+ gnu_result = build_atomic_load (gnu_result);
+ }
break;
case N_Slice:
@@ -5110,8 +5221,13 @@ gnat_to_gnu (Node_Id gnat_node)
(Parent (gnat_node)));
}
- gcc_assert (gnu_result);
gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+ /* If this is an atomic access on the RHS for which synchronization is
+ required, build the atomic load. */
+ if (atomic_sync_required_p (gnat_node)
+ && !present_in_lhs_or_actual_p (gnat_node))
+ gnu_result = build_atomic_load (gnu_result);
}
break;
@@ -5618,7 +5734,8 @@ gnat_to_gnu (Node_Id gnat_node)
N_Raise_Storage_Error);
else if (Nkind (Expression (gnat_node)) == N_Function_Call)
gnu_result
- = call_to_gnu (Expression (gnat_node), &gnu_result_type, gnu_lhs);
+ = call_to_gnu (Expression (gnat_node), &gnu_result_type, gnu_lhs,
+ atomic_sync_required_p (Name (gnat_node)));
else
{
gnu_rhs
@@ -5629,8 +5746,11 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)),
gnat_node);
- gnu_result
- = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs);
+ if (atomic_sync_required_p (Name (gnat_node)))
+ gnu_result = build_atomic_store (gnu_lhs, gnu_rhs);
+ else
+ gnu_result
+ = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs);
/* If the type being assigned is an array type and the two sides are
not completely disjoint, play safe and use memmove. But don't do
@@ -5880,7 +6000,7 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Function_Call:
case N_Procedure_Call_Statement:
- gnu_result = call_to_gnu (gnat_node, &gnu_result_type, NULL_TREE);
+ gnu_result = call_to_gnu (gnat_node, &gnu_result_type, NULL_TREE, false);
break;
/************************/
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 4075a27..c303e2f 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -29,6 +29,7 @@
#include "tm.h"
#include "tree.h"
#include "flags.h"
+#include "toplev.h"
#include "ggc.h"
#include "output.h"
#include "tree-inline.h"
@@ -590,6 +591,112 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
return convert (type, result);
}
+/* This page contains routines that implement the Ada semantics with regard
+ to atomic objects. They are fully piggybacked on the middle-end support
+ for atomic loads and stores.
+
+ *** Memory barriers and volatile objects ***
+
+ We implement the weakened form of the C.6(16) clause that was introduced
+ in Ada 2012 (AI05-117). Earlier forms of this clause wouldn't have been
+ implementable without significant performance hits on modern platforms.
+
+ We also take advantage of the requirements imposed on shared variables by
+ 9.10 (conditions for sequential actions) to have non-erroneous execution
+ and consider that C.6(16) and C.6(17) only prescribe an uniform order of
+ volatile updates with regard to sequential actions, i.e. with regard to
+ reads or updates of atomic objects.
+
+ As such, an update of an atomic object by a task requires that all earlier
+ accesses to volatile objects have completed. Similarly, later accesses to
+ volatile objects cannot be reordered before the update of the atomic object.
+ So, memory barriers both before and after the atomic update are needed.
+
+ For a read of an atomic object, to avoid seeing writes of volatile objects
+ by a task earlier than by the other tasks, a memory barrier is needed before
+ the atomic read. Finally, to avoid reordering later reads or updates of
+ volatile objects to before the atomic read, a barrier is needed after the
+ atomic read.
+
+ So, memory barriers are needed before and after atomic reads and updates.
+ And, in order to simplify the implementation, we use full memory barriers
+ in all cases, i.e. we enforce sequential consistency for atomic accesses. */
+
+/* Return the size of TYPE, which must be a positive power of 2. */
+
+static unsigned int
+resolve_atomic_size (tree type)
+{
+ unsigned HOST_WIDE_INT size = tree_low_cst (TYPE_SIZE_UNIT (type), 1);
+
+ if (size == 1 || size == 2 || size == 4 || size == 8 || size == 16)
+ return size;
+
+ /* We shouldn't reach here without having already detected that the size
+ isn't compatible with an atomic access. */
+ gcc_assert (Serious_Errors_Detected);
+
+ return 0;
+}
+
+/* Build an atomic load for the underlying atomic object in SRC. */
+
+tree
+build_atomic_load (tree src)
+{
+ tree ptr_type
+ = build_pointer_type
+ (build_qualified_type (void_type_node, TYPE_QUAL_VOLATILE));
+ tree mem_model = build_int_cst (integer_type_node, MEMMODEL_SEQ_CST);
+ tree orig_src = src;
+ tree type = TREE_TYPE (src);
+ tree t, val;
+ unsigned int size;
+ int fncode;
+
+ src = remove_conversions (src, false);
+ size = resolve_atomic_size (TREE_TYPE (src));
+ if (size == 0)
+ return orig_src;
+
+ fncode = (int) BUILT_IN_ATOMIC_LOAD_N + exact_log2 (size) + 1;
+ t = builtin_decl_implicit ((enum built_in_function) fncode);
+
+ src = build_unary_op (ADDR_EXPR, ptr_type, src);
+ val = build_call_expr (t, 2, src, mem_model);
+
+ return unchecked_convert (type, val, true);
+}
+
+/* Build an atomic store from SRC to the underlying atomic object in DEST. */
+
+tree
+build_atomic_store (tree dest, tree src)
+{
+ tree ptr_type
+ = build_pointer_type
+ (build_qualified_type (void_type_node, TYPE_QUAL_VOLATILE));
+ tree mem_model = build_int_cst (integer_type_node, MEMMODEL_SEQ_CST);
+ tree orig_dest = dest;
+ tree t, int_type;
+ unsigned int size;
+ int fncode;
+
+ dest = remove_conversions (dest, false);
+ size = resolve_atomic_size (TREE_TYPE (dest));
+ if (size == 0)
+ return build_binary_op (MODIFY_EXPR, NULL_TREE, orig_dest, src);
+
+ fncode = (int) BUILT_IN_ATOMIC_STORE_N + exact_log2 (size) + 1;
+ t = builtin_decl_implicit ((enum built_in_function) fncode);
+ int_type = gnat_type_for_size (BITS_PER_UNIT * size, 1);
+
+ dest = build_unary_op (ADDR_EXPR, ptr_type, dest);
+ src = unchecked_convert (int_type, src, true);
+
+ return build_call_expr (t, 3, dest, src, mem_model);
+}
+
/* Make a binary operation of kind OP_CODE. RESULT_TYPE is the type
desired for the result. Usually the operation is to be performed
in that type. For INIT_EXPR and MODIFY_EXPR, RESULT_TYPE must be
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9615be5..e988797 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,15 @@
+2011-11-10 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/atomic6_1.adb: New test.
+ * gnat.dg/atomic6_2.adb: Likewise.
+ * gnat.dg/atomic6_3.adb: Likewise.
+ * gnat.dg/atomic6_4.adb: Likewise.
+ * gnat.dg/atomic6_5.adb: Likewise.
+ * gnat.dg/atomic6_6.adb: Likewise.
+ * gnat.dg/atomic6_7.adb: Likewise.
+ * gnat.dg/atomic6_8.adb: Likewise.
+ * gnat.dg/atomic6_pkg.ads: New helper.
+
2011-11-10 Jakub Jelinek <jakub@redhat.com>
PR middle-end/51077
diff --git a/gcc/testsuite/gnat.dg/atomic6_1.adb b/gcc/testsuite/gnat.dg/atomic6_1.adb
new file mode 100644
index 0000000..714ceb6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_1.adb
@@ -0,0 +1,39 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-gimple" }
+
+with Atomic6_Pkg; use Atomic6_Pkg;
+
+procedure Atomic6_1 is
+ Temp : Integer;
+begin
+
+ Counter1 := Counter2;
+
+ Timer1 := Timer2;
+
+ Counter1 := Int(Timer1);
+ Timer1 := Integer(Counter1);
+
+ Temp := Integer(Counter1);
+ Counter1 := Int(Temp);
+
+ Temp := Timer1;
+ Timer1 := Temp;
+
+end;
+
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { cleanup-tree-dump "gimple" } }
diff --git a/gcc/testsuite/gnat.dg/atomic6_2.adb b/gcc/testsuite/gnat.dg/atomic6_2.adb
new file mode 100644
index 0000000..4ecef9b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_2.adb
@@ -0,0 +1,45 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-gimple" }
+
+with Atomic6_Pkg; use Atomic6_Pkg;
+
+procedure Atomic6_2 is
+ Temp : Integer;
+begin
+
+ Counter1 := Counter1 + Counter2;
+
+ Timer1 := Timer1 + Timer2;
+
+ Counter1 := Counter1 + Int(Timer1);
+ Timer1 := Timer1 + Integer(Counter1);
+
+ Temp := Integer(Counter1) + Timer1;
+ Counter1 := Int(Timer1) + Int(Temp);
+ Timer1 := Integer(Counter1) + Temp;
+
+ if Counter1 /= Counter2 then
+ raise Program_Error;
+ end if;
+
+ if Timer1 /= Timer2 then
+ raise Program_Error;
+ end if;
+
+end;
+
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter1" 6 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter2" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer1" 6 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer2" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { cleanup-tree-dump "gimple" } }
diff --git a/gcc/testsuite/gnat.dg/atomic6_3.adb b/gcc/testsuite/gnat.dg/atomic6_3.adb
new file mode 100644
index 0000000..86b6d81
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_3.adb
@@ -0,0 +1,58 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-gimple" }
+
+with Atomic6_Pkg; use Atomic6_Pkg;
+
+procedure Atomic6_3 is
+
+ function F (I : Integer) return Integer is
+ begin
+ return I;
+ end;
+
+ function F2 return Integer is
+ begin
+ return Integer(Counter1);
+ end;
+
+ function F3 return Integer is
+ begin
+ return Timer1;
+ end;
+
+ Temp : Integer;
+begin
+
+ Counter1 := Int(F(Integer(Counter2)));
+
+ Timer1 := F(Timer2);
+
+ Counter1 := Int(F(Timer1));
+ Timer1 := F(Integer(Counter1));
+
+ Temp := F(Integer(Counter1));
+ Counter1 := Int(F(Temp));
+
+ Temp := F(Timer1);
+ Timer1 := F(Temp);
+
+ Temp := F2;
+ Temp := F3;
+
+end;
+
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { cleanup-tree-dump "gimple" } }
diff --git a/gcc/testsuite/gnat.dg/atomic6_4.adb b/gcc/testsuite/gnat.dg/atomic6_4.adb
new file mode 100644
index 0000000..cf960fb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_4.adb
@@ -0,0 +1,45 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-gimple" }
+
+with Atomic6_Pkg; use Atomic6_Pkg;
+
+procedure Atomic6_4 is
+
+ procedure P (I1 : out Integer; I2 : in Integer) is
+ begin
+ I1 := I2;
+ end;
+
+ Temp : Integer;
+begin
+
+ P (Integer(Counter1), Integer(Counter2));
+
+ P (Timer1, Timer2);
+
+ P (Integer(Counter1), Timer1);
+ P (Timer1, Integer(Counter1));
+
+ P (Temp, Integer(Counter1));
+ P (Integer(Counter1), Temp);
+
+ P (Temp, Timer1);
+ P (Timer1, Temp);
+
+end;
+
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { cleanup-tree-dump "gimple" } }
diff --git a/gcc/testsuite/gnat.dg/atomic6_5.adb b/gcc/testsuite/gnat.dg/atomic6_5.adb
new file mode 100644
index 0000000..5490f3a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_5.adb
@@ -0,0 +1,38 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-gimple" }
+
+with Atomic6_Pkg; use Atomic6_Pkg;
+
+procedure Atomic6_5 is
+ type Arr is array (Integer range 1 .. 4) of Boolean;
+ A : Arr;
+ B : Boolean;
+begin
+
+ A (Integer(Counter1)) := True;
+ B := A (Timer1);
+
+ declare
+ pragma Suppress (Index_Check);
+ begin
+ A (Integer(Counter1)) := True;
+ B := A (Timer1);
+ end;
+
+end;
+
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter1" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer1" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { cleanup-tree-dump "gimple" } }
diff --git a/gcc/testsuite/gnat.dg/atomic6_6.adb b/gcc/testsuite/gnat.dg/atomic6_6.adb
new file mode 100644
index 0000000..2c217f6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_6.adb
@@ -0,0 +1,39 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-gimple" }
+
+with Atomic6_Pkg; use Atomic6_Pkg;
+
+procedure Atomic6_6 is
+ Temp : Integer;
+begin
+
+ Counter(1) := Counter(2);
+
+ Timer(1) := Timer(2);
+
+ Counter(1) := Int(Timer(1));
+ Timer(1) := Integer(Counter(1));
+
+ Temp := Integer(Counter(1));
+ Counter(1) := Int(Temp);
+
+ Temp := Timer(1);
+ Timer(1) := Temp;
+
+end;
+
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter\\\[1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter\\\[2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer\\\[1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer\\\[2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter\\\[1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter\\\[2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer\\\[1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer\\\[2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { cleanup-tree-dump "gimple" } }
diff --git a/gcc/testsuite/gnat.dg/atomic6_7.adb b/gcc/testsuite/gnat.dg/atomic6_7.adb
new file mode 100644
index 0000000..8b48bf5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_7.adb
@@ -0,0 +1,40 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-gimple" }
+
+with Atomic6_Pkg; use Atomic6_Pkg;
+
+procedure Atomic6_7 is
+ My_Atomic : R;
+ Temp : Integer;
+begin
+
+ My_Atomic.Counter1 := Counter2;
+
+ My_Atomic.Timer1 := Timer2;
+
+ My_Atomic.Counter1 := Int(My_Atomic.Timer1);
+ My_Atomic.Timer1 := Integer(My_Atomic.Counter1);
+
+ Temp := Integer(My_Atomic.Counter1);
+ My_Atomic.Counter1 := Int(Temp);
+
+ Temp := My_Atomic.Timer1;
+ My_Atomic.Timer1 := Temp;
+
+end;
+
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&my_atomic.counter1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&my_atomic.timer1" 2 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer2" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&my_atomic.counter1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&my_atomic.timer1" 3 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*ptr" 0 "gimple"} }
+
+-- { dg-final { cleanup-tree-dump "gimple" } }
diff --git a/gcc/testsuite/gnat.dg/atomic6_8.adb b/gcc/testsuite/gnat.dg/atomic6_8.adb
new file mode 100644
index 0000000..7d39396
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_8.adb
@@ -0,0 +1,37 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-gimple" }
+
+with Atomic6_Pkg; use Atomic6_Pkg;
+
+procedure Atomic6_8 is
+ Ptr : Int_Ptr := new Int;
+ Temp : Integer;
+begin
+
+ Ptr.all := Counter1;
+
+ Counter1 := Ptr.all;
+
+ Ptr.all := Int(Timer1);
+ Timer1 := Integer(Ptr.all);
+
+ Temp := Integer(Ptr.all);
+ Ptr.all := Int(Temp);
+
+end;
+
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter1" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer1" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_load\[^\n\r\]*ptr" 3 "gimple"} }
+
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter1" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__counter2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer1" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&atomic6_pkg__timer2" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*&temp" 0 "gimple"} }
+-- { dg-final { scan-tree-dump-times "atomic_store\[^\n\r\]*ptr" 3 "gimple"} }
+
+-- { dg-final { cleanup-tree-dump "gimple" } }
diff --git a/gcc/testsuite/gnat.dg/atomic6_pkg.ads b/gcc/testsuite/gnat.dg/atomic6_pkg.ads
new file mode 100644
index 0000000..aad2435
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/atomic6_pkg.ads
@@ -0,0 +1,34 @@
+package Atomic6_Pkg is
+
+ type Int is new Integer;
+ pragma Atomic (Int);
+
+ Counter1 : Int;
+ Counter2 : Int;
+
+ Timer1 : Integer;
+ pragma Atomic (Timer1);
+
+ Timer2 : Integer;
+ pragma Atomic (Timer2);
+
+ type Arr1 is array (1..8) of Int;
+ Counter : Arr1;
+
+ type Arr2 is array (1..8) of Integer;
+ pragma Atomic_Components (Arr2);
+ Timer : Arr2;
+
+ type R is record
+ Counter1 : Int;
+ Timer1 : Integer;
+ pragma Atomic (Timer1);
+ Counter2 : Int;
+ Timer2 : Integer;
+ pragma Atomic (Timer2);
+ Dummy : Integer;
+ end record;
+
+ type Int_Ptr is access all Int;
+
+end Atomic6_Pkg;
generated by cgit v1.1 at 2025-02-12 06:34:38 +0000