* 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.
From-SVN: r181267
+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.
/* 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: */
$(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
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
mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
}
\f
+/* 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;
+}
+\f
/* Create a temporary variable with PREFIX and TYPE, and return it. */
static tree
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);
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
/* 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))
{
/* 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
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);
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);
}
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. */
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:
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:
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:
(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;
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
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
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;
/************************/
#include "tm.h"
#include "tree.h"
#include "flags.h"
+#include "toplev.h"
#include "ggc.h"
#include "output.h"
#include "tree-inline.h"
return convert (type, result);
}
\f
+/* 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);
+}
+\f
/* 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
+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
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+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;
projects / gcc.git / commitdiff