This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Implement AI05-117 (memory barriers and volatile objects)
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Thu, 10 Nov 2011 20:44:38 +0100
- Subject: [Ada] Implement AI05-117 (memory barriers and volatile objects)
This is the final part of the implementation of AI05-117, whose aim is to make
it possible to implement efficient lock-free algorithms. We map operations on
atomic types onto the new __builtin_atomic_load and __builtin_atomic_store
primitives of the middle-end.
Tested on i586-suse-linux, applied on mainline,
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-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.
--
Eric Botcazou
Index: fe.h
===================================================================
--- fe.h (revision 181216)
+++ fe.h (working copy)
@@ -92,13 +92,15 @@ extern void Set_Identifier_Casing (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
+#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 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: */
Index: gcc-interface/Make-lang.in
===================================================================
--- gcc-interface/Make-lang.in (revision 181216)
+++ gcc-interface/Make-lang.in (working copy)
@@ -1297,7 +1297,7 @@ ada/utils.o : ada/gcc-interface/utils.c
$(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
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c (revision 181216)
+++ gcc-interface/utils2.c (working copy)
@@ -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_c
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
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h (revision 181216)
+++ gcc-interface/gigi.h (working copy)
@@ -804,6 +804,12 @@ extern unsigned int known_alignment (tre
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
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 181216)
+++ gcc-interface/trans.c (working copy)
@@ -3300,6 +3300,60 @@ Subprogram_Body_to_gnu (Node_Id gnat_nod
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 *prefi
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 *gn
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 *gn
/* 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 *gn
/* 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 *gn
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 *gn
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;
/************************/
-- { 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" } }
-- { 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" } }
-- { 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" } }
-- { 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" } }
-- { 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" } }
-- { 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" } }
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;
-- { 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" } }
-- { 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" } }