https://gcc.gnu.org/g:481fcc676950ee279d37f1cec84834dbb2aba87b

commit r15-6157-g481fcc676950ee279d37f1cec84834dbb2aba87b
Author: Eric Botcazou <ebotca...@adacore.com>
Date:   Thu Nov 21 15:28:43 2024 +0100

    ada: Elide the copy for bit-packed aggregates in object declarations
    
    The in-place expansion has been historically disabled for them, but there
    does not seem to be any good reason left for this.  However, this requires
    a small trick in order for the expanded code not to be flagged as using the
    object uninitialized by the code generator.
    
    gcc/ada/ChangeLog:
    
            * exp_aggr.adb (Convert_Aggr_In_Object_Decl): Clear the component
            referenced on the right-hand side of the first assignment generated
            for a bit-packed array, if any.
            (Expand_Array_Aggregate): Do not exclude aggregates of bit-packed
            array types in object declarations from in-place expansion.
            * sem_eval.adb (Eval_Indexed_Component): Do not attempt a constant
            evaluation for a bit-packed array type.

Diff:
---
 gcc/ada/exp_aggr.adb | 36 +++++++++++++++++++++++++++++-------
 gcc/ada/sem_eval.adb |  8 ++++++--
 2 files changed, 35 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 364af2283592..c01011cc1fb5 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -3811,6 +3811,31 @@ package body Exp_Aggr is
          end loop;
       end if;
 
+      --  If Typ is a bit-packed array and the first statement generated for
+      --  the aggregate initialization is an assignment of the form:
+
+      --    Obj (j) := (Obj (j) [and Mask]) or Val
+
+      --  then we initialize Obj (j) right before the assignment, in order to
+      --  avoid a spurious warning about Obj being used uninitialized.
+
+      if Is_Bit_Packed_Array (Typ) then
+         Stmt := Next (N);
+
+         if Stmt /= Marker
+           and then Nkind (Stmt) = N_Assignment_Statement
+           and then Nkind (Expression (Stmt)) in N_Op_And | N_Op_Or
+           and then Nkind (Name (Stmt)) = N_Indexed_Component
+           and then Is_Entity_Name (Prefix (Name (Stmt)))
+           and then Entity (Prefix (Name (Stmt))) = Obj
+         then
+            Insert_Action (Stmt,
+              Make_Assignment_Statement (Loc,
+                Name       => New_Copy_Tree (Name (Stmt)),
+                Expression => Make_Integer_Literal (Loc, Uint_0)));
+         end if;
+      end if;
+
       --  After expansion the expression can be removed from the declaration
       --  except if the object is class-wide, in which case the aggregate
       --  provides the actual type.
@@ -6163,9 +6188,8 @@ package body Exp_Aggr is
                                       Designated_Type (Etype (Parent_Node)),
                                       Typ)))
 
-         --  Object declaration (see Convert_Aggr_In_Object_Decl). Bit-packed
-         --  array types need specific processing and sliding cannot be done
-         --  in place for the time being.
+         --  Object declaration (see Convert_Aggr_In_Object_Decl). Sliding
+         --  cannot be done in place for the time being.
 
          or else (Parent_Kind = N_Object_Declaration
                    and then
@@ -6174,13 +6198,11 @@ package body Exp_Aggr is
                        or else Needs_Finalization (Typ)
                        or else Is_Special_Return_Object
                                  (Defining_Identifier (Parent_Node))
-                       or else (not Is_Bit_Packed_Array (Typ)
-                                 and then not
-                                   Must_Slide
+                       or else not Must_Slide
                                      (N,
                                       Etype
                                         (Defining_Identifier (Parent_Node)),
-                                      Typ))))
+                                      Typ)))
 
          --  Safe assignment (see Convert_Aggr_In_Assignment). So far only the
          --  assignments in init procs are taken into account, as well those
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index f0f83d29c383..c55e4d3bb24b 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -2696,9 +2696,13 @@ package body Sem_Eval is
 
             --  If we have an array type (we should have but perhaps there are
             --  error cases where this is not the case), then see if we can do
-            --  a constant evaluation of the array reference.
+            --  a constant evaluation of the array reference, although specific
+            --  processing would be required if the array type is bit-packed.
 
-            if Is_Array_Type (Atyp) and then Atyp /= Any_Composite then
+            if Is_Array_Type (Atyp)
+              and then not Is_Bit_Packed_Array (Atyp)
+              and then Atyp /= Any_Composite
+            then
                if Ekind (Atyp) = E_String_Literal_Subtype then
                   Lbd := String_Literal_Low_Bound (Atyp);
                else

Reply via email to