public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Ada] Extend No_Dependence restriction to code generation
@ 2022-07-13 10:03 Pierre-Marie de Rodat
  0 siblings, 0 replies; 2+ messages in thread
From: Pierre-Marie de Rodat @ 2022-07-13 10:03 UTC (permalink / raw)
  To: gcc-patches; +Cc: Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 1062 bytes --]

This reports violations for 4 units from gigi.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* gcc-interface/trans.cc (gigi): Report a violation of No_Dependence
	on System.Stack_Checking if Stack_Check_Probes_On_Target is not set
	and -fstack-check is specified.
	(build_binary_op_trapv): Report violatiosn of No_Dependence on both
	System.Arith_64 and System.Arith_128.
	(add_decl_expr): If an initialized variable, report a violation of
	No_Dependence on System.Memory_Copy for large aggregate types.
	(gnat_to_gnu) <N_Op_Eq>: Report a violation
	of No_Dependence on System.Memory_Compare for large aggregate types.
	<N_Assignment_Statement>! Report a violation of No_Dependence on
	System.Memory_Set, System.Memory_Move or else System.Memory_Copy for
	large aggregate types.
	* gcc-interface/utils2.cc (maybe_wrap_malloc): Report a violation of
	No_Dependence on System.Memory.
	(maybe_wrap_free): Add GNAT_NODE parameter and report a violation of
	No_Dependence on System.Memory.
	(build_call_alloc_dealloc): Adjust call to maybe_wrap_free.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 7377 bytes --]

diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -364,7 +364,12 @@ gigi (Node_Id gnat_root,
 
   /* Enable GNAT stack checking method if needed */
   if (!Stack_Check_Probes_On_Target)
-    set_stack_check_libfunc ("__gnat_stack_check");
+    {
+      set_stack_check_libfunc ("__gnat_stack_check");
+      if (flag_stack_check != NO_STACK_CHECK)
+	Check_Restriction_No_Dependence_On_System (Name_Stack_Checking,
+						   gnat_root);
+    }
 
   /* Retrieve alignment settings.  */
   double_float_alignment = get_target_double_float_alignment ();
@@ -6933,9 +6938,18 @@ gnat_to_gnu (Node_Id gnat_node)
 	      = convert (TREE_TYPE (gnu_rhs), TYPE_SIZE (gnu_type));
 	  }
 
+	/* If this is a comparison between (potentially) large aggregates, then
+	   declare the dependence on the memcmp routine.  */
+	else if ((kind == N_Op_Eq || kind == N_Op_Ne)
+		 && AGGREGATE_TYPE_P (TREE_TYPE (gnu_lhs))
+		 && (!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_lhs)))
+		     || compare_tree_int (TYPE_SIZE (TREE_TYPE (gnu_lhs)),
+					  2 * BITS_PER_WORD) > 0))
+	  Check_Restriction_No_Dependence_On_System (Name_Memory_Compare,
+						     gnat_node);
+
 	/* Pending generic support for efficient vector logical operations in
-	   GCC, convert vectors to their representative array type view and
-	   fallthrough.  */
+	   GCC, convert vectors to their representative array type view.  */
 	gnu_lhs = maybe_vector_array (gnu_lhs);
 	gnu_rhs = maybe_vector_array (gnu_rhs);
 
@@ -7254,6 +7268,8 @@ gnat_to_gnu (Node_Id gnat_node)
 		  value = int_const_binop (BIT_AND_EXPR, value, mask);
 		}
 	      gnu_result = build_call_expr (t, 3, dest, value, size);
+	      Check_Restriction_No_Dependence_On_System (Name_Memory_Set,
+							 gnat_node);
 	    }
 
 	  /* Otherwise build a regular assignment.  */
@@ -7278,7 +7294,18 @@ gnat_to_gnu (Node_Id gnat_node)
 	      tree from_ptr = build_fold_addr_expr (from);
 	      tree t = builtin_decl_explicit (BUILT_IN_MEMMOVE);
 	      gnu_result = build_call_expr (t, 3, to_ptr, from_ptr, size);
+	      Check_Restriction_No_Dependence_On_System (Name_Memory_Move,
+							 gnat_node);
 	   }
+
+	  /* If this is an assignment between (potentially) large aggregates,
+	     then declare the dependence on the memcpy routine.  */
+	  else if (AGGREGATE_TYPE_P (TREE_TYPE (gnu_lhs))
+		   && (!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_lhs)))
+		       || compare_tree_int (TYPE_SIZE (TREE_TYPE (gnu_lhs)),
+					    2 * BITS_PER_WORD) > 0))
+	    Check_Restriction_No_Dependence_On_System (Name_Memory_Copy,
+						       gnat_node);
 	}
       break;
 
@@ -8437,27 +8464,37 @@ add_decl_expr (tree gnu_decl, Node_Id gnat_node)
       && !TYPE_FAT_POINTER_P (type))
     MARK_VISITED (TYPE_ADA_SIZE (type));
 
-  /* If this is a variable and an initializer is attached to it, it must be
-     valid for the context.  Similar to init_const in create_var_decl.  */
-  if (TREE_CODE (gnu_decl) == VAR_DECL
-      && (gnu_init = DECL_INITIAL (gnu_decl))
-      && (!gnat_types_compatible_p (type, TREE_TYPE (gnu_init))
+  if (TREE_CODE (gnu_decl) == VAR_DECL && (gnu_init = DECL_INITIAL (gnu_decl)))
+    {
+      /* If this is a variable and an initializer is attached to it, it must be
+	 valid for the context.  Similar to init_const in create_var_decl.  */
+      if (!gnat_types_compatible_p (type, TREE_TYPE (gnu_init))
 	  || (TREE_STATIC (gnu_decl)
 	      && !initializer_constant_valid_p (gnu_init,
-						TREE_TYPE (gnu_init)))))
-    {
-      DECL_INITIAL (gnu_decl) = NULL_TREE;
-      if (TREE_READONLY (gnu_decl))
+						TREE_TYPE (gnu_init))))
 	{
-	  TREE_READONLY (gnu_decl) = 0;
-	  DECL_READONLY_ONCE_ELAB (gnu_decl) = 1;
-	}
+	  DECL_INITIAL (gnu_decl) = NULL_TREE;
+	  if (TREE_READONLY (gnu_decl))
+	    {
+	      TREE_READONLY (gnu_decl) = 0;
+	      DECL_READONLY_ONCE_ELAB (gnu_decl) = 1;
+	    }
+
+	  /* Remove any padding so the assignment is done properly.  */
+	  gnu_decl = maybe_padded_object (gnu_decl);
 
-      /* Remove any padding so the assignment is done properly.  */
-      gnu_decl = maybe_padded_object (gnu_decl);
+	  gnu_stmt
+	    = build_binary_op (INIT_EXPR, NULL_TREE, gnu_decl, gnu_init);
+	  add_stmt_with_node (gnu_stmt, gnat_node);
+	}
 
-      gnu_stmt = build_binary_op (INIT_EXPR, NULL_TREE, gnu_decl, gnu_init);
-      add_stmt_with_node (gnu_stmt, gnat_node);
+      /* If this is the initialization of a (potentially) large aggregate, then
+	 declare the dependence on the memcpy routine.  */
+      if (AGGREGATE_TYPE_P (type)
+	  && (!TREE_CONSTANT (TYPE_SIZE (type))
+	      || compare_tree_int (TYPE_SIZE (type), 2 * BITS_PER_WORD) > 0))
+	Check_Restriction_No_Dependence_On_System (Name_Memory_Copy,
+						   gnat_node);
     }
 }
 
@@ -9359,6 +9396,7 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
       if (code == MULT_EXPR && precision == 64 && BITS_PER_WORD < 64)
 	{
 	  tree int64 = gnat_type_for_size (64, 0);
+	  Check_Restriction_No_Dependence_On_System (Name_Arith_64, gnat_node);
 	  return convert (gnu_type, build_call_n_expr (mulv64_decl, 2,
 						       convert (int64, lhs),
 						       convert (int64, rhs)));
@@ -9368,6 +9406,7 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
       else if (code == MULT_EXPR && precision == 128 && BITS_PER_WORD < 128)
 	{
 	  tree int128 = gnat_type_for_size (128, 0);
+	  Check_Restriction_No_Dependence_On_System (Name_Arith_128, gnat_node);
 	  return convert (gnu_type, build_call_n_expr (mulv128_decl, 2,
 						       convert (int128, lhs),
 						       convert (int128, rhs)));


diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -2259,6 +2259,8 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
 
   tree malloc_ptr = build_call_n_expr (malloc_decl, 1, size_to_malloc);
 
+  Check_Restriction_No_Dependence_On_System (Name_Memory, gnat_node);
+
   if (aligning_type)
     {
       /* Latch malloc's return value and get a pointer to the aligning field
@@ -2305,7 +2307,7 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
    designated by DATA_PTR using the __gnat_free entry point.  */
 
 static inline tree
-maybe_wrap_free (tree data_ptr, tree data_type)
+maybe_wrap_free (tree data_ptr, tree data_type, Node_Id gnat_node)
 {
   /* In the regular alignment case, we pass the data pointer straight to free.
      In the superaligned case, we need to retrieve the initial allocator
@@ -2317,6 +2319,8 @@ maybe_wrap_free (tree data_ptr, tree data_type)
 
   tree free_ptr;
 
+  Check_Restriction_No_Dependence_On_System (Name_Memory, gnat_node);
+
   if (data_align > system_allocator_alignment)
     {
       /* DATA_FRONT_PTR (void *)
@@ -2363,7 +2367,7 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, tree gnu_type,
   /* Otherwise, object to "free" or "malloc" with possible special processing
      for alignments stricter than what the default allocator honors.  */
   else if (gnu_obj)
-    return maybe_wrap_free (gnu_obj, gnu_type);
+    return maybe_wrap_free (gnu_obj, gnu_type, gnat_node);
   else
     {
       /* Assert that we no longer can be called with this special pool.  */



^ permalink raw reply	[flat|nested] 2+ messages in thread

* [Ada] Extend No_Dependence restriction to code generation
@ 2022-07-12 12:25 Pierre-Marie de Rodat
  0 siblings, 0 replies; 2+ messages in thread
From: Pierre-Marie de Rodat @ 2022-07-12 12:25 UTC (permalink / raw)
  To: gcc-patches; +Cc: Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 1011 bytes --]

This makes it possible to report violations of the No_Dependence restriction
during code generation, in other words outside of the Ada front-end proper.
These violations are supposed to be only for child units of System, so the
implementation is restricted to these cases.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* restrict.ads (type ND_Entry): Add System_Child component.
	(Check_Restriction_No_Dependence_On_System): Declare.
	* restrict.adb (Global_Restriction_No_Tasking): Move around.
	(Violation_Of_No_Dependence): New procedure.
	(Check_Restriction_No_Dependence): Call Violation_Of_No_Dependence
	to report a violation.
	(Check_Restriction_No_Dependence_On_System): New procedure.
	(Set_Restriction_No_Dependenc): Set System_Child component if the
	unit is a child of System.
	* snames.ads-tmpl (Name_Arith_64): New package name.
	(Name_Arith_128): Likewise.
	(Name_Memory): Likewise.
	(Name_Stack_Checking): Likewise.
	* fe.h (Check_Restriction_No_Dependence_On_System): Declare.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 8589 bytes --]

diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -252,6 +252,8 @@ extern Boolean SJLJ_Exceptions		(void);
   restrict__check_no_implicit_protected_alloc
 #define Check_No_Implicit_Task_Alloc	\
   restrict__check_no_implicit_task_alloc
+#define Check_Restriction_No_Dependence_On_System \
+  restrict__check_restriction_no_dependence_on_system
 #define No_Exception_Handlers_Set	\
   restrict__no_exception_handlers_set
 #define No_Exception_Propagation_Active	\
@@ -262,6 +264,7 @@ extern void Check_Implicit_Dynamic_Code_Allowed	(Node_Id);
 extern void Check_No_Implicit_Heap_Alloc	(Node_Id);
 extern void Check_No_Implicit_Protected_Alloc	(Node_Id);
 extern void Check_No_Implicit_Task_Alloc	(Node_Id);
+extern void Check_Restriction_No_Dependence_On_System (Name_Id, Node_Id);
 extern Boolean No_Exception_Handlers_Set	(void);
 extern Boolean No_Exception_Propagation_Active	(void);
 


diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -44,10 +44,6 @@ with Uname;          use Uname;
 
 package body Restrict is
 
-   Global_Restriction_No_Tasking : Boolean := False;
-   --  Set to True when No_Tasking is set in the run-time package System
-   --  or in a configuration pragmas file (for example, gnat.adc).
-
    --------------------------------
    -- Package Local Declarations --
    --------------------------------
@@ -55,6 +51,10 @@ package body Restrict is
    Config_Cunit_Boolean_Restrictions : Save_Cunit_Boolean_Restrictions;
    --  Save compilation unit restrictions set by config pragma files
 
+   Global_Restriction_No_Tasking : Boolean := False;
+   --  Set to True when No_Tasking is set in the run-time package System
+   --  or in a configuration pragmas file (for example, gnat.adc).
+
    Restricted_Profile_Result : Boolean := False;
    --  This switch memoizes the result of Restricted_Profile function calls for
    --  improved efficiency. Valid only if Restricted_Profile_Cached is True.
@@ -122,6 +122,11 @@ package body Restrict is
    --  message is to be suppressed if this is an internal file and this file is
    --  not the main unit. Returns True if message is to be suppressed.
 
+   procedure Violation_Of_No_Dependence (Unit : Int; N : Node_Id);
+   --  Called if a violation of restriction No_Dependence for Unit at node N
+   --  is found. This routine outputs the appropriate message, taking care of
+   --  warning vs real violation.
+
    -------------------
    -- Abort_Allowed --
    -------------------
@@ -550,8 +555,6 @@ package body Restrict is
    -------------------------------------
 
    procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id) is
-      DU : Node_Id;
-
    begin
       --  Ignore call if node U is not in the main source unit. This avoids
       --  cascaded errors, e.g. when Ada.Containers units with other units.
@@ -567,26 +570,33 @@ package body Restrict is
       --  Loop through entries in No_Dependence table to check each one in turn
 
       for J in No_Dependences.First .. No_Dependences.Last loop
-         DU := No_Dependences.Table (J).Unit;
+         if Same_Unit (No_Dependences.Table (J).Unit, U) then
+            Violation_Of_No_Dependence (J, Err);
+            return;
+         end if;
+      end loop;
+   end Check_Restriction_No_Dependence;
 
-         if Same_Unit (U, DU) then
-            Error_Msg_Sloc := Sloc (DU);
-            Error_Msg_Node_1 := DU;
+   -----------------------------------------------
+   -- Check_Restriction_No_Dependence_On_System --
+   -----------------------------------------------
 
-            if No_Dependences.Table (J).Warn then
-               Error_Msg
-                 ("?*?violation of restriction `No_Dependence '='> &`#",
-                  Sloc (Err));
-            else
-               Error_Msg
-                 ("|violation of restriction `No_Dependence '='> &`#",
-                  Sloc (Err));
-            end if;
+   procedure Check_Restriction_No_Dependence_On_System
+     (U   : Name_Id;
+      Err : Node_Id)
+   is
+      pragma Assert (U /= No_Name);
+
+   begin
+      --  Loop through entries in No_Dependence table to check each one in turn
 
+      for J in No_Dependences.First .. No_Dependences.Last loop
+         if No_Dependences.Table (J).System_Child = U then
+            Violation_Of_No_Dependence (J, Err);
             return;
          end if;
       end loop;
-   end Check_Restriction_No_Dependence;
+   end Check_Restriction_No_Dependence_On_System;
 
    --------------------------------------------------
    -- Check_Restriction_No_Specification_Of_Aspect --
@@ -1474,6 +1484,8 @@ package body Restrict is
       Warn    : Boolean;
       Profile : Profile_Name := No_Profile)
    is
+      ND : ND_Entry;
+
    begin
       --  Loop to check for duplicate entry
 
@@ -1495,7 +1507,26 @@ package body Restrict is
 
       --  Entry is not currently in table
 
-      No_Dependences.Append ((Unit, Warn, Profile));
+      ND := (Unit, No_Name, Warn, Profile);
+
+      --  Check whether this is a child unit of System
+
+      if Nkind (Unit) = N_Selected_Component then
+         declare
+            Root : Node_Id := Unit;
+
+         begin
+            while Nkind (Prefix (Root)) = N_Selected_Component loop
+               Root := Prefix (Root);
+            end loop;
+
+            if Chars (Prefix (Root)) = Name_System then
+               ND.System_Child := Chars (Selector_Name (Root));
+            end if;
+         end;
+      end if;
+
+      No_Dependences.Append (ND);
    end Set_Restriction_No_Dependence;
 
    --------------------------------------
@@ -1647,6 +1678,24 @@ package body Restrict is
       end if;
    end Suppress_Restriction_Message;
 
+   --------------------------------
+   -- Violation_Of_No_Dependence --
+   --------------------------------
+
+   procedure Violation_Of_No_Dependence (Unit : Int; N : Node_Id) is
+   begin
+      Error_Msg_Node_1 := No_Dependences.Table (Unit).Unit;
+      Error_Msg_Sloc   := Sloc (Error_Msg_Node_1);
+
+      if No_Dependences.Table (Unit).Warn then
+         Error_Msg
+           ("?*?violation of restriction `No_Dependence '='> &`#", Sloc (N));
+      else
+         Error_Msg
+           ("|violation of restriction `No_Dependence '='> &`#", Sloc (N));
+      end if;
+   end Violation_Of_No_Dependence;
+
    ---------------------
    -- Tasking_Allowed --
    ---------------------


diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -168,6 +168,9 @@ package Restrict is
       Unit : Node_Id;
       --  The unit parameter from the No_Dependence pragma
 
+      System_Child : Name_Id;
+      --  The name if the unit is a child of System, or else No_Name
+
       Warn : Boolean;
       --  True if from Restriction_Warnings, False if from Restrictions
 
@@ -269,6 +272,13 @@ package Restrict is
    --  an explicit WITH clause). U is a node for the unit involved, and Err is
    --  the node to which an error will be attached if necessary.
 
+   procedure Check_Restriction_No_Dependence_On_System
+     (U   : Name_Id;
+      Err : Node_Id);
+   --  Likewise, but for the child units of System referenced by their name
+
+   --  WARNING: There is a matching C declaration of this subprogram in fe.h
+
    procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id);
    --  N is the node id for an N_Aspect_Specification, an N_Pragma, or an
    --  N_Attribute_Definition_Clause. An error message (warning) will be issued


diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -274,10 +274,14 @@ package Snames is
 
    --  Names for packages that are treated specially by the compiler
 
+   Name_Arith_64                       : constant Name_Id := N + $;
+   Name_Arith_128                      : constant Name_Id := N + $;
    Name_Exception_Traces               : constant Name_Id := N + $;
    Name_Finalization                   : constant Name_Id := N + $;
    Name_Interfaces                     : constant Name_Id := N + $;
+   Name_Memory                         : constant Name_Id := N + $;
    Name_Most_Recent_Exception          : constant Name_Id := N + $;
+   Name_Stack_Checking                 : constant Name_Id := N + $;
    Name_Standard                       : constant Name_Id := N + $;
    Name_System                         : constant Name_Id := N + $;
    Name_Text_IO                        : constant Name_Id := N + $;



^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2022-07-13 10:03 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-13 10:03 [Ada] Extend No_Dependence restriction to code generation Pierre-Marie de Rodat
  -- strict thread matches above, loose matches on Subject: below --
2022-07-12 12:25 Pierre-Marie de Rodat

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).