--- gcc/ada/exp_ch6.adb +++ gcc/ada/exp_ch6.adb @@ -1287,6 +1287,10 @@ package body Exp_Ch6 is -- the context of a call. Now we need to complete the expansion, so we -- unmark the analyzed bits in all prefixes. + function Requires_Atomic_Or_Volatile_Copy return Boolean; + -- Returns whether a copy is required as per RM C.6(19) and gives a + -- warning in this case. + --------------------------- -- Add_Call_By_Copy_Code -- --------------------------- @@ -1938,6 +1942,43 @@ package body Exp_Ch6 is end loop; end Reset_Packed_Prefix; + ---------------------------------------- + -- Requires_Atomic_Or_Volatile_Copy -- + ---------------------------------------- + + function Requires_Atomic_Or_Volatile_Copy return Boolean is + begin + -- If the formal is already passed by copy, no need to do anything + + if Is_By_Copy_Type (E_Formal) then + return False; + end if; + + -- Check for atomicity mismatch + + if Is_Atomic_Object (Actual) and then not Is_Atomic (E_Formal) + then + if Comes_From_Source (N) then + Error_Msg_N + ("?atomic actual passed by copy (RM C.6(19))", Actual); + end if; + return True; + end if; + + -- Check for volatility mismatch + + if Is_Volatile_Object (Actual) and then not Is_Volatile (E_Formal) + then + if Comes_From_Source (N) then + Error_Msg_N + ("?volatile actual passed by copy (RM C.6(19))", Actual); + end if; + return True; + end if; + + return False; + end Requires_Atomic_Or_Volatile_Copy; + -- Start of processing for Expand_Actuals begin @@ -2125,27 +2166,10 @@ package body Exp_Ch6 is then Add_Call_By_Copy_Code; - -- If the actual is not a scalar and is marked for volatile - -- treatment, whereas the formal is not volatile, then pass - -- by copy unless it is a by-reference type. + -- We may need to force a copy because of atomicity or volatility + -- considerations. - -- Note: we use Is_Volatile here rather than Treat_As_Volatile, - -- because this is the enforcement of a language rule that applies - -- only to "real" volatile variables, not e.g. to the address - -- clause overlay case. - - elsif Is_Entity_Name (Actual) - and then Is_Volatile (Entity (Actual)) - and then not Is_By_Reference_Type (E_Actual) - and then not Is_Scalar_Type (Etype (Entity (Actual))) - and then not Is_Volatile (E_Formal) - then - Add_Call_By_Copy_Code; - - elsif Nkind (Actual) = N_Indexed_Component - and then Is_Entity_Name (Prefix (Actual)) - and then Has_Volatile_Components (Entity (Prefix (Actual))) - then + elsif Requires_Atomic_Or_Volatile_Copy then Add_Call_By_Copy_Code; -- Add call-by-copy code for the case of scalar out parameters @@ -2323,6 +2347,12 @@ package body Exp_Ch6 is elsif Is_Possibly_Unaligned_Slice (Actual) then Add_Call_By_Copy_Code; + -- We may need to force a copy because of atomicity or volatility + -- considerations. + + elsif Requires_Atomic_Or_Volatile_Copy then + Add_Call_By_Copy_Code; + -- An unusual case: a current instance of an enclosing task can be -- an actual, and must be replaced by a reference to self. --- gcc/ada/fe.h +++ gcc/ada/fe.h @@ -281,17 +281,13 @@ extern Boolean Is_OK_Static_Expression (Node_Id); #define Defining_Entity sem_util__defining_entity #define First_Actual sem_util__first_actual -#define Is_Atomic_Object sem_util__is_atomic_object #define Is_Variable_Size_Record sem_util__is_variable_size_record -#define Is_Volatile_Object sem_util__is_volatile_object #define Next_Actual sem_util__next_actual #define Requires_Transient_Scope sem_util__requires_transient_scope extern Entity_Id Defining_Entity (Node_Id); extern Node_Id First_Actual (Node_Id); -extern Boolean Is_Atomic_Object (Node_Id); extern Boolean Is_Variable_Size_Record (Entity_Id Id); -extern Boolean Is_Volatile_Object (Node_Id); extern Node_Id Next_Actual (Node_Id); extern Boolean Requires_Transient_Scope (Entity_Id); --- gcc/ada/gcc-interface/trans.c +++ gcc/ada/gcc-interface/trans.c @@ -5008,35 +5008,6 @@ create_init_temporary (const char *prefix, tree gnu_init, tree *gnu_init_stmt, return gnu_temp; } -/* Return whether ACTUAL parameter corresponding to FORMAL_TYPE must be passed - by copy in a call as per RM C.6(19). Note that we use the same predicates - as in the front-end for RM C.6(12) because it's purely a legality issue. */ - -static bool -atomic_or_volatile_copy_required_p (Node_Id actual, Entity_Id formal_type) -{ - /* We should not have a scalar type here because such a type is passed - by copy. But the Interlocked routines in System.Aux_DEC force some - of the their scalar parameters to be passed by reference so we need - to preserve that if we do not want to break the interface. */ - if (Is_Scalar_Type (formal_type)) - return false; - - if (Is_Atomic_Object (actual) && !Is_Atomic (formal_type)) - { - post_error ("?atomic actual passed by copy (RM C.6(19))", actual); - return true; - } - - if (Is_Volatile_Object (actual) && !Is_Volatile (formal_type)) - { - post_error ("?volatile actual passed by copy (RM C.6(19))", actual); - return true; - } - - return false; -} - /* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call 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. @@ -5254,18 +5225,13 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, = build_compound_expr (TREE_TYPE (gnu_name), init, gnu_name); } - /* If we are passing a non-addressable actual parameter by reference, - pass the address of a copy and, in the In Out or Out case, set up - to copy back after the call. We also need to do that if the actual - parameter is atomic or volatile but the formal parameter is not. */ + /* If we are passing a non-addressable parameter by reference, pass the + address of a copy. In the In Out or Out case, set up to copy back + out after the call. */ if (is_by_ref_formal_parm && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name))) - && (!addressable_p (gnu_name, gnu_name_type) - || (Comes_From_Source (gnat_node) - && atomic_or_volatile_copy_required_p (gnat_actual, - gnat_formal_type)))) + && !addressable_p (gnu_name, gnu_name_type)) { - const bool atomic_p = atomic_access_required_p (gnat_actual, &sync); tree gnu_orig = gnu_name, gnu_temp, gnu_stmt; /* Do not issue warnings for CONSTRUCTORs since this is not a copy @@ -5335,9 +5301,6 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, } /* Create an explicit temporary holding the copy. */ - if (atomic_p) - gnu_name = build_atomic_load (gnu_name, sync); - /* Do not initialize it for the _Init parameter of an initialization procedure since no data is meant to be passed in. */ if (Ekind (gnat_formal) == E_Out_Parameter @@ -5367,13 +5330,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, (TREE_OPERAND (TREE_OPERAND (gnu_orig, 1), 1))) gnu_orig = TREE_OPERAND (gnu_orig, 2); - if (atomic_p) - gnu_stmt - = build_atomic_store (gnu_orig, gnu_temp, sync); - else - gnu_stmt - = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, - gnu_temp); + gnu_stmt + = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, gnu_temp); set_expr_location_from_node (gnu_stmt, gnat_node); append_to_statement_list (gnu_stmt, &gnu_after_list); --- gcc/ada/sem_util.ads +++ gcc/ada/sem_util.ads @@ -1533,8 +1533,6 @@ package Sem_Util is -- Determine whether arbitrary node N denotes a reference to an atomic -- object as per Ada RM C.6(7) and the crucial remark in C.6(8). - -- WARNING: There is a matching C declaration of this subprogram in fe.h - function Is_Atomic_Object_Entity (Id : Entity_Id) return Boolean; -- Determine whether arbitrary entity Id denotes an atomic object as per -- Ada RM C.6(12). @@ -2108,8 +2106,6 @@ package Sem_Util is -- for something actually declared as volatile, not for an object that gets -- treated as volatile (see Einfo.Treat_As_Volatile). - -- WARNING: There is a matching C declaration of this subprogram in fe.h - generic with procedure Handle_Parameter (Formal : Entity_Id; Actual : Node_Id); procedure Iterate_Call_Parameters (Call : Node_Id);