[Ada] Implement RM C.6(19) clause entirely in the front-end
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 16 Dec 2019 10:33:17 +0000 (10:33 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Mon, 16 Dec 2019 10:33:17 +0000 (10:33 +0000)
2019-12-16  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

* 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.

From-SVN: r279414

gcc/ada/ChangeLog
gcc/ada/exp_ch6.adb
gcc/ada/fe.h
gcc/ada/gcc-interface/trans.c
gcc/ada/sem_util.ads

index f110a9b9c0837a9be61061e4190778c81f41ea00..0f843f3b66eefd9f9fc6a0288195a889ae944b97 100644 (file)
@@ -1,3 +1,15 @@
+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
index c03cd7c535286b67f9fd7c8dbe1c02eb2b532c6a..62934c3d44e2de6373a9189d84443698bb2b39b9 100644 (file)
@@ -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.
 
index 0ccd1a01ddd5c5eb3ab45629af5977dedd2fed7a..74eb2ad3e1d6191268b1e910a4a4c02fcc0cbd10 100644 (file)
@@ -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);
 
index ef16a08498bd67362500755e3088dbe5a497daf1..e1b09bedeb1d1467971a28021874d97177a45f98 100644 (file)
@@ -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);
index c156651c22f93ac044281573a3170d910adfbd07..89fa579a0cc44f0af72ae6a4f02ccded861f1f55 100644 (file)
@@ -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);