+2019-12-16 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_ch6.adb (Requires_Atomic_Or_Volatile_Copy): New predicate.
+ (Expand_Actuals): Use it to decide whether to add call by copy
+ code as per the RM C.6(19) clause.
+ * fe.h (Is_Atomic_Object): Remove.
+ (Is_Volatile_Object): Likewise.
+ * sem_util.ads (Is_Atomic_Object): Remove WARNING note.
+ (Is_Volatile_Object): Likewise.
+ * gcc-interface/trans.c (atomic_or_volatile_copy_required_p): Delete.
+ (Call_to_gnu): Do not implement the RM C.6(19) clause.
+
2019-12-16 Ghjuvan Lacambre <lacambre@adacore.com>
* sem_ch12.adb (Validate_Access_Subprogram_Instance): Add
-- 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 --
---------------------------
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
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
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.
#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);
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.
= 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
}
/* 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
(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);
-- 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).
-- 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);