[Ada] In-place initialization for Initialize_Scalars

This patch optimizes the initialization and allocation of scalar array objects
when pragma Initialize_Scalars is in effect. The patch also extends the syntax
and semantics of pragma Initialize_Scalars to allow for the specification of
invalid values pertaining to families of scalar types. The new syntax is as
follows:

   pragma Initialize_Scalars
     [ ( TYPE_VALUE_PAIR {, TYPE_VALUE_PAIR} ) ];

   TYPE_VALUE_PAIR ::=
     SCALAR_TYPE => static_EXPRESSION

   SCALAR_TYPE :=
     Short_Float
   | Float
   | Long_Float
   | Long_Long_Flat
   | Signed_8
   | Signed_16
   | Signed_32
   | Signed_64
   | Unsigned_8
   | Unsigned_16
   | Unsigned_32
   | Unsigned_64

Depending on the value specified by pragma Initialize_Scalars, the backend may
optimize the creation of the scalar array object into a fast memset.

------------
-- Source --
------------

--  gnat.adc

pragma Initialize_Scalars
  (Short_Float     => 0.0,
   Float           => 0.0,
   Long_Float      => 0.0,
   Long_Long_Float => 0.0,
   Signed_8        => 0,
   Signed_16       => 0,
   Signed_32       => 0,
   Signed_64       => 0,
   Unsigned_8      => 0,
   Unsigned_16     => 0,
   Unsigned_32     => 0,
   Unsigned_64     => 0);

--  types.ads

with System;

package Types is
   Max : constant := 10_000;
   subtype Big is Integer range 1 .. Max;

   type Byte is range 0 .. 255;
   for Byte'Size use System.Storage_Unit;

   type Byte_Arr_1 is array (1 .. Max) of Byte;
   type Byte_Arr_2 is array (Big) of Byte;
   type Byte_Arr_3 is array (Integer range <>) of Byte;
   type Byte_Arr_4 is array (Integer range <>,
                             Integer range <>) of Byte;
   type Constr_Arr_1 is array (1 .. Max) of Integer;
   type Constr_Arr_2 is array (Big) of Integer;
   type Constr_Arr_3 is array (1 .. Max, 1 .. Max) of Integer;
   type Constr_Arr_4 is array (Big, Big) of Integer;

   type Unconstr_Arr_1 is array (Integer range <>) of Integer;
   type Unconstr_Arr_2 is array (Integer range <>,
                                 Integer range <>) of Integer;

   subtype Subt_Arr_1 is Unconstr_Arr_1 (1 .. Max);
   subtype Subt_Arr_2 is Unconstr_Arr_1 (Big);
   subtype Subt_Arr_3 is Unconstr_Arr_2 (1 .. Max, 1 .. Max);
   subtype Subt_Arr_4 is Unconstr_Arr_2 (Big, Big);

   subtype Subt_Str_1 is String (1 .. Max);
   subtype Subt_Str_2 is String (Big);

   type Byte_Arr_1_Ptr     is access Byte_Arr_1;
   type Byte_Arr_2_Ptr     is access Byte_Arr_2;
   type Byte_Arr_3_Ptr     is access Byte_Arr_3;
   type Byte_Arr_4_Ptr     is access Byte_Arr_4;
   type Constr_Arr_1_Ptr   is access Constr_Arr_1;
   type Constr_Arr_2_Ptr   is access Constr_Arr_2;
   type Constr_Arr_3_Ptr   is access Constr_Arr_3;
   type Constr_Arr_4_Ptr   is access Constr_Arr_4;
   type Unconstr_Arr_1_Ptr is access Unconstr_Arr_1;
   type Unconstr_Arr_2_Ptr is access Unconstr_Arr_2;
   type Subt_Arr_1_Ptr     is access Subt_Arr_1;
   type Subt_Arr_2_Ptr     is access Subt_Arr_2;
   type Subt_Arr_3_Ptr     is access Subt_Arr_3;
   type Subt_Arr_4_Ptr     is access Subt_Arr_4;
   type Str_Ptr            is access String;
   type Subt_Str_1_Ptr     is access Subt_Str_1;
   type Subt_Str_2_Ptr     is access Subt_Str_2;
end Types;

--  main.adb

with Types; use Types;

procedure Main is
   Byte_Arr_1_Obj     : Byte_Arr_1;
   Byte_Arr_2_Obj     : Byte_Arr_2;
   Byte_Arr_3_Obj     : Byte_Arr_3 (1 .. Max);
   Byte_Arr_4_Obj     : Byte_Arr_3 (Big);
   Byte_Arr_5_Obj     : Byte_Arr_4 (1 .. Max, 1 .. Max);
   Byte_Arr_6_Obj     : Byte_Arr_4 (Big, Big);
   Constr_Arr_1_Obj   : Constr_Arr_1;
   Constr_Arr_2_Obj   : Constr_Arr_2;
   Constr_Arr_3_Obj   : Constr_Arr_3;
   Constr_Arr_4_Obj   : Constr_Arr_4;
   Unconstr_Arr_1_Obj : Unconstr_Arr_1 (1 .. Max);
   Unconstr_Arr_2_Obj : Unconstr_Arr_1 (Big);
   Unconstr_Arr_3_Obj : Unconstr_Arr_2 (1 .. Max, 1 .. Max);
   Unconstr_Arr_4_Obj : Unconstr_Arr_2 (Big, Big);
   Subt_Arr_1_Obj     : Subt_Arr_1;
   Subt_Arr_2_Obj     : Subt_Arr_2;
   Subt_Arr_3_Obj     : Subt_Arr_3;
   Subt_Arr_4_Obj     : Subt_Arr_4;
   Str_1_Obj          : String (1 .. Max);
   Str_2_Obj          : String (Big);
   Subt_Str_1_Obj     : Subt_Str_1;
   Subt_Str_2_Obj     : Subt_Str_2;

   Byte_Arr_1_Ptr_Obj     : Byte_Arr_1_Ptr     := new Byte_Arr_1;
   Byte_Arr_2_Ptr_Obj     : Byte_Arr_2_Ptr     := new Byte_Arr_2;
   Byte_Arr_3_Ptr_Obj     : Byte_Arr_3_Ptr     := new Byte_Arr_3 (1 .. Max);
   Byte_Arr_4_Ptr_Obj     : Byte_Arr_3_Ptr     := new Byte_Arr_3 (Big);
   Byte_Arr_5_Ptr_Obj     : Byte_Arr_4_Ptr     :=
                              new Byte_Arr_4 (1 .. Max, 1 .. Max);
   Byte_Arr_6_Ptr_Obj     : Byte_Arr_4_Ptr     := new Byte_Arr_4 (Big, Big);
   Constr_Arr_1_Ptr_Obj   : Constr_Arr_1_Ptr   := new Constr_Arr_1;
   Constr_Arr_2_Ptr_Obj   : Constr_Arr_2_Ptr   := new Constr_Arr_2;
   Constr_Arr_3_Ptr_Obj   : Constr_Arr_3_Ptr   := new Constr_Arr_3;
   Constr_Arr_4_Ptr_Obj   : Constr_Arr_4_Ptr   := new Constr_Arr_4;
   Unconstr_Arr_1_Ptr_Obj : Unconstr_Arr_1_Ptr :=
                              new Unconstr_Arr_1 (1 .. Max);
   Unconstr_Arr_2_Ptr_Obj : Unconstr_Arr_1_Ptr := new Unconstr_Arr_1 (Big);
   Unconstr_Arr_3_Ptr_Obj : Unconstr_Arr_2_Ptr :=
                              new Unconstr_Arr_2 (1 .. Max, 1 .. Max);
   Unconstr_Arr_4_Ptr_Obj : Unconstr_Arr_2_Ptr :=
                              new Unconstr_Arr_2 (Big, Big);
   Subt_Arr_1_Ptr_Obj     : Subt_Arr_1_Ptr     := new Subt_Arr_1;
   Subt_Arr_2_Ptr_Obj     : Subt_Arr_2_Ptr     := new Subt_Arr_2;
   Subt_Arr_3_Ptr_Obj     : Subt_Arr_3_Ptr     := new Subt_Arr_3;
   Subt_Arr_4_Ptr_Obj     : Subt_Arr_4_Ptr     := new Subt_Arr_4;
   Str_Ptr_1_Obj          : Str_Ptr            := new String (1 .. Max);
   Str_Ptr_2_Obj          : Str_Ptr            := new String (Big);
   Subt_Str_1_Ptr_Obj     : Subt_Str_1_Ptr     := new Subt_Str_1;
   Subt_Str_2_Ptr_Obj     : Subt_Str_2_Ptr     := new Subt_Str_2;
begin null; end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c -S -gnatDG -gnatws main.adb
$ grep -c "others => types__TbyteB!(0));" main.adb.dg
$ grep -c "others => integer!(0));" main.adb.dg
$ grep -c "others => character!(0));" main.adb.dg
$ grep -c "others => types__TbyteB!(0));" main.adb.dg
$ grep -c "memset" main.s
8
12
8
8
44

2018-05-22  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Strip away any
	conversions before extracting the value of the expression.
	* exp_ch3.adb (Default_Initialize_Object): Optimize the default
	initialization of an array of scalars.
	(Get_Simple_Init_Val): Add processing for array types. Remove the
	processing of strings because this case is already handled by the array
	case.
	(Needs_Simple_Initialization): Moved to Sem_Util.
	(Simple_Init_Array_Type): New routine.
	(Simple_Init_Initialize_Scalars_Type): Reimplemented to use the new
	facilities from Sem_Util.
	(Simple_Initialization_OK): New routine.
	* exp_ch3.ads (Needs_Simple_Initialization): Moved to Sem_Util.
	* exp_ch4.adb (Expand_N_Allocator): Optimize the default allocation of
	an array of scalars.
	* sem_prag.adb (Analyze_Float_Value): New routine.
	(Analyze_Integer_Value): New routine.
	(Analyze_Pragma): Reimplement the analysis of pragma Initialize_Scalars
	to handled the extended form of the pragma.
	(Analyze_Type_Value_Pair): New routine.
	* sem_util.adb: Add invalid value-related data structures.
	(Examine_Array_Bounds): New routine.
	(Has_Static_Array_Bounds): Reimplemented.
	(Has_Static_Non_Empty_Array_Bounds): New routine.
	(Invalid_Scalar_Value): New routine.
	(Needs_Simple_Initialization): Moved from Exp_Ch3.
	(Set_Invalid_Scalar_Value): New routines.
	* sem_util.ads (Has_Static_Non_Empty_Array_Bounds): New routine.
	(Invalid_Scalar_Value): New routine.
	(Needs_Simple_Initialization): Moved from Exp_Ch3.
	(Set_Invalid_Scalar_Value): New routines.
	* snames.ads-tmpl: Add names for the salar type families used by pragma
	Initialize_Scalars.

From-SVN: r260529

gcc/ada/ChangeLog

+2018-05-22  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Strip away any
+	conversions before extracting the value of the expression.
+	* exp_ch3.adb (Default_Initialize_Object): Optimize the default
+	initialization of an array of scalars.
+	(Get_Simple_Init_Val): Add processing for array types. Remove the
+	processing of strings because this case is already handled by the array
+	case.
+	(Needs_Simple_Initialization): Moved to Sem_Util.
+	(Simple_Init_Array_Type): New routine.
+	(Simple_Init_Initialize_Scalars_Type): Reimplemented to use the new
+	facilities from Sem_Util.
+	(Simple_Initialization_OK): New routine.
+	* exp_ch3.ads (Needs_Simple_Initialization): Moved to Sem_Util.
+	* exp_ch4.adb (Expand_N_Allocator): Optimize the default allocation of
+	an array of scalars.
+	* sem_prag.adb (Analyze_Float_Value): New routine.
+	(Analyze_Integer_Value): New routine.
+	(Analyze_Pragma): Reimplement the analysis of pragma Initialize_Scalars
+	to handled the extended form of the pragma.
+	(Analyze_Type_Value_Pair): New routine.
+	* sem_util.adb: Add invalid value-related data structures.
+	(Examine_Array_Bounds): New routine.
+	(Has_Static_Array_Bounds): Reimplemented.
+	(Has_Static_Non_Empty_Array_Bounds): New routine.
+	(Invalid_Scalar_Value): New routine.
+	(Needs_Simple_Initialization): Moved from Exp_Ch3.
+	(Set_Invalid_Scalar_Value): New routines.
+	* sem_util.ads (Has_Static_Non_Empty_Array_Bounds): New routine.
+	(Invalid_Scalar_Value): New routine.
+	(Needs_Simple_Initialization): Moved from Exp_Ch3.
+	(Set_Invalid_Scalar_Value): New routines.
+	* snames.ads-tmpl: Add names for the salar type families used by pragma
+	Initialize_Scalars.
+
 2018-05-22  Javier Miranda  <miranda@adacore.com>
 
 	* exp_disp.adb (Make_DT): Initialize the External_Tag with an empty

gcc/ada/exp_aggr.adb

@@ -4918,20 +4918,21 @@ package body Exp_Aggr is
       --  specifically optimized for the target.
 
       function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean is
+         Csiz      : Uint;
          Ctyp      : Entity_Id;
+         Expr      : Node_Id;
+         High      : Node_Id;
          Index     : Entity_Id;
-         Expr      : Node_Id := N;
          Low       : Node_Id;
-         High      : Node_Id;
-         Csiz      : Uint;
+         Nunits    : Int;
          Remainder : Uint;
          Value     : Uint;
-         Nunits    : Nat;
 
       begin
          --  Recurse as far as possible to find the innermost component type
 
          Ctyp := Etype (N);
+         Expr := N;
          while Is_Array_Type (Ctyp) loop
             if Nkind (Expr) /= N_Aggregate
               or else not Is_Others_Aggregate (Expr)
@@ -5022,6 +5023,15 @@ package body Exp_Aggr is
 
          Analyze_And_Resolve (Expr, Ctyp);
 
+         --  Strip away any conversions from the expression as they simply
+         --  qualify the real expression.
+
+         while Nkind_In (Expr, N_Unchecked_Type_Conversion,
+                               N_Type_Conversion)
+         loop
+            Expr := Expression (Expr);
+         end loop;
+
          Nunits := UI_To_Int (Csiz) / System_Storage_Unit;
 
          if Nunits = 1 then

gcc/ada/exp_ch3.ads

@@ -134,17 +134,4 @@ package Exp_Ch3 is
    --  clause the assignment is handled as part of the freezing of the object,
    --  see Check_Address_Clause.
 
-   function Needs_Simple_Initialization
-     (Typ         : Entity_Id;
-      Consider_IS : Boolean := True) return Boolean;
-   --  Certain types need initialization even though there is no specific
-   --  initialization routine:
-   --    Access types (which need initializing to null)
-   --    All scalar types if Normalize_Scalars mode set
-   --    Descendants of standard string types if Normalize_Scalars mode set
-   --    Scalar types having a Default_Value attribute
-   --  Regarding Initialize_Scalars mode, this is ignored if Consider_IS is
-   --  set to False, but if Consider_IS is set to True, then the cases above
-   --  mentioning Normalize_Scalars also apply for Initialize_Scalars mode.
-
 end Exp_Ch3;

gcc/ada/exp_ch4.adb

@@ -4595,7 +4595,7 @@ package body Exp_Ch4 is
       --  first argument to Init must be converted to the task record type.
 
       declare
-         T         : constant Entity_Id := Entity (Expression (N));
+         T         : constant Entity_Id := Etype (Expression (N));
          Args      : List_Id;
          Decls     : List_Id;
          Decl      : Node_Id;
@@ -4618,6 +4618,67 @@ package body Exp_Ch4 is
                   Is_Allocate => True);
             end if;
 
+         --  Optimize the default allocation of an array object when the
+         --  following conditions are met:
+         --
+         --    * Pragma Initialize_Scalars or Normalize_Scalars is in effect
+         --
+         --    * The bounds of the array type are static and lack empty ranges
+         --
+         --    * The array type does not contain atomic components or is
+         --      treated as packed.
+         --
+         --    * The component is of a scalar type which requires simple
+         --      initialization.
+         --
+         --  Construct an in-place initialization aggregate which may be
+         --  convert into a fast memset by the backend.
+
+         elsif Init_Or_Norm_Scalars
+           and then Is_Array_Type (T)
+           and then not Has_Atomic_Components (T)
+           and then not Is_Packed (T)
+           and then Has_Static_Non_Empty_Array_Bounds (T)
+           and then Is_Scalar_Type (Component_Type (T))
+           and then Needs_Simple_Initialization
+                      (Typ         => Component_Type (T),
+                       Consider_IS => True)
+         then
+            Set_Analyzed (N);
+            Temp := Make_Temporary (Loc, 'P');
+
+            --  Generate:
+            --    Temp : Ptr_Typ := new ...;
+
+            Insert_Action
+              (Assoc_Node => N,
+               Ins_Action =>
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => Temp,
+                   Object_Definition   => New_Occurrence_Of (PtrT, Loc),
+                   Expression          => Relocate_Node (N)),
+               Suppress   => All_Checks);
+
+            --  Generate:
+            --    Temp.all := (others => ...);
+
+            Insert_Action
+              (Assoc_Node => N,
+               Ins_Action =>
+                 Make_Assignment_Statement (Loc,
+                   Name       =>
+                     Make_Explicit_Dereference (Loc,
+                       Prefix => New_Occurrence_Of (Temp, Loc)),
+                   Expression =>
+                     Get_Simple_Init_Val
+                       (Typ  => T,
+                        N    => N,
+                        Size => Esize (Component_Type (T)))),
+               Suppress   => All_Checks);
+
+            Rewrite (N, New_Occurrence_Of (Temp, Loc));
+            Analyze_And_Resolve (N, PtrT);
+
          --  Case of no initialization procedure present
 
          elsif not Has_Non_Null_Base_Init_Proc (T) then

gcc/ada/sem_prag.adb

@@ -17124,24 +17124,190 @@ package body Sem_Prag is
          -- Initialize_Scalars --
          ------------------------
 
-         --  pragma Initialize_Scalars;
+         --  pragma Initialize_Scalars
+         --    [ ( TYPE_VALUE_PAIR {, TYPE_VALUE_PAIR} ) ];
+
+         --  TYPE_VALUE_PAIR ::=
+         --    SCALAR_TYPE => static_EXPRESSION
+
+         --  SCALAR_TYPE :=
+         --    Short_Float
+         --  | Float
+         --  | Long_Float
+         --  | Long_Long_Flat
+         --  | Signed_8
+         --  | Signed_16
+         --  | Signed_32
+         --  | Signed_64
+         --  | Unsigned_8
+         --  | Unsigned_16
+         --  | Unsigned_32
+         --  | Unsigned_64
+
+         when Pragma_Initialize_Scalars => Do_Initialize_Scalars : declare
+            Seen : array (Scalar_Id) of Node_Id := (others => Empty);
+            --  This collection holds the individual pairs which specify the
+            --  invalid values of their respective scalar types.
+
+            procedure Analyze_Float_Value
+              (Scal_Typ : Float_Scalar_Id;
+               Val_Expr : Node_Id);
+            --  Analyze a type value pair associated with float type Scal_Typ
+            --  and expression Val_Expr.
+
+            procedure Analyze_Integer_Value
+              (Scal_Typ : Integer_Scalar_Id;
+               Val_Expr : Node_Id);
+            --  Analyze a type value pair associated with integer type Scal_Typ
+            --  and expression Val_Expr.
+
+            procedure Analyze_Type_Value_Pair (Pair : Node_Id);
+            --  Analyze type value pair Pair
 
-         when Pragma_Initialize_Scalars =>
+            -------------------------
+            -- Analyze_Float_Value --
+            -------------------------
+
+            procedure Analyze_Float_Value
+              (Scal_Typ : Float_Scalar_Id;
+               Val_Expr : Node_Id)
+            is
+            begin
+               Analyze_And_Resolve (Val_Expr, Any_Real);
+
+               if Is_OK_Static_Expression (Val_Expr) then
+                  Set_Invalid_Scalar_Value (Scal_Typ, Expr_Value_R (Val_Expr));
+
+               else
+                  Error_Msg_Name_1 := Scal_Typ;
+                  Error_Msg_N ("value for type % must be static", Val_Expr);
+               end if;
+            end Analyze_Float_Value;
+
+            ---------------------------
+            -- Analyze_Integer_Value --
+            ---------------------------
+
+            procedure Analyze_Integer_Value
+              (Scal_Typ : Integer_Scalar_Id;
+               Val_Expr : Node_Id)
+            is
+            begin
+               Analyze_And_Resolve (Val_Expr, Any_Integer);
+
+               if Is_OK_Static_Expression (Val_Expr) then
+                  Set_Invalid_Scalar_Value (Scal_Typ, Expr_Value (Val_Expr));
+
+               else
+                  Error_Msg_Name_1 := Scal_Typ;
+                  Error_Msg_N ("value for type % must be static", Val_Expr);
+               end if;
+            end Analyze_Integer_Value;
+
+            -----------------------------
+            -- Analyze_Type_Value_Pair --
+            -----------------------------
+
+            procedure Analyze_Type_Value_Pair (Pair : Node_Id) is
+               Scal_Typ  : constant Name_Id := Chars (Pair);
+               Val_Expr  : constant Node_Id := Expression (Pair);
+               Prev_Pair : Node_Id;
+
+            begin
+               if Scal_Typ in Scalar_Id then
+                  Prev_Pair := Seen (Scal_Typ);
+
+                  --  Prevent multiple attempts to set a value for a scalar
+                  --  type.
+
+                  if Present (Prev_Pair) then
+                     Error_Msg_Name_1 := Scal_Typ;
+                     Error_Msg_N
+                       ("cannot specify multiple invalid values for type %",
+                        Pair);
+
+                     Error_Msg_Sloc := Sloc (Prev_Pair);
+                     Error_Msg_N ("previous value set #", Pair);
+
+                     --  Ignore the effects of the pair, but do not halt the
+                     --  analysis of the pragma altogether.
+
+                     return;
+
+                  --  Otherwise capture the first pair for this scalar type
+
+                  else
+                     Seen (Scal_Typ) := Pair;
+                  end if;
+
+                  if Scal_Typ in Float_Scalar_Id then
+                     Analyze_Float_Value (Scal_Typ, Val_Expr);
+
+                  else pragma Assert (Scal_Typ in Integer_Scalar_Id);
+                     Analyze_Integer_Value (Scal_Typ, Val_Expr);
+                  end if;
+
+               --  Otherwise the scalar family is illegal
+
+               else
+                  Error_Msg_Name_1 := Pname;
+                  Error_Msg_N
+                    ("argument of pragma % must denote valid scalar family",
+                     Pair);
+               end if;
+            end Analyze_Type_Value_Pair;
+
+            --  Local variables
+
+            Pairs : constant List_Id := Pragma_Argument_Associations (N);
+            Pair  : Node_Id;
+
+         --  Start of processing for Do_Initialize_Scalars
+
+         begin
             GNAT_Pragma;
-            Check_Arg_Count (0);
             Check_Valid_Configuration_Pragma;
             Check_Restriction (No_Initialize_Scalars, N);
 
+            --  Ignore the effects of the pragma when No_Initialize_Scalars is
+            --  in effect.
+
+            if Restriction_Active (No_Initialize_Scalars) then
+               null;
+
             --  Initialize_Scalars creates false positives in CodePeer, and
             --  incorrect negative results in GNATprove mode, so ignore this
             --  pragma in these modes.
 
-            if not Restriction_Active (No_Initialize_Scalars)
-              and then not (CodePeer_Mode or GNATprove_Mode)
-            then
+            elsif CodePeer_Mode or GNATprove_Mode then
+               null;
+
+            --  Otherwise analyze the pragma
+
+            else
+               if Present (Pairs) then
+
+                  --  Install Standard in order to provide access to primitive
+                  --  types in case the expressions contain attributes such as
+                  --  Integer'Last.
+
+                  Push_Scope (Standard_Standard);
+
+                  Pair := First (Pairs);
+                  while Present (Pair) loop
+                     Analyze_Type_Value_Pair (Pair);
+                     Next (Pair);
+                  end loop;
+
+                  --  Remove Standard
+
+                  Pop_Scope;
+               end if;
+
                Init_Or_Norm_Scalars := True;
-               Initialize_Scalars := True;
+               Initialize_Scalars   := True;
             end if;
+         end Do_Initialize_Scalars;
 
          -----------------
          -- Initializes --

gcc/ada/sem_util.ads

@@ -1325,6 +1325,9 @@ package Sem_Util is
    function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean;
    --  Return whether an array type has static bounds
 
+   function Has_Static_Non_Empty_Array_Bounds (Typ : Node_Id) return Boolean;
+   --  Determine whether array type Typ has static non-empty bounds
+
    function Has_Stream (T : Entity_Id) return Boolean;
    --  Tests if type T is derived from Ada.Streams.Root_Stream_Type, or in the
    --  case of a composite type, has a component for which this predicate is
@@ -1471,6 +1474,13 @@ package Sem_Util is
    procedure Install_SPARK_Mode (Mode : SPARK_Mode_Type; Prag : Node_Id);
    --  Establish the SPARK_Mode and SPARK_Mode_Pragma currently in effect
 
+   function Invalid_Scalar_Value
+     (Loc      : Source_Ptr;
+      Scal_Typ : Scalar_Id) return Node_Id;
+   --  Obtain the invalid value for scalar type Scal_Typ as either specified by
+   --  pragma Initialize_Scalars or by the binder. Return an expression created
+   --  at source location Loc, which denotes the invalid value.
+
    function Is_Actual_Out_Parameter (N : Node_Id) return Boolean;
    --  Determines if N is an actual parameter of out mode in a subprogram call
 
@@ -2183,6 +2193,19 @@ package Sem_Util is
    --  syntactic ambiguity that results from an indexing of a function call
    --  that returns an array, so that Obj.F (X, Y) may mean F (Ob) (X, Y).
 
+   function Needs_Simple_Initialization
+     (Typ         : Entity_Id;
+      Consider_IS : Boolean := True) return Boolean;
+   --  Certain types need initialization even though there is no specific
+   --  initialization routine:
+   --    Access types (which need initializing to null)
+   --    All scalar types if Normalize_Scalars mode set
+   --    Descendants of standard string types if Normalize_Scalars mode set
+   --    Scalar types having a Default_Value attribute
+   --  Regarding Initialize_Scalars mode, this is ignored if Consider_IS is
+   --  set to False, but if Consider_IS is set to True, then the cases above
+   --  mentioning Normalize_Scalars also apply for Initialize_Scalars mode.
+
    function New_Copy_List_Tree (List : List_Id) return List_Id;
    --  Copy recursively an analyzed list of nodes. Uses New_Copy_Tree defined
    --  below. As for New_Copy_Tree, it is illegal to attempt to copy extended
@@ -2633,6 +2656,18 @@ package Sem_Util is
    --    If restriction No_Implementation_Identifiers is set, then it checks
    --    that the entity is not implementation defined.
 
+   procedure Set_Invalid_Scalar_Value
+     (Scal_Typ : Float_Scalar_Id;
+      Value    : Ureal);
+   --  Associate invalid value Value with scalar type Scal_Typ as specified by
+   --  pragma Initialize_Scalars.
+
+   procedure Set_Invalid_Scalar_Value
+     (Scal_Typ : Integer_Scalar_Id;
+      Value    : Uint);
+   --  Associate invalid value Value with scalar type Scal_Typ as specified by
+   --  pragma Initialize_Scalars.
+
    procedure Set_Name_Entity_Id (Id : Name_Id; Val : Entity_Id);
    pragma Inline (Set_Name_Entity_Id);
    --  Sets the Entity_Id value associated with the given name, which is the

gcc/ada/snames.ads-tmpl

@@ -1137,6 +1137,30 @@ package Snames is
    Name_Sequential                         : constant Name_Id := N + $;
    Last_Partition_Elaboration_Policy_Name  : constant Name_Id := N + $;
 
+   --  Names of recognized scalar families for pragma Initialize_Scalars
+
+   Name_Short_Float                    : constant Name_Id := N + $; -- GNAT
+   Name_Float                          : constant Name_Id := N + $; -- GNAT
+   Name_Long_Float                     : constant Name_Id := N + $; -- GNAT
+   Name_Long_Long_Float                : constant Name_Id := N + $; -- GNAT
+   Name_Signed_8                       : constant Name_Id := N + $; -- GNAT
+   Name_Signed_16                      : constant Name_Id := N + $; -- GNAT
+   Name_Signed_32                      : constant Name_Id := N + $; -- GNAT
+   Name_Signed_64                      : constant Name_Id := N + $; -- GNAT
+   Name_Unsigned_8                     : constant Name_Id := N + $; -- GNAT
+   Name_Unsigned_16                    : constant Name_Id := N + $; -- GNAT
+   Name_Unsigned_32                    : constant Name_Id := N + $; -- GNAT
+   Name_Unsigned_64                    : constant Name_Id := N + $; -- GNAT
+
+   subtype Scalar_Id is Name_Id range
+     Name_Short_Float .. Name_Unsigned_64;
+
+   subtype Float_Scalar_Id is Name_Id range
+     Name_Short_Float .. Name_Long_Long_Float;
+
+   subtype Integer_Scalar_Id is Name_Id range
+     Name_Signed_8 .. Name_Unsigned_64;
+
    --  Names of recognized checks for pragma Suppress
 
    --  Note: the name Atomic_Synchronization can only be specified internally