[gcc r12-6595] Fix reverse scalar storage order issues in IPA-SRA

[gcc r12-6595] Fix reverse scalar storage order issues in IPA-SRA

[Eric Botcazou]

https://gcc.gnu.org/g:c76b3bc55b4603d38cc948f4076264af5c0b95aa

commit r12-6595-gc76b3bc55b4603d38cc948f4076264af5c0b95aa
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Fri Jan 14 19:49:21 2022 +0100

    Fix reverse scalar storage order issues in IPA-SRA
    
    The IPA-SRA pass introduced in GCC 10 does not always play nice with the
    reverse scalar storage order that can be used in structures/records/unions.
    Reading the code, the pass apparently correctly detects it but fails to
    propagate the information to the rewriting phase in some cases and, in
    particular, does not stream it for LTO.
    
    gcc/
            * ipa-param-manipulation.c (ipa_dump_adjusted_parameters): Dump
            reverse flag as "reverse" for the sake of consistency.
            * ipa-sra.c: Fix copyright year.
            (ipa_sra_function_summaries::duplicate): Copy the reverse flag.
            (dump_isra_access): Tweak dump line.
            (isra_write_node_summary): Write the reverse flag.
            (isra_read_node_info): Read it.
            (pull_accesses_from_callee): Test its consistency and copy it.
    
    gcc/testsuite/
            * gnat.dg/lto25.adb: New test.
            * gnat.dg/opt96.adb: Likewise.
            * gnat.dg/opt96_pkg.ads, gnat.dg/opt96_pkg.adb: New helper.

Diff:
---
 gcc/ipa-param-manipulation.c        |  2 +-
 gcc/ipa-sra.c                       | 56 ++++++++++++++++++-------------------
 gcc/testsuite/gnat.dg/lto25.adb     | 14 ++++++++++
 gcc/testsuite/gnat.dg/opt96.adb     | 14 ++++++++++
 gcc/testsuite/gnat.dg/opt96_pkg.adb | 16 +++++++++++
 gcc/testsuite/gnat.dg/opt96_pkg.ads | 32 +++++++++++++++++++++
 6 files changed, 105 insertions(+), 29 deletions(-)

diff --git a/gcc/ipa-param-manipulation.c b/gcc/ipa-param-manipulation.c
index 4973bfb67dd..fa6815e0941 100644
--- a/gcc/ipa-param-manipulation.c
+++ b/gcc/ipa-param-manipulation.c
@@ -228,7 +228,7 @@ ipa_dump_adjusted_parameters (FILE *f,
 	  fprintf (f, " prefix: %s",
 		   ipa_param_prefixes[apm->param_prefix_index]);
 	  if (apm->reverse)
-	    fprintf (f, ", reverse-sso");
+	    fprintf (f, ", reverse");
 	  break;
 	}
       fprintf (f, "\n");
diff --git a/gcc/ipa-sra.c b/gcc/ipa-sra.c
index 45030a17c07..f300a328f2b 100644
--- a/gcc/ipa-sra.c
+++ b/gcc/ipa-sra.c
@@ -1,6 +1,5 @@
 /* Interprocedural scalar replacement of aggregates
-   Copyright (C) 2008-2022 Free Software Foundation, Inc.
-
+   Copyright (C) 2019-2022 Free Software Foundation, Inc.
    Contributed by Martin Jambor <mjambor@suse.cz>
 
 This file is part of GCC.
@@ -21,7 +20,7 @@ along with GCC; see the file COPYING3.  If not see
 
 /* IPA-SRA is an interprocedural pass that removes unused function return
    values (turning functions returning a value which is never used into void
-   functions), removes unused function parameters.  It can also replace an
+   functions) and removes unused function parameters.  It can also replace an
    aggregate parameter by a set of other parameters representing part of the
    original, turning those passed by reference into new ones which pass the
    value directly.
@@ -57,7 +56,6 @@ along with GCC; see the file COPYING3.  If not see
    ipa-param-manipulation.h for more details.  */
 
 
-
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
@@ -93,7 +91,7 @@ static void ipa_sra_summarize_function (cgraph_node *);
 #define ISRA_ARG_SIZE_LIMIT_BITS 16
 #define ISRA_ARG_SIZE_LIMIT (1 << ISRA_ARG_SIZE_LIMIT_BITS)
 /* How many parameters can feed into a call actual argument and still be
-   tracked. */
+   tracked.  */
 #define IPA_SRA_MAX_PARAM_FLOW_LEN 7
 
 /* Structure describing accesses to a specific portion of an aggregate
@@ -122,7 +120,7 @@ struct GTY(()) param_access
      transformed function - initially not set for portions of formal parameters
      that are only used as actual function arguments passed to callees.  */
   unsigned certain : 1;
-  /* Set if the access has a reversed scalar storage order.  */
+  /* Set if the access has reverse scalar storage order.  */
   unsigned reverse : 1;
 };
 
@@ -156,7 +154,7 @@ struct gensum_param_access
      arguments to a function call that can be tracked.  */
   bool nonarg;
 
-  /* Set if the access has a reversed scalar storage order.  */
+  /* Set if the access has reverse scalar storage order.  */
   bool reverse;
 };
 
@@ -219,8 +217,8 @@ struct gensum_param_desc
 };
 
 /* Properly deallocate accesses of DESC.  TODO: Since this data structure is
-   not in GC memory, this is not necessary and we can consider removing the
-   function.  */
+   allocated in GC memory, this is not necessary and we can consider removing
+   the function.  */
 
 static void
 free_param_decl_accesses (isra_param_desc *desc)
@@ -275,9 +273,9 @@ public:
   unsigned m_queued : 1;
 };
 
-/* Clean up and deallocate isra_func_summary points to.  TODO: Since this data
-   structure is not in GC memory, this is not necessary and we can consider
-   removing the destructor.  */
+/* Deallocate the memory pointed to by isra_func_summary.  TODO: Since this
+   data structure is allocated in GC memory, this is not necessary and we can
+   consider removing the destructor.  */
 
 isra_func_summary::~isra_func_summary ()
 {
@@ -287,7 +285,6 @@ isra_func_summary::~isra_func_summary ()
   vec_free (m_parameters);
 }
 
-
 /* Mark the function as not a candidate for any IPA-SRA transformation.  Return
    true if it was a candidate until now.  */
 
@@ -297,6 +294,7 @@ isra_func_summary::zap ()
   bool ret = m_candidate;
   m_candidate = false;
 
+  /* TODO: see the destructor above.  */
   unsigned len = vec_safe_length (m_parameters);
   for (unsigned i = 0; i < len; ++i)
     free_param_decl_accesses (&(*m_parameters)[i]);
@@ -306,7 +304,7 @@ isra_func_summary::zap ()
 }
 
 /* Structure to describe which formal parameters feed into a particular actual
-   arguments.  */
+   argument.  */
 
 struct isra_param_flow
 {
@@ -426,6 +424,7 @@ ipa_sra_function_summaries::duplicate (cgraph_node *, cgraph_node *,
 	  to->unit_offset = from->unit_offset;
 	  to->unit_size = from->unit_size;
 	  to->certain = from->certain;
+	  to->reverse = from->reverse;
 	  d->accesses->quick_push (to);
 	}
     }
@@ -552,7 +551,7 @@ namespace {
 
 hash_map<tree, gensum_param_desc *> *decl2desc;
 
-/* Countdown of allowed Alias analysis steps during summary building.  */
+/* Countdown of allowed Alias Analysis steps during summary building.  */
 
 int aa_walking_limit;
 
@@ -665,7 +664,7 @@ dump_isra_access (FILE *f, param_access *access)
   if (access->certain)
     fprintf (f, ", certain");
   else
-    fprintf (f, ", not-certain");
+    fprintf (f, ", not certain");
   if (access->reverse)
     fprintf (f, ", reverse");
   fprintf (f, "\n");
@@ -927,8 +926,7 @@ isra_track_scalar_value_uses (function *fun, cgraph_node *node, tree name,
 
    This function is similar to ptr_parm_has_nonarg_uses but its results are
    meant for unused parameter removal, as opposed to splitting of parameters
-   passed by reference or converting them to passed by value.
-  */
+   passed by reference or converting them to passed by value.  */
 
 static bool
 isra_track_scalar_param_local_uses (function *fun, cgraph_node *node, tree parm,
@@ -968,8 +966,7 @@ isra_track_scalar_param_local_uses (function *fun, cgraph_node *node, tree parm,
    This function is similar to isra_track_scalar_param_local_uses but its
    results are meant for splitting of parameters passed by reference or turning
    them into bits passed by value, as opposed to generic unused parameter
-   removal.
- */
+   removal.  */
 
 static bool
 ptr_parm_has_nonarg_uses (cgraph_node *node, function *fun, tree parm,
@@ -1650,7 +1647,7 @@ record_nonregister_call_use (gensum_param_desc *desc,
 }
 
 /* Callback of walk_aliased_vdefs, just mark that there was a possible
-   modification. */
+   modification.  */
 
 static bool
 mark_maybe_modified (ao_ref *, tree, void *data)
@@ -2195,7 +2192,7 @@ static bool
 check_gensum_access (tree parm, gensum_param_desc *desc,
 		     gensum_param_access *access,
 		     HOST_WIDE_INT *nonarg_acc_size, bool *only_calls,
-		      int entry_bb_index)
+		     int entry_bb_index)
 {
   if (access->nonarg)
     {
@@ -2363,8 +2360,8 @@ process_scan_results (cgraph_node *node, struct function *fun,
      offset in this function at IPA level.
 
      TODO: Measure the overhead and the effect of just being pessimistic.
-     Maybe this is only -O3 material?
-  */
+     Maybe this is only -O3 material?  */
+
   bool pdoms_calculated = false;
   if (check_pass_throughs)
     for (cgraph_edge *cs = node->callees; cs; cs = cs->next_callee)
@@ -2584,6 +2581,7 @@ isra_write_node_summary (output_block *ob, cgraph_node *node)
 	  streamer_write_uhwi (ob, acc->unit_size);
 	  bitpack_d bp = bitpack_create (ob->main_stream);
 	  bp_pack_value (&bp, acc->certain, 1);
+	  bp_pack_value (&bp, acc->reverse, 1);
 	  streamer_write_bitpack (&bp);
 	}
       streamer_write_uhwi (ob, desc->param_size_limit);
@@ -2702,6 +2700,7 @@ isra_read_node_info (struct lto_input_block *ib, cgraph_node *node,
 	  acc->unit_size = streamer_read_uhwi (ib);
 	  bitpack_d bp = streamer_read_bitpack (ib);
 	  acc->certain = bp_unpack_value (&bp, 1);
+	  acc->reverse = bp_unpack_value (&bp, 1);
 	  vec_safe_push (desc->accesses, acc);
 	}
       desc->param_size_limit = streamer_read_uhwi (ib);
@@ -3161,7 +3160,7 @@ isra_mark_caller_param_used (isra_func_summary *from_ifs, int input_idx,
 
 /* Propagate information that any parameter is not used only locally within a
    SCC across CS to the caller, which must be in the same SCC as the
-   callee. Push any callers that need to be re-processed to STACK.  */
+   callee.  Push any callers that need to be re-processed to STACK.  */
 
 static void
 propagate_used_across_scc_edge (cgraph_edge *cs, vec<cgraph_node *> *stack)
@@ -3199,7 +3198,7 @@ propagate_used_across_scc_edge (cgraph_edge *cs, vec<cgraph_node *> *stack)
 
 /* Propagate information that any parameter is not used only locally within a
    SCC (i.e. is used also elsewhere) to all callers of NODE that are in the
-   same SCC. Push any callers that need to be re-processed to STACK.  */
+   same SCC.  Push any callers that need to be re-processed to STACK.  */
 
 static bool
 propagate_used_to_scc_callers (cgraph_node *node, void *data)
@@ -3292,7 +3291,8 @@ pull_accesses_from_callee (cgraph_node *caller, isra_param_desc *param_desc,
 	      && pacc->unit_size == argacc->unit_size)
 	    {
 	      if (argacc->alias_ptr_type != pacc->alias_ptr_type
-		  || !types_compatible_p (argacc->type, pacc->type))
+		  || !types_compatible_p (argacc->type, pacc->type)
+		  || argacc->reverse != pacc->reverse)
 		return "propagated access types would not match existing ones";
 
 	      exact_match = true;
@@ -3349,6 +3349,7 @@ pull_accesses_from_callee (cgraph_node *caller, isra_param_desc *param_desc,
 	  copy->type = argacc->type;
 	  copy->alias_ptr_type = argacc->alias_ptr_type;
 	  copy->certain = true;
+	  copy->reverse = argacc->reverse;
 	  vec_safe_push (param_desc->accesses, copy);
 	}
       else if (prop_kinds[j] == ACC_PROP_CERTAIN)
@@ -3610,7 +3611,6 @@ retval_used_p (cgraph_node *node, void *)
    PREV_ADJUSTMENT.  If the parent clone is the original function,
    PREV_ADJUSTMENT is NULL and PREV_CLONE_INDEX is equal to BASE_INDEX.  */
 
-
 static void
 push_param_adjustments_for_index (isra_func_summary *ifs, unsigned base_index,
 				  unsigned prev_clone_index,
diff --git a/gcc/testsuite/gnat.dg/lto25.adb b/gcc/testsuite/gnat.dg/lto25.adb
new file mode 100644
index 00000000000..242c8d68650
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/lto25.adb
@@ -0,0 +1,14 @@
+-- { dg-do run }
+-- { dg-options "-O2 -flto" { target lto } }
+
+with Opt96_Pkg; use Opt96_Pkg;
+
+procedure Lto25 is
+   R : Rec;
+   D : Data;
+begin
+   D.Foo.Bar := (0.02, 0.01);
+   if R.F (D) /= 30 then
+     raise Program_Error;
+   end if;
+end;
diff --git a/gcc/testsuite/gnat.dg/opt96.adb b/gcc/testsuite/gnat.dg/opt96.adb
new file mode 100644
index 00000000000..d91368b93f7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt96.adb
@@ -0,0 +1,14 @@
+-- { dg-do run }
+-- { dg-options "-O2" }
+
+with Opt96_Pkg; use Opt96_Pkg;
+
+procedure Opt96 is
+   R : Rec;
+   D : Data;
+begin
+   D.Foo.Bar := (0.02, 0.01);
+   if R.F (D) /= 30 then
+     raise Program_Error;
+   end if;
+end;
diff --git a/gcc/testsuite/gnat.dg/opt96_pkg.adb b/gcc/testsuite/gnat.dg/opt96_pkg.adb
new file mode 100644
index 00000000000..60fdb0deb84
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt96_pkg.adb
@@ -0,0 +1,16 @@
+package body Opt96_Pkg is
+
+   function F (D : Data) return Integer is
+      X : constant Long_Float := Long_Float (D.Foo.Bar.X);
+      Y : constant Long_Float := Long_Float (D.Foo.Bar.Y);
+   begin
+      return Integer ((X * 1000.0) + (Y * 1000.0));
+   end;
+
+   function F (Self : Rec; D  : Data'Class) return Integer is
+      Base_Data : constant Data := Data (D);
+   begin
+      return F (Base_Data);
+   end;
+
+end Opt96_Pkg;
diff --git a/gcc/testsuite/gnat.dg/opt96_pkg.ads b/gcc/testsuite/gnat.dg/opt96_pkg.ads
new file mode 100644
index 00000000000..7939c386ada
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt96_pkg.ads
@@ -0,0 +1,32 @@
+with System;
+
+package Opt96_Pkg is
+
+   type Baz_Type is delta (1.0 / 2.0**16) range 0.0 .. 1.0 - (1.0 / 2.0**16);
+   for Baz_Type'Small use (1.0 / 2.0**16);
+   for Baz_Type'Size use 16;
+
+   type Bar_Type is record
+     X : Baz_Type;
+     Y : Baz_Type;
+   end record;
+   for Bar_Type use record
+     X at 0 range 0 .. 15;
+     Y at 2 range 0 .. 15;
+   end record;
+   for Bar_Type'Bit_Order use System.High_Order_First;
+   for Bar_Type'Scalar_Storage_Order use System.High_Order_First;
+
+   type Foo_Type is record
+      Bar : Bar_Type;
+   end record;
+
+   type Data is tagged record
+     Foo : Foo_Type;
+   end record;
+
+   type Rec is tagged null record;
+
+   function F (Self : Rec; D  : Data'Class) return Integer;
+
+end Opt96_Pkg;