re PR ada/19900 (ACATS c391002 c432002 ICE categorize_ctor_elements_1)

2005-03-08  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	PR ada/19900

	* exp_pakd.adb (Create_Packed_Array_Type): Do not set
	Must_Be_Byte_Aligned for cases where we do not need to use a
	System.Pack_nn unit.

	* exp_ch6.adb (Expand_Call): Call Expand_Actuals for functions as well
	as procedures.
	Needed now that we do some processing for IN parameters as well. This
	may well fix some unrelated errors.
	(Expand_Call): Handle case of unaligned objects (in particular those
	that come from packed arrays).
	(Expand_Inlined_Call): If the subprogram is a renaming as body, and the
	renamed entity is an inherited operation, re-expand the call using the
	original operation, which is the one to call.
	Detect attempt to inline parameterless recursive subprogram.
	(Represented_As_Scalar): Fix to work properly with private types
	(Is_Possibly_Unaligned_Object): Major rewrite to get a much more
	accurate estimate. Yields True in far fewer cases than before,
	improving the quality of code that depends on this test.
	(Remove_Side_Effects): Properly test for Expansion_Delayed and handle
	case when it's inside an N_Qualified_Expression.

	* exp_util.adb (Kill_Dead_Code): For a package declaration, iterate
	over both visible and private declarations to remove them from tree,
	and mark subprograms declared in package as eliminated, to prevent
	spurious use in subsequent compilation of generic units in the context.

	* exp_util.ads: Minor cleanup in variable names

	* sem_eval.ads, sem_eval.adb: Minor reformatting
	(Compile_Time_Known_Bounds): New function

From-SVN: r96493

gcc/ada/exp_ch6.adb

@@ -123,6 +123,9 @@ package body Exp_Ch6 is
    --
    --  For all parameter modes, actuals that denote components and slices
    --  of packed arrays are expanded into suitable temporaries.
+   --
+   --  For non-scalar objects that are possibly unaligned, add call by copy
+   --  code (copy in for IN and IN OUT, copy out for OUT and IN OUT).
 
    procedure Expand_Inlined_Call
     (N         : Node_Id;
@@ -501,11 +504,10 @@ package body Exp_Ch6 is
       --  also takes care of any constraint checks required for the type
       --  conversion case (on both the way in and the way out).
 
-      procedure Add_Packed_Call_By_Copy_Code;
-      --  This is used when the actual involves a reference to an element
-      --  of a packed array, where we can appropriately use a simpler
-      --  approach than the full call by copy code. We just copy the value
-      --  in and out of an appropriate temporary.
+      procedure Add_Simple_Call_By_Copy_Code;
+      --  This is similar to the above, but is used in cases where we know
+      --  that all that is needed is to simply create a temporary and copy
+      --  the value in and out of the temporary.
 
       procedure Check_Fortran_Logical;
       --  A value of type Logical that is passed through a formal parameter
@@ -532,7 +534,7 @@ package body Exp_Ch6 is
          Expr  : Node_Id;
          Init  : Node_Id;
          Temp  : Entity_Id;
-         Indic : Node_Id := New_Occurrence_Of (Etype (Formal), Loc);
+         Indic : Node_Id;
          Var   : Entity_Id;
          F_Typ : constant Entity_Id := Etype (Formal);
          V_Typ : Entity_Id;
@@ -541,6 +543,17 @@ package body Exp_Ch6 is
       begin
          Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
 
+         --  Use formal type for temp, unless formal type is an unconstrained
+         --  array, in which case we don't have to worry about bounds checks,
+         --  and we use the actual type, since that has appropriate bonds.
+
+         if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
+            Indic := New_Occurrence_Of (Etype (Actual), Loc);
+         else
+            Indic := New_Occurrence_Of (Etype (Formal), Loc);
+         end if;
+
+
          if Nkind (Actual) = N_Type_Conversion then
             V_Typ := Etype (Expression (Actual));
 
@@ -584,7 +597,7 @@ package body Exp_Ch6 is
             then
                --  Actual is a one-dimensional array or slice, and the type
                --  requires no initialization. Create a temporary of the
-               --  right size, but do copy actual into it (optimization).
+               --  right size, but do not copy actual into it (optimization).
 
                Init := Empty;
                Indic :=
@@ -621,11 +634,9 @@ package body Exp_Ch6 is
                      Is_Bit_Packed_Array (Etype (Expression (Actual))))
          then
             if Conversion_OK (Actual) then
-               Init :=
-                 OK_Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
+               Init := OK_Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
             else
-               Init :=
-                 Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
+               Init := Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
             end if;
 
          elsif Ekind (Formal) = E_In_Parameter then
@@ -700,21 +711,33 @@ package body Exp_Ch6 is
       end Add_Call_By_Copy_Code;
 
       ----------------------------------
-      -- Add_Packed_Call_By_Copy_Code --
+      -- Add_Simple_Call_By_Copy_Code --
       ----------------------------------
 
-      procedure Add_Packed_Call_By_Copy_Code is
+      procedure Add_Simple_Call_By_Copy_Code is
          Temp   : Entity_Id;
          Incod  : Node_Id;
          Outcod : Node_Id;
          Lhs    : Node_Id;
          Rhs    : Node_Id;
+         Indic  : Node_Id;
+         F_Typ  : constant Entity_Id := Etype (Formal);
 
       begin
-         Reset_Packed_Prefix;
+         --  Use formal type for temp, unless formal type is an unconstrained
+         --  array, in which case we don't have to worry about bounds checks,
+         --  and we use the actual type, since that has appropriate bonds.
+
+         if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
+            Indic := New_Occurrence_Of (Etype (Actual), Loc);
+         else
+            Indic := New_Occurrence_Of (Etype (Formal), Loc);
+         end if;
 
          --  Prepare to generate code
 
+         Reset_Packed_Prefix;
+
          Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
          Incod  := Relocate_Node (Actual);
          Outcod := New_Copy_Tree (Incod);
@@ -729,8 +752,7 @@ package body Exp_Ch6 is
          Insert_Action (N,
            Make_Object_Declaration (Loc,
              Defining_Identifier => Temp,
-             Object_Definition   =>
-               New_Occurrence_Of (Etype (Formal), Loc),
+             Object_Definition   => Indic,
              Expression          => Incod));
 
          --  The actual is simply a reference to the temporary
@@ -754,8 +776,9 @@ package body Exp_Ch6 is
               Make_Assignment_Statement (Loc,
                 Name       => Lhs,
                 Expression => Rhs));
+            Set_Assignment_OK (Name (Last (Post_Call)));
          end if;
-      end Add_Packed_Call_By_Copy_Code;
+      end Add_Simple_Call_By_Copy_Code;
 
       ---------------------------
       -- Check_Fortran_Logical --
@@ -930,7 +953,14 @@ package body Exp_Ch6 is
             --  [in] out parameters.
 
             elsif Is_Ref_To_Bit_Packed_Array (Actual) then
-               Add_Packed_Call_By_Copy_Code;
+               Add_Simple_Call_By_Copy_Code;
+
+            --  If a non-scalar actual is possibly unaligned, we need a copy
+
+            elsif Is_Possibly_Unaligned_Object (Actual)
+              and then not Represented_As_Scalar (Etype (Formal))
+            then
+               Add_Simple_Call_By_Copy_Code;
 
             --  References to slices of bit packed arrays are expanded
 
@@ -983,7 +1013,7 @@ package body Exp_Ch6 is
             --  the special processing above for the OUT and IN OUT cases
             --  could be performed. We could make the test in Exp_Ch4 more
             --  complex and have it detect the parameter mode, but it is
-            --  easier simply to handle all cases here.
+            --  easier simply to handle all cases here.)
 
             if Nkind (Actual) = N_Indexed_Component
               and then Is_Packed (Etype (Prefix (Actual)))
@@ -997,7 +1027,14 @@ package body Exp_Ch6 is
             --  Is this really necessary in all cases???
 
             elsif Is_Ref_To_Bit_Packed_Array (Actual) then
-               Add_Packed_Call_By_Copy_Code;
+               Add_Simple_Call_By_Copy_Code;
+
+            --  If a non-scalar actual is possibly unaligned, we need a copy
+
+            elsif Is_Possibly_Unaligned_Object (Actual)
+              and then not Represented_As_Scalar (Etype (Formal))
+            then
+               Add_Simple_Call_By_Copy_Code;
 
             --  Similarly, we have to expand slices of packed arrays here
             --  because the result must be byte aligned.
@@ -1768,13 +1805,10 @@ package body Exp_Ch6 is
          end loop;
       end if;
 
-      if Ekind (Subp) = E_Procedure
-         or else (Ekind (Subp) = E_Subprogram_Type
-                   and then Etype (Subp) = Standard_Void_Type)
-         or else Is_Entry (Subp)
-      then
+      --  At this point we have all the actuals, so this is the point at
+      --  which the various expansion activities for actuals is carried out.
+
       Expand_Actuals (N, Subp);
-      end if;
 
       --  If the subprogram is a renaming, or if it is inherited, replace it
       --  in the call with the name of the actual subprogram being called.
@@ -1924,14 +1958,17 @@ package body Exp_Ch6 is
                        Designated_Type (Base_Type (Etype (Ptr)));
 
             begin
-               Obj := Make_Selected_Component (Loc,
+               Obj :=
+                 Make_Selected_Component (Loc,
                    Prefix        => Unchecked_Convert_To (T, Ptr),
-                 Selector_Name => New_Occurrence_Of (First_Entity (T), Loc));
+                   Selector_Name =>
+                     New_Occurrence_Of (First_Entity (T), Loc));
 
-               Nam := Make_Selected_Component (Loc,
+               Nam :=
+                 Make_Selected_Component (Loc,
                    Prefix        => Unchecked_Convert_To (T, Ptr),
-                 Selector_Name => New_Occurrence_Of (
-                   Next_Entity (First_Entity (T)), Loc));
+                   Selector_Name =>
+                     New_Occurrence_Of (Next_Entity (First_Entity (T)), Loc));
 
                Nam := Make_Explicit_Dereference (Loc, Nam);
 
@@ -2621,11 +2658,11 @@ package body Exp_Ch6 is
    --  Start of processing for Expand_Inlined_Call
 
    begin
-      --  Check for special case of To_Address call, and if so, just
-      --  do an unchecked conversion instead of expanding the call.
-      --  Not only is this more efficient, but it also avoids a
-      --  problem with order of elaboration when address clauses
-      --  are inlined (address expr elaborated at wrong point).
+      --  Check for special case of To_Address call, and if so, just do an
+      --  unchecked conversion instead of expanding the call. Not only is this
+      --  more efficient, but it also avoids problem with order of elaboration
+      --  when address clauses are inlined (address expr elaborated at wrong
+      --  point).
 
       if Subp = RTE (RE_To_Address) then
          Rewrite (N,
@@ -2635,13 +2672,31 @@ package body Exp_Ch6 is
          return;
       end if;
 
+      --  Check for an illegal attempt to inline a recursive procedure. If the
+      --  subprogram has parameters this is detected when trying to supply a
+      --  binding for parameters that already have one. For parameterless
+      --  subprograms this must be done explicitly.
+
+      if In_Open_Scopes (Subp) then
+         Error_Msg_N ("call to recursive subprogram cannot be inlined?", N);
+         Set_Is_Inlined (Subp, False);
+         return;
+      end if;
+
       if Nkind (Orig_Bod) = N_Defining_Identifier then
 
          --  Subprogram is a renaming_as_body. Calls appearing after the
          --  renaming can be replaced with calls to the renamed entity
-         --  directly, because the subprograms are subtype conformant.
+         --  directly, because the subprograms are subtype conformant. If
+         --  the renamed subprogram is an inherited operation, we must redo
+         --  the expansion because implicit conversions may be needed.
 
          Set_Name (N, New_Occurrence_Of (Orig_Bod, Loc));
+
+         if Present (Alias (Orig_Bod)) then
+            Expand_Call (N);
+         end if;
+
          return;
       end if;
 
@@ -2685,10 +2740,10 @@ package body Exp_Ch6 is
          end if;
 
          --  If the argument may be a controlling argument in a call within
-         --  the inlined body, we must preserve its classwide nature to
-         --  insure that dynamic dispatching take place subsequently.
-         --  If the formal has a constraint it must be preserved to retain
-         --  the semantics of the body.
+         --  the inlined body, we must preserve its classwide nature to insure
+         --  that dynamic dispatching take place subsequently. If the formal
+         --  has a constraint it must be preserved to retain the semantics of
+         --  the body.
 
          if Is_Class_Wide_Type (Etype (F))
            or else (Is_Access_Type (Etype (F))
@@ -2847,7 +2902,7 @@ package body Exp_Ch6 is
       end if;
 
       --  Analyze Blk with In_Inlined_Body set, to avoid spurious errors on
-      --  conflicting private views that Gigi would ignore. If this is a
+      --  conflicting private views that Gigi would ignore. If this is
       --  predefined unit, analyze with checks off, as is done in the non-
       --  inlined run-time units.
 
@@ -2924,8 +2979,8 @@ package body Exp_Ch6 is
 
          elsif Requires_Transient_Scope (Typ) then
 
-            --  Verify that the return type of the enclosing function has
-            --  the same constrained status as that of the expression.
+            --  Verify that the return type of the enclosing function has the
+            --  same constrained status as that of the expression.
 
             while Ekind (S) /= E_Function loop
                S := Scope (S);
@@ -2968,16 +3023,16 @@ package body Exp_Ch6 is
 
    begin
       --  A special check. If stack checking is enabled, and the return type
-      --  might generate a large temporary, and the call is not the right
-      --  side of an assignment, then generate an explicit temporary. We do
-      --  this because otherwise gigi may generate a large temporary on the
-      --  fly and this can cause trouble with stack checking.
+      --  might generate a large temporary, and the call is not the right side
+      --  of an assignment, then generate an explicit temporary. We do this
+      --  because otherwise gigi may generate a large temporary on the fly and
+      --  this can cause trouble with stack checking.
 
       --  This is unecessary if the call is the expression in an object
-      --  declaration, or if it appears outside of any library unit. This
-      --  can only happen if it appears as an actual in a library-level
-      --  instance, in which case a temporary will be generated for it once
-      --  the instance itself is installed.
+      --  declaration, or if it appears outside of any library unit. This can
+      --  only happen if it appears as an actual in a library-level instance,
+      --  in which case a temporary will be generated for it once the instance
+      --  itself is installed.
 
       if May_Generate_Large_Temp (Typ)
         and then not Rhs_Of_Assign_Or_Decl (N)
@@ -2986,10 +3041,10 @@ package body Exp_Ch6 is
       then
          if Stack_Checking_Enabled then
 
-            --  Note: it might be thought that it would be OK to use a call
-            --  to Force_Evaluation here, but that's not good enough, because
-            --  that can results in a 'Reference construct that may still
-            --  need a temporary.
+            --  Note: it might be thought that it would be OK to use a call to
+            --  Force_Evaluation here, but that's not good enough, because
+            --  that can results in a 'Reference construct that may still need
+            --  a temporary.
 
             declare
                Loc      : constant Source_Ptr := Sloc (N);
@@ -3086,9 +3141,9 @@ package body Exp_Ch6 is
    --  Add poll call if ATC polling is enabled, unless the body will be
    --  inlined by the back-end.
 
-   --  Add return statement if last statement in body is not a return
-   --  statement (this makes things easier on Gigi which does not want
-   --  to have to handle a missing return).
+   --  Add return statement if last statement in body is not a return statement
+   --  (this makes things easier on Gigi which does not want to have to handle
+   --  a missing return).
 
    --  Add call to Activate_Tasks if body is a task activator
 

gcc/ada/exp_pakd.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1219,10 +1219,14 @@ package body Exp_Pakd is
 
          --  Currently the code in this unit requires that packed arrays
          --  represented by non-modular arrays of bytes be on a byte
-         --  boundary.
+         --  boundary for bit sizes handled by System.Pack_nn units.
+         --  That's because these units assume the array being accessed
+         --  starts on a byte boundary.
 
+         if Get_Id (UI_To_Int (Csize)) /= RE_Null then
             Set_Must_Be_On_Byte_Boundary (Typ);
          end if;
+      end if;
    end Create_Packed_Array_Type;
 
    -----------------------------------

gcc/ada/exp_util.adb

@@ -29,6 +29,7 @@ with Checks;   use Checks;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
+with Exp_Aggr; use Exp_Aggr;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Tss;  use Exp_Tss;
@@ -2323,51 +2324,136 @@ package body Exp_Util is
    -- Is_Possibly_Unaligned_Object --
    ----------------------------------
 
-   function Is_Possibly_Unaligned_Object (P : Node_Id) return Boolean is
+   function Is_Possibly_Unaligned_Object (N : Node_Id) return Boolean is
+      T  : constant Entity_Id := Etype (N);
+
    begin
-      --  If target does not have strict alignment, result is always
-      --  False, since correctness of code does no depend on alignment.
+      --  If renamed object, apply test to underlying object
 
-      if not Target_Strict_Alignment then
-         return False;
+      if Is_Entity_Name (N)
+        and then Is_Object (Entity (N))
+        and then Present (Renamed_Object (Entity (N)))
+      then
+         return Is_Possibly_Unaligned_Object (Renamed_Object (Entity (N)));
       end if;
 
-      --  If renamed object, apply test to underlying object
+      --  Tagged and controlled types and aliased types are always aligned,
+      --  as are concurrent types.
 
-      if Is_Entity_Name (P)
-        and then Is_Object (Entity (P))
-        and then Present (Renamed_Object (Entity (P)))
+      if Is_Aliased (T)
+        or else Has_Controlled_Component (T)
+        or else Is_Concurrent_Type (T)
+        or else Is_Tagged_Type (T)
+        or else Is_Controlled (T)
       then
-         return Is_Possibly_Unaligned_Object (Renamed_Object (Entity (P)));
+         return False;
       end if;
 
       --  If this is an element of a packed array, may be unaligned
 
-      if Is_Ref_To_Bit_Packed_Array (P) then
+      if Is_Ref_To_Bit_Packed_Array (N) then
          return True;
       end if;
 
       --  Case of component reference
 
-      if Nkind (P) = N_Selected_Component then
+      if Nkind (N) = N_Selected_Component then
+         declare
+            P : constant Node_Id   := Prefix (N);
+            C : constant Entity_Id := Entity (Selector_Name (N));
+            M : Nat;
+            S : Nat;
 
-         --  If component reference is for a record that is bit packed
-         --  or has a specified alignment (that might be too small) or
-         --  the component reference has a component clause, then the
-         --  object may be unaligned.
+         begin
+            --  If component reference is for an array with non-static bounds,
+            --  then it is always aligned, we can only unaligned arrays with
+            --  static bounds (more accurately bounds known at compile time)
 
-         if Is_Packed (Etype (Prefix (P)))
-           or else Known_Alignment (Etype (Prefix (P)))
-           or else Present (Component_Clause (Entity (Selector_Name (P))))
+            if Is_Array_Type (T)
+              and then not Compile_Time_Known_Bounds (T)
+            then
+               return False;
+            end if;
+
+            --  If component is aliased, it is definitely properly aligned
+
+            if Is_Aliased (C) then
+               return False;
+            end if;
+
+            --  If component is for a type implemented as a scalar, and the
+            --  record is packed, and the component is other than the first
+            --  component of the record, then the component may be unaligned.
+
+            if Is_Packed (Etype (P))
+              and then Represented_As_Scalar (Etype (P))
+              and then First_Entity (Etype (Entity (P))) /= C
             then
                return True;
+            end if;
 
-         --  Otherwise, for a component reference, test prefix
+            --  Compute maximum possible alignment for T
+
+            --  If alignment is known, then that settles things
+
+            if Known_Alignment (T) then
+               M := UI_To_Int (Alignment (T));
+
+            --  If alignment is not known, tentatively set max alignment
 
             else
-            return Is_Possibly_Unaligned_Object (Prefix (P));
+               M := Ttypes.Maximum_Alignment;
+
+               --  We can reduce this if the Esize is known since the default
+               --  alignment will never be more than the smallest power of 2
+               --  that does not exceed this Esize value.
+
+               if Known_Esize (T) then
+                  S := UI_To_Int (Esize (T));
+
+                  while (M / 2) >= S loop
+                     M := M / 2;
+                  end loop;
+               end if;
+            end if;
+
+            --  If the component reference is for a record that has a specified
+            --  alignment, and we either know it is too small, or cannot tell,
+            --  then the component may be unaligned
+
+            if Known_Alignment (Etype (P))
+              and then Alignment (Etype (P)) < Ttypes.Maximum_Alignment
+              and then M > Alignment (Etype (P))
+            then
+               return True;
+            end if;
+
+            --  Case of component clause present which may specify an
+            --  unaligned position.
+
+            if Present (Component_Clause (C)) then
+
+               --  Otherwise we can do a test to make sure that the actual
+               --  start position in the record, and the length, are both
+               --  consistent with the required alignment. If not, we know
+               --  that we are unaligned.
+
+               declare
+                  Align_In_Bits : constant Nat := M * System_Storage_Unit;
+               begin
+                  if Component_Bit_Offset (C) mod Align_In_Bits /= 0
+                    or else Esize (C) mod Align_In_Bits /= 0
+                  then
+                     return True;
+                  end if;
+               end;
             end if;
 
+            --  Otherwise, for a component reference, test prefix
+
+            return Is_Possibly_Unaligned_Object (P);
+         end;
+
       --  If not a component reference, must be aligned
 
       else
@@ -2379,7 +2465,7 @@ package body Exp_Util is
    -- Is_Possibly_Unaligned_Slice --
    ---------------------------------
 
-   function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean is
+   function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean is
    begin
       --  ??? GCC3 will eventually handle strings with arbitrary alignments,
       --  but for now the following check must be disabled.
@@ -2390,16 +2476,16 @@ package body Exp_Util is
 
       --  For renaming case, go to renamed object
 
-      if Is_Entity_Name (P)
-        and then Is_Object (Entity (P))
-        and then Present (Renamed_Object (Entity (P)))
+      if Is_Entity_Name (N)
+        and then Is_Object (Entity (N))
+        and then Present (Renamed_Object (Entity (N)))
       then
-         return Is_Possibly_Unaligned_Slice (Renamed_Object (Entity (P)));
+         return Is_Possibly_Unaligned_Slice (Renamed_Object (Entity (N)));
       end if;
 
       --  The reference must be a slice
 
-      if Nkind (P) /= N_Slice then
+      if Nkind (N) /= N_Slice then
          return False;
       end if;
 
@@ -2407,10 +2493,10 @@ package body Exp_Util is
       --  component clause, which gigi/gcc does not appear to handle well.
       --  It is not clear why this special test is needed at all ???
 
-      if Nkind (Prefix (P)) = N_Selected_Component
-        and then Nkind (Prefix (Prefix (P))) = N_Selected_Component
+      if Nkind (Prefix (N)) = N_Selected_Component
+        and then Nkind (Prefix (Prefix (N))) = N_Selected_Component
         and then
-          Present (Component_Clause (Entity (Selector_Name (Prefix (P)))))
+          Present (Component_Clause (Entity (Selector_Name (Prefix (N)))))
       then
          return True;
       end if;
@@ -2424,10 +2510,10 @@ package body Exp_Util is
       --  If it is a slice, then look at the array type being sliced
 
       declare
-         Sarr : constant Node_Id := Prefix (P);
+         Sarr : constant Node_Id := Prefix (N);
          --  Prefix of the slice, i.e. the array being sliced
 
-         Styp : constant Entity_Id := Etype (Prefix (P));
+         Styp : constant Entity_Id := Etype (Prefix (N));
          --  Type of the array being sliced
 
          Pref : Node_Id;
@@ -2519,30 +2605,30 @@ package body Exp_Util is
    -- Is_Ref_To_Bit_Packed_Array --
    --------------------------------
 
-   function Is_Ref_To_Bit_Packed_Array (P : Node_Id) return Boolean is
+   function Is_Ref_To_Bit_Packed_Array (N : Node_Id) return Boolean is
       Result : Boolean;
       Expr   : Node_Id;
 
    begin
-      if Is_Entity_Name (P)
-        and then Is_Object (Entity (P))
-        and then Present (Renamed_Object (Entity (P)))
+      if Is_Entity_Name (N)
+        and then Is_Object (Entity (N))
+        and then Present (Renamed_Object (Entity (N)))
       then
-         return Is_Ref_To_Bit_Packed_Array (Renamed_Object (Entity (P)));
+         return Is_Ref_To_Bit_Packed_Array (Renamed_Object (Entity (N)));
       end if;
 
-      if Nkind (P) = N_Indexed_Component
+      if Nkind (N) = N_Indexed_Component
            or else
-         Nkind (P) = N_Selected_Component
+         Nkind (N) = N_Selected_Component
       then
-         if Is_Bit_Packed_Array (Etype (Prefix (P))) then
+         if Is_Bit_Packed_Array (Etype (Prefix (N))) then
             Result := True;
          else
-            Result := Is_Ref_To_Bit_Packed_Array (Prefix (P));
+            Result := Is_Ref_To_Bit_Packed_Array (Prefix (N));
          end if;
 
-         if Result and then Nkind (P) = N_Indexed_Component then
-            Expr := First (Expressions (P));
+         if Result and then Nkind (N) = N_Indexed_Component then
+            Expr := First (Expressions (N));
             while Present (Expr) loop
                Force_Evaluation (Expr);
                Next (Expr);
@@ -2560,25 +2646,25 @@ package body Exp_Util is
    -- Is_Ref_To_Bit_Packed_Slice --
    --------------------------------
 
-   function Is_Ref_To_Bit_Packed_Slice (P : Node_Id) return Boolean is
+   function Is_Ref_To_Bit_Packed_Slice (N : Node_Id) return Boolean is
    begin
-      if Is_Entity_Name (P)
-        and then Is_Object (Entity (P))
-        and then Present (Renamed_Object (Entity (P)))
+      if Is_Entity_Name (N)
+        and then Is_Object (Entity (N))
+        and then Present (Renamed_Object (Entity (N)))
       then
-         return Is_Ref_To_Bit_Packed_Slice (Renamed_Object (Entity (P)));
+         return Is_Ref_To_Bit_Packed_Slice (Renamed_Object (Entity (N)));
       end if;
 
-      if Nkind (P) = N_Slice
-        and then Is_Bit_Packed_Array (Etype (Prefix (P)))
+      if Nkind (N) = N_Slice
+        and then Is_Bit_Packed_Array (Etype (Prefix (N)))
       then
          return True;
 
-      elsif Nkind (P) = N_Indexed_Component
+      elsif Nkind (N) = N_Indexed_Component
            or else
-         Nkind (P) = N_Selected_Component
+         Nkind (N) = N_Selected_Component
       then
-         return Is_Ref_To_Bit_Packed_Slice (Prefix (P));
+         return Is_Ref_To_Bit_Packed_Slice (Prefix (N));
 
       else
          return False;
@@ -2646,6 +2732,22 @@ package body Exp_Util is
                Set_Is_Eliminated (Defining_Entity (N));
             end if;
 
+         elsif Nkind (N) = N_Package_Declaration then
+            Kill_Dead_Code (Visible_Declarations (Specification (N)));
+            Kill_Dead_Code (Private_Declarations (Specification (N)));
+
+            declare
+               E : Entity_Id := First_Entity (Defining_Entity (N));
+            begin
+               while Present (E) loop
+                  if Ekind (E) = E_Operator then
+                     Set_Is_Eliminated (E);
+                  end if;
+
+                  Next_Entity (E);
+               end loop;
+            end;
+
          --  Recurse into composite statement to kill individual statements,
          --  in particular instantiations.
 
@@ -3706,8 +3808,22 @@ package body Exp_Util is
             New_Exp := Make_Reference (Loc, E);
          end if;
 
-         if Nkind (E) = N_Aggregate and then Expansion_Delayed (E) then
+         if Is_Delayed_Aggregate (E) then
+
+            --  The expansion of nested aggregates is delayed until the
+            --  enclosing aggregate is expanded. As aggregates are often
+            --  qualified, the predicate applies to qualified expressions
+            --  as well, indicating that the enclosing aggregate has not
+            --  been expanded yet. At this point the aggregate is part of
+            --  a stand-alone declaration, and must be fully expanded.
+
+            if Nkind (E) = N_Qualified_Expression then
+               Set_Expansion_Delayed (Expression (E), False);
+               Set_Analyzed (Expression (E), False);
+            else
                Set_Expansion_Delayed (E, False);
+            end if;
+
             Set_Analyzed (E, False);
          end if;
 
@@ -3731,6 +3847,18 @@ package body Exp_Util is
       Scope_Suppress := Svg_Suppress;
    end Remove_Side_Effects;
 
+   ---------------------------
+   -- Represented_As_Scalar --
+   ---------------------------
+
+   function Represented_As_Scalar (T : Entity_Id) return Boolean is
+      UT : constant Entity_Id := Underlying_Type (T);
+   begin
+      return Is_Scalar_Type (UT)
+        or else (Is_Bit_Packed_Array (UT)
+                   and then Is_Scalar_Type (Packed_Array_Type (UT)));
+   end Represented_As_Scalar;
+
    ------------------------------------
    -- Safe_Unchecked_Type_Conversion --
    ------------------------------------

gcc/ada/exp_util.ads

@@ -417,7 +417,7 @@ package Exp_Util is
    --  nodes. False otherwise. True for an empty list. It is an error
    --  to call this routine with No_List as the argument.
 
-   function Is_Ref_To_Bit_Packed_Array (P : Node_Id) return Boolean;
+   function Is_Ref_To_Bit_Packed_Array (N : Node_Id) return Boolean;
    --  Determine whether the node P is a reference to a bit packed
    --  array, i.e. whether the designated object is a component of
    --  a bit packed array, or a subcomponent of such a component.
@@ -425,18 +425,18 @@ package Exp_Util is
    --  to Force_Evaluation, and True is returned. Otherwise False
    --  is returned, and P is not affected.
 
-   function Is_Ref_To_Bit_Packed_Slice (P : Node_Id) return Boolean;
+   function Is_Ref_To_Bit_Packed_Slice (N : Node_Id) return Boolean;
    --  Determine whether the node P is a reference to a bit packed
    --  slice, i.e. whether the designated object is bit packed slice
    --  or a component of a bit packed slice. Return True if so.
 
-   function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean;
+   function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean;
    --  Determine whether the node P is a slice of an array where the slice
    --  result may cause alignment problems because it has an alignment that
    --  is not compatible with the type. Return True if so.
 
-   function Is_Possibly_Unaligned_Object (P : Node_Id) return Boolean;
-   --  Node P is an object reference. This function returns True if it
+   function Is_Possibly_Unaligned_Object (N : Node_Id) return Boolean;
+   --  Node N is an object reference. This function returns True if it
    --  is possible that the object may not be aligned according to the
    --  normal default alignment requirement for its type (e.g. if it
    --  appears in a packed record, or as part of a component that has
@@ -511,6 +511,11 @@ package Exp_Util is
    --  call to Remove_Side_Effects, it is safe to call New_Copy_Tree to
    --  obtain a copy of the resulting expression.
 
+   function Represented_As_Scalar (T : Entity_Id) return Boolean;
+   --  Returns True iff the implementation of this type in code generation
+   --  terms is scalar. This is true for scalars in the Ada sense, and for
+   --  packed arrays which are represented by a scalar (modular) type.
+
    function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
    --  Given the node for an N_Unchecked_Type_Conversion, return True
    --  if this is an unchecked conversion that Gigi can handle directly.

gcc/ada/sem_eval.adb

@@ -377,8 +377,7 @@ package body Sem_Eval is
 
    function Compile_Time_Compare
      (L, R : Node_Id;
-      Rec  : Boolean := False)
-      return Compare_Result
+      Rec  : Boolean := False) return Compare_Result
    is
       Ltyp : constant Entity_Id := Etype (L);
       Rtyp : constant Entity_Id := Etype (R);
@@ -795,6 +794,34 @@ package body Sem_Eval is
       end if;
    end Compile_Time_Compare;
 
+   -------------------------------
+   -- Compile_Time_Known_Bounds --
+   -------------------------------
+
+   function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean is
+      Indx : Node_Id;
+      Typ  : Entity_Id;
+
+   begin
+      if not Is_Array_Type (T) then
+         return False;
+      end if;
+
+      Indx := First_Index (T);
+      while Present (Indx) loop
+         Typ := Underlying_Type (Etype (Indx));
+         if not Compile_Time_Known_Value (Type_Low_Bound (Typ)) then
+            return False;
+         elsif not Compile_Time_Known_Value (Type_High_Bound (Typ)) then
+            return False;
+         else
+            Next_Index (Indx);
+         end if;
+      end loop;
+
+      return True;
+   end Compile_Time_Known_Bounds;
+
    ------------------------------
    -- Compile_Time_Known_Value --
    ------------------------------
@@ -3116,8 +3143,7 @@ package body Sem_Eval is
    function In_Subrange_Of
      (T1        : Entity_Id;
       T2        : Entity_Id;
-      Fixed_Int : Boolean := False)
-      return      Boolean
+      Fixed_Int : Boolean := False) return Boolean
    is
       L1 : Node_Id;
       H1 : Node_Id;
@@ -3219,8 +3245,7 @@ package body Sem_Eval is
      (N         : Node_Id;
       Typ       : Entity_Id;
       Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False)
-      return      Boolean
+      Int_Real  : Boolean := False) return Boolean
    is
       Val  : Uint;
       Valr : Ureal;
@@ -3400,8 +3425,7 @@ package body Sem_Eval is
      (N         : Node_Id;
       Typ       : Entity_Id;
       Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False)
-      return      Boolean
+      Int_Real  : Boolean := False) return Boolean
    is
       Val  : Uint;
       Valr : Ureal;
@@ -3692,8 +3716,7 @@ package body Sem_Eval is
 
    function Subtypes_Statically_Compatible
      (T1 : Entity_Id;
-      T2   : Entity_Id)
-      return Boolean
+      T2 : Entity_Id) return Boolean
    is
    begin
       if Is_Scalar_Type (T1) then

gcc/ada/sem_eval.ads

@@ -137,8 +137,7 @@ package Sem_Eval is
    subtype Compare_LE is Compare_Result range LT .. EQ;
    function Compile_Time_Compare
      (L, R : Node_Id;
-      Rec  : Boolean := False)
-      return Compare_Result;
+      Rec  : Boolean := False) return Compare_Result;
    --  Given two expression nodes, finds out whether it can be determined
    --  at compile time how the runtime values will compare. An Unknown
    --  result means that the result of a comparison cannot be determined at
@@ -195,8 +194,7 @@ package Sem_Eval is
 
    function Subtypes_Statically_Compatible
      (T1 : Entity_Id;
-      T2   : Entity_Id)
-      return Boolean;
+      T2 : Entity_Id) return Boolean;
    --  Returns true if the subtypes are unconstrained or the constraint on
    --  on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
    --  Otherwise returns false.
@@ -222,6 +220,11 @@ package Sem_Eval is
    --  whose constituent expressions are either compile time known values
    --  or compile time known aggregates.
 
+   function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean;
+   --  If T is an array whose index bounds are all known at compile time,
+   --  then True is returned, if T is not an array, or one or more of its
+   --  index bounds is not known at compile time, then False is returned.
+
    function Expr_Value (N : Node_Id) return Uint;
    --  Returns the folded value of the expression N. This function is called
    --  in instances where it has already been determined that the expression
@@ -330,8 +333,7 @@ package Sem_Eval is
      (N         : Node_Id;
       Typ       : Entity_Id;
       Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False)
-      return      Boolean;
+      Int_Real  : Boolean := False) return Boolean;
    --  Returns True if it can be guaranteed at compile time that expression
    --  N is known to be in range of the subtype Typ. If the values of N or
    --  of either bouds of Type are unknown at compile time, False will
@@ -353,8 +355,7 @@ package Sem_Eval is
      (N         : Node_Id;
       Typ       : Entity_Id;
       Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False)
-      return      Boolean;
+      Int_Real  : Boolean := False) return Boolean;
    --  Returns True if it can be guaranteed at compile time that expression
    --  N is known to be out of range of the subtype Typ.  True is returned
    --  if Typ is a scalar type, at least one of whose bounds is known at
@@ -367,8 +368,7 @@ package Sem_Eval is
    function In_Subrange_Of
      (T1        : Entity_Id;
       T2        : Entity_Id;
-      Fixed_Int : Boolean := False)
-      return      Boolean;
+      Fixed_Int : Boolean := False) return Boolean;
    --  Returns True if it can be guaranteed at compile time that the range
    --  of values for scalar type T1 are always in the range of scalar type
    --  T2.  A result of False does not mean that T1 is not in T2's subrange,