This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Optimize calls to pure functions with by-ref In parameter


With GNAT you can declare a function as pure with a dedicated pragma, even if 
it takes a parameter passed by reference.  In this case, if the parameter is 
declared as In (the default), the language additionally guarantees that it is 
not modified, thus making the function also pure in the GCC sense.

Tested on x86-64/Linux, applied on the mainline.


2018-07-07  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_param): Minor tweak.
	(gnat_to_gnu_subprog_type): New pure_flag local variable.  Set it for
	a pure Ada function with a by-ref In parameter.  Propagate it onto the
	function type by means of the TYPE_QUAL_RESTRICT flag.
	* gcc-interface/utils.c (finish_subprog_decl): Set DECL_PURE_P if the
	function type has the TYPE_QUAL_RESTRICT flag set.


2018-07-07  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/pure_function3a.adb: New test.
	* gnat.dg/pure_function3b.adb: Likewise.
	* gnat.dg/pure_function3c.adb: Likewise.
	* gnat.dg/pure_function3_pkg.ads: New helper.

-- 
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 262468)
+++ gcc-interface/decl.c	(working copy)
@@ -5228,7 +5228,6 @@ gnat_to_gnu_param (Entity_Id gnat_param,
 	     && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_param_type)))
 	gnu_param_type = TREE_TYPE (gnu_param_type);
 
-      by_component_ptr = true;
       gnu_param_type = TREE_TYPE (gnu_param_type);
 
       if (ro_param)
@@ -5236,6 +5235,7 @@ gnat_to_gnu_param (Entity_Id gnat_param,
 	  = change_qualified_type (gnu_param_type, TYPE_QUAL_CONST);
 
       gnu_param_type = build_pointer_type (gnu_param_type);
+      by_component_ptr = true;
     }
 
   /* Fat pointers are passed as thin pointers for foreign conventions.  */
@@ -5561,14 +5561,15 @@ gnat_to_gnu_subprog_type (Entity_Id gnat
   /* Fields in return type of procedure with copy-in copy-out parameters.  */
   tree gnu_field_list = NULL_TREE;
   /* The semantics of "pure" in Ada essentially matches that of "const"
-     in the back-end.  In particular, both properties are orthogonal to
-     the "nothrow" property if the EH circuitry is explicit in the
-     internal representation of the back-end.  If we are to completely
+     or "pure" in GCC.  In particular, both properties are orthogonal
+     to the "nothrow" property if the EH circuitry is explicit in the
+     internal representation of the middle-end.  If we are to completely
      hide the EH circuitry from it, we need to declare that calls to pure
      Ada subprograms that can throw have side effects since they can
-     trigger an "abnormal" transfer of control flow; thus they can be
-     neither "const" nor "pure" in the back-end sense.  */
+     trigger an "abnormal" transfer of control flow; therefore, they can
+     be neither "const" nor "pure" in the GCC sense.  */
   bool const_flag = (Back_End_Exceptions () && Is_Pure (gnat_subprog));
+  bool pure_flag = false;
   bool return_by_direct_ref_p = false;
   bool return_by_invisi_ref_p = false;
   bool return_unconstrained_p = false;
@@ -5849,13 +5850,19 @@ gnat_to_gnu_subprog_type (Entity_Id gnat
 	  gnu_param_list = chainon (gnu_param, gnu_param_list);
 	  save_gnu_tree (gnat_param, gnu_param, false);
 
-	  /* If a parameter is a pointer, a function may modify memory through
-	     it and thus shouldn't be considered a const function.   Also, the
-	     memory may be modified between two calls, so they can't be CSE'ed.
-	     The latter case also handles by-ref parameters.  */
-	  if (POINTER_TYPE_P (gnu_param_type)
-	      || TYPE_IS_FAT_POINTER_P (gnu_param_type))
-	    const_flag = false;
+	  /* A pure function in the Ada sense which takes an access parameter
+	     may modify memory through it and thus need be considered neither
+	     const nor pure in the GCC sense.  Likewise it if takes a by-ref
+	     In Out or Out parameter.  But if it takes a by-ref In parameter,
+	     then it may only read memory through it and can be considered
+	     pure in the GCC sense.  */
+	  if ((const_flag || pure_flag)
+	      && (POINTER_TYPE_P (gnu_param_type)
+		  || TYPE_IS_FAT_POINTER_P (gnu_param_type)))
+	    {
+	      const_flag = false;
+	      pure_flag = DECL_POINTS_TO_READONLY_P (gnu_param);
+	    }
 	}
 
       /* If the parameter uses the copy-in copy-out mechanism, allocate a field
@@ -6007,6 +6014,9 @@ gnat_to_gnu_subprog_type (Entity_Id gnat
       if (const_flag)
 	gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_CONST);
 
+      if (pure_flag)
+	gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_RESTRICT);
+
       if (No_Return (gnat_subprog))
 	gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
 
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 262468)
+++ gcc-interface/utils.c	(working copy)
@@ -3330,6 +3330,9 @@ finish_subprog_decl (tree decl, tree asm
   /* Propagate the "const" property.  */
   TREE_READONLY (decl) = TYPE_READONLY (type);
 
+  /* Propagate the "pure" property.  */
+  DECL_PURE_P (decl) = TYPE_RESTRICT (type);
+
   /* Propagate the "noreturn" property.  */
   TREE_THIS_VOLATILE (decl) = TYPE_VOLATILE (type);
 
package Pure_Function3_Pkg is

   type T is limited private;
   function F (Self : T) return Integer with Pure_Function;
   procedure Set (Self : in out T);
   function F_And_Set (Self : in out T) return Integer with Pure_Function;

private

   type T is limited record
      F : Integer;
   end record;

end Pure_Function3_Pkg;
-- { dg-do compile }
-- { dg-options "-O -gnatws -fdump-tree-optimized" }

with Pure_Function3_Pkg; use Pure_Function3_Pkg;

procedure Pure_Function3a is
   V : T;
begin
   if F (V) = 1 then
      raise Program_Error;
   elsif F (V) = 2 then
      raise Program_Error;
   end if;
end;

-- { dg-final { scan-tree-dump-times "pure_function3_pkg.f" 1 "optimized" } }
-- { dg-do compile }
-- { dg-options "-O -gnatws -fdump-tree-optimized" }

with Pure_Function3_Pkg; use Pure_Function3_Pkg;

procedure Pure_Function3b is
   V : T;
begin
   if F (V) = 1 then
      raise Program_Error;
   end if;
   Set (V);
   if F (V) = 2 then
      raise Program_Error;
   end if;
end;

-- { dg-final { scan-tree-dump-times "pure_function3_pkg.f" 2 "optimized" } }
-- { dg-do compile }
-- { dg-options "-O -gnatws -fdump-tree-optimized" }

with Pure_Function3_Pkg; use Pure_Function3_Pkg;

procedure Pure_Function3c is
   V : T;
begin
   if F_And_Set (V) = 1 then
      raise Program_Error;
   elsif F_And_Set (V) = 2 then
      raise Program_Error;
   end if;
end;

-- { dg-final { scan-tree-dump-times "pure_function3_pkg.f" 2 "optimized" } }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]