2012-02-08 Robert Dewar <dewar@adacore.com>

	* a-coinve.adb, sem_util.adb, sem_ch8.adb, a-cobove.adb,
	a-convec.adb: Minor reformatting and code reorganization.

2012-02-08  Steve Baird  <baird@adacore.com>

	* sem_cat.adb (In_Preelaborated_Unit): A child
	unit instantiation does not inherit preelaboration requirements
	from its parent.

2012-02-08  Gary Dismukes  <dismukes@adacore.com>

	* aspects.ads (type Aspect_Id): Add Aspect_Simple_Storage_Pool.
	(Impl_Defined_Aspects): Add entry for Aspect_Simple_Storage_Pool.
	(Aspect_Argument): Add Name entry for Aspect_Simple_Storage_Pool.
	(Aspect_Names): Add entry for Aspect_Simple_Storage_Pool.
	* aspects.adb (Canonical_Aspect): Add entry for
	Aspect_Simple_Storage_Pool.
	* exp_attr.adb (Expand_N_Attribute_Reference): Handle case of
	Attribute_Simple_Storage_Pool in the same way as Storage_Pool
	(add conversion, analyze/resolve). For the Storage_Size attribute,
	for the simple pool case, locate and use the simple pool type's
	Storage_Size function (if any), otherwise evaluate to zero.
	* exp_ch4.adb (Expand_N_Allocator): In the case of an allocator
	for an access type with an associated simple storage pool,
	locate and use the pool type's Allocate.
	* exp_intr.adb (Expand_Unc_Deallocation): In the case where the
	access type has a simple storage pool, locate the pool type's
	Deallocate procedure (if present) and use it as the procedure
	to call on the Free operation.
	* freeze.adb (Freeze_Entity): In the case of a full type for
	a private type defined with pragma Simple_Storage_Pool, check
	that the full type is also appropriate for the pragma. For
	a simple storage pool type, validate that the operations
	Allocate, Deallocate (if present), and Storage_Size
	(if present) are defined with appropriate expected profiles.
	(Validate_Simple_Pool_Op_Formal): New procedure
	(Validate_Simple_Pool_Operation): New procedure Add with and
	use of Rtsfind.
	* par-prag.adb: Add Pragma_Simple_Storage_Pool to case statement
	(no action required).
	* sem_attr.adb (Analyze_Attribute): For the case of the
	Storage_Pool attribute, give a warning if the prefix type has an
	associated simple storage pool, and rewrite the attribute as a
	raise of Program_Error. In the case of the Simple_Storage_Pool
	attribute, check that the prefix type has an associated simple
	storage pool, and set the attribute type to the pool's type.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Add
	Aspect_Simple_Storage_Pool case choice.
	(Analyze_Attribute_Definition_Clause): Add
	Aspect_Simple_Storage_Pool to case for Ignore_Rep_Clauses
	(no action). Add handling for Simple_Storage_Pool attribute
	definition, requiring the name to denote a simple storage pool
	object.
	(Check_Aspect_At_Freeze_Point): For a simple storage pool
	aspect, set the type to that of the name specified for the aspect.
	* sem_prag.adb (Analyze_Pragma): Add handling for pragma
	Simple_Storage_Pool, requiring that it applies to a library-level
	type declared in a package declaration that is a limited private
	or limited record type.
	* sem_res.adb (Resolve_Allocator): Flag an attempt to call a
	build-in-place function in an allocator for an access type with
	a simple storage pool as unsupported.
	* snames.ads-tmpl: Add Name_Simple_Storage_Pool.
	(type Attribute_Id): Add Attribute_Simple_Storage_Pool.
	(type Pragma_Id): Add Pragma_Simple_Storage_Pool.
	* snames.adb-tmpl (Get_Pragma_Id): Handle case of
	Name_Simple_Storage_Pool.
	(Is_Pragma_Name): Return True for Name_Simple_Storage_Pool.

2012-02-08  Cyrille Comar  <comar@adacore.com>

	* projects.texi: Clarify doc for interfaces.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183997 138bc75d-0d04-0410-961f-82ee72b054a4

21 files changed, 726 insertions, 102 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dad7bcbe0e0..16cd2e91dd6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,78 @@
+2012-02-08  Robert Dewar  <dewar@adacore.com>
+
+	* a-coinve.adb, sem_util.adb, sem_ch8.adb, a-cobove.adb,
+	a-convec.adb: Minor reformatting and code reorganization.
+
+2012-02-08  Steve Baird  <baird@adacore.com>
+
+	* sem_cat.adb (In_Preelaborated_Unit): A child
+	unit instantiation does not inherit preelaboration requirements
+	from its parent.
+
+2012-02-08  Gary Dismukes  <dismukes@adacore.com>
+
+	* aspects.ads (type Aspect_Id): Add Aspect_Simple_Storage_Pool.
+	(Impl_Defined_Aspects): Add entry for Aspect_Simple_Storage_Pool.
+	(Aspect_Argument): Add Name entry for Aspect_Simple_Storage_Pool.
+	(Aspect_Names): Add entry for Aspect_Simple_Storage_Pool.
+	* aspects.adb (Canonical_Aspect): Add entry for
+	Aspect_Simple_Storage_Pool.
+	* exp_attr.adb (Expand_N_Attribute_Reference): Handle case of
+	Attribute_Simple_Storage_Pool in the same way as Storage_Pool
+	(add conversion, analyze/resolve). For the Storage_Size attribute,
+	for the simple pool case, locate and use the simple pool type's
+	Storage_Size function (if any), otherwise evaluate to zero.
+	* exp_ch4.adb (Expand_N_Allocator): In the case of an allocator
+	for an access type with an associated simple storage pool,
+	locate and use the pool type's Allocate.
+	* exp_intr.adb (Expand_Unc_Deallocation): In the case where the
+	access type has a simple storage pool, locate the pool type's
+	Deallocate procedure (if present) and use it as the procedure
+	to call on the Free operation.
+	* freeze.adb (Freeze_Entity): In the case of a full type for
+	a private type defined with pragma Simple_Storage_Pool, check
+	that the full type is also appropriate for the pragma. For
+	a simple storage pool type, validate that the operations
+	Allocate, Deallocate (if present), and Storage_Size
+	(if present) are defined with appropriate expected profiles.
+	(Validate_Simple_Pool_Op_Formal): New procedure
+	(Validate_Simple_Pool_Operation): New procedure Add with and
+	use of Rtsfind.
+	* par-prag.adb: Add Pragma_Simple_Storage_Pool to case statement
+	(no action required).
+	* sem_attr.adb (Analyze_Attribute): For the case of the
+	Storage_Pool attribute, give a warning if the prefix type has an
+	associated simple storage pool, and rewrite the attribute as a
+	raise of Program_Error. In the case of the Simple_Storage_Pool
+	attribute, check that the prefix type has an associated simple
+	storage pool, and set the attribute type to the pool's type.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Add
+	Aspect_Simple_Storage_Pool case choice.
+	(Analyze_Attribute_Definition_Clause): Add
+	Aspect_Simple_Storage_Pool to case for Ignore_Rep_Clauses
+	(no action). Add handling for Simple_Storage_Pool attribute
+	definition, requiring the name to denote a simple storage pool
+	object.
+	(Check_Aspect_At_Freeze_Point): For a simple storage pool
+	aspect, set the type to that of the name specified for the aspect.
+	* sem_prag.adb (Analyze_Pragma): Add handling for pragma
+	Simple_Storage_Pool, requiring that it applies to a library-level
+	type declared in a package declaration that is a limited private
+	or limited record type.
+	* sem_res.adb (Resolve_Allocator): Flag an attempt to call a
+	build-in-place function in an allocator for an access type with
+	a simple storage pool as unsupported.
+	* snames.ads-tmpl: Add Name_Simple_Storage_Pool.
+	(type Attribute_Id): Add Attribute_Simple_Storage_Pool.
+	(type Pragma_Id): Add Pragma_Simple_Storage_Pool.
+	* snames.adb-tmpl (Get_Pragma_Id): Handle case of
+	Name_Simple_Storage_Pool.
+	(Is_Pragma_Name): Return True for Name_Simple_Storage_Pool.
+
+2012-02-08  Cyrille Comar  <comar@adacore.com>
+
+	* projects.texi: Clarify doc for interfaces.
+
 2012-02-07  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/Make-lang.in (GCC_LINKERFLAGS): New variable.
diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb
index aaf69c31213..9148fa17454 100644
--- a/gcc/ada/a-cobove.adb
+++ b/gcc/ada/a-cobove.adb
@@ -939,8 +939,6 @@ package body Ada.Containers.Bounded_Vectors is
               Array_Type   => Elements_Array,
               "<"          => "<");
 
-      --  Start of processing for Sort
-
       begin
          if Container.Last <= Index_Type'First then
             return;
@@ -2238,8 +2236,9 @@ package body Ada.Containers.Bounded_Vectors is
    ----------------------
 
    procedure Reverse_Elements (Container : in out Vector) is
-      E        : Elements_Array renames Container.Elements;
-      Idx, Jdx : Count_Type;
+      E   : Elements_Array renames Container.Elements;
+      Idx : Count_Type;
+      Jdx : Count_Type;
 
    begin
       if Container.Length <= 1 then
@@ -2251,9 +2250,9 @@ package body Ada.Containers.Bounded_Vectors is
       --  catch more things) instead of for element tampering (which will catch
       --  fewer things). It's true that the elements of this vector container
       --  could be safely moved around while (say) an iteration is taking place
-      --  (iteration only increments the busy counter), and so technically all
-      --  we would need here is a test for element tampering (indicated by the
-      --  lock counter), that's simply an artifact of our array-based
+      --  (iteration only increments the busy counter), and so technically
+      --  all we would need here is a test for element tampering (indicated
+      --  by the lock counter), that's simply an artifact of our array-based
       --  implementation. Logically Reverse_Elements requires a check for
       --  cursor tampering.
 
diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb
index ef5389f95a3..326524cc2f1 100644
--- a/gcc/ada/a-coinve.adb
+++ b/gcc/ada/a-coinve.adb
@@ -1402,8 +1402,6 @@ package body Ada.Containers.Indefinite_Vectors is
             Array_Type   => Elements_Array,
             "<"          => Is_Less);
 
-      --  Start of processing for Sort
-
       begin
          if Container.Last <= Index_Type'First then
             return;
@@ -3432,9 +3430,9 @@ package body Ada.Containers.Indefinite_Vectors is
       --  catch more things) instead of for element tampering (which will catch
       --  fewer things). It's true that the elements of this vector container
       --  could be safely moved around while (say) an iteration is taking place
-      --  (iteration only increments the busy counter), and so technically all
-      --  we would need here is a test for element tampering (indicated by the
-      --  lock counter), that's simply an artifact of our array-based
+      --  (iteration only increments the busy counter), and so technically
+      --  all we would need here is a test for element tampering (indicated
+      --  by the lock counter), that's simply an artifact of our array-based
       --  implementation. Logically Reverse_Elements requires a check for
       --  cursor tampering.
 
diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb
index 837c7832f53..729fead732c 100644
--- a/gcc/ada/a-convec.adb
+++ b/gcc/ada/a-convec.adb
@@ -1047,8 +1047,6 @@ package body Ada.Containers.Vectors is
               Array_Type   => Elements_Array,
               "<"          => "<");
 
-      --  Start of processing for Sort
-
       begin
          if Container.Last <= Index_Type'First then
             return;
@@ -2994,9 +2992,9 @@ package body Ada.Containers.Vectors is
       --  catch more things) instead of for element tampering (which will catch
       --  fewer things). It's true that the elements of this vector container
       --  could be safely moved around while (say) an iteration is taking place
-      --  (iteration only increments the busy counter), and so technically all
-      --  we would need here is a test for element tampering (indicated by the
-      --  lock counter), that's simply an artifact of our array-based
+      --  (iteration only increments the busy counter), and so technically
+      --  all we would need here is a test for element tampering (indicated
+      --  by the lock counter), that's simply an artifact of our array-based
       --  implementation. Logically Reverse_Elements requires a check for
       --  cursor tampering.
 
@@ -3006,22 +3004,22 @@ package body Ada.Containers.Vectors is
       end if;
 
       declare
-         I, J : Index_Type;
-         E    : Elements_Type renames Container.Elements.all;
+         K : Index_Type;
+         J : Index_Type;
+         E : Elements_Type renames Container.Elements.all;
 
       begin
-         I := Index_Type'First;
+         K := Index_Type'First;
          J := Container.Last;
-         while I < J loop
+         while K < J loop
             declare
-               EI : constant Element_Type := E.EA (I);
-
+               EK : constant Element_Type := E.EA (K);
             begin
-               E.EA (I) := E.EA (J);
-               E.EA (J) := EI;
+               E.EA (K) := E.EA (J);
+               E.EA (J) := EK;
             end;
 
-            I := I + 1;
+            K := K + 1;
             J := J - 1;
          end loop;
       end;
@@ -3116,12 +3114,12 @@ package body Ada.Containers.Vectors is
       Count : constant Count_Type'Base := Container.Length - Length;
 
    begin
-      --  Set_Length allows the user to set the length explicitly, instead of
-      --  implicitly as a side-effect of deletion or insertion. If the
+      --  Set_Length allows the user to set the length explicitly, instead
+      --  of implicitly as a side-effect of deletion or insertion. If the
       --  requested length is less then the current length, this is equivalent
       --  to deleting items from the back end of the vector. If the requested
-      --  length is greater than the current length, then this is equivalent to
-      --  inserting "space" (nonce items) at the end.
+      --  length is greater than the current length, then this is equivalent
+      --  to inserting "space" (nonce items) at the end.
 
       if Count >= 0 then
          Container.Delete_Last (Count);
@@ -3360,6 +3358,7 @@ package body Ada.Containers.Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of Length.
@@ -3440,13 +3439,11 @@ package body Ada.Containers.Vectors is
    begin
       if Position.Container = null then
          raise Constraint_Error with "Position cursor has no element";
-      end if;
-
-      if Position.Container /= Container'Unrestricted_Access then
+      elsif Position.Container /= Container'Unrestricted_Access then
          raise Program_Error with "Position cursor denotes wrong container";
+      else
+         Update_Element (Container, Position.Index, Process);
       end if;
-
-      Update_Element (Container, Position.Index, Process);
    end Update_Element;
 
    -----------
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index a0105d9433b..d78ce81427a 100755
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -298,6 +298,7 @@ package body Aspects is
     Aspect_Remote_Access_Type           => Aspect_Remote_Access_Type,
     Aspect_Read                         => Aspect_Read,
     Aspect_Shared                       => Aspect_Atomic,
+    Aspect_Simple_Storage_Pool          => Aspect_Simple_Storage_Pool,
     Aspect_Size                         => Aspect_Size,
     Aspect_Small                        => Aspect_Small,
     Aspect_Static_Predicate             => Aspect_Predicate,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 187b6451a78..bb713a42758 100755
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -74,6 +74,7 @@ package Aspects is
       Aspect_Predicate,                     -- GNAT
       Aspect_Priority,
       Aspect_Read,
+      Aspect_Simple_Storage_Pool,           -- GNAT
       Aspect_Size,
       Aspect_Small,
       Aspect_Static_Predicate,
@@ -186,6 +187,7 @@ package Aspects is
                              Aspect_Pure_Function        => True,
                              Aspect_Remote_Access_Type   => True,
                              Aspect_Shared               => True,
+                             Aspect_Simple_Storage_Pool  => True,
                              Aspect_Suppress_Debug_Info  => True,
                              Aspect_Test_Case            => True,
                              Aspect_Universal_Data       => True,
@@ -277,6 +279,7 @@ package Aspects is
                         Aspect_Predicate               => Expression,
                         Aspect_Priority                => Expression,
                         Aspect_Read                    => Name,
+                        Aspect_Simple_Storage_Pool     => Name,
                         Aspect_Size                    => Expression,
                         Aspect_Small                   => Expression,
                         Aspect_Static_Predicate        => Expression,
@@ -364,6 +367,7 @@ package Aspects is
      Aspect_Remote_Types                 => Name_Remote_Types,
      Aspect_Shared                       => Name_Shared,
      Aspect_Shared_Passive               => Name_Shared_Passive,
+     Aspect_Simple_Storage_Pool          => Name_Simple_Storage_Pool,
      Aspect_Size                         => Name_Size,
      Aspect_Small                        => Name_Small,
      Aspect_Static_Predicate             => Name_Static_Predicate,
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 14d9da1609a..a2651545871 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -4217,6 +4217,17 @@ package body Exp_Attr is
       when Attribute_Scaling =>
          Expand_Fpt_Attribute_RI (N);
 
+      -------------------------
+      -- Simple_Storage_Pool --
+      -------------------------
+
+      when Attribute_Simple_Storage_Pool =>
+         Rewrite (N,
+           Make_Type_Conversion (Loc,
+             Subtype_Mark => New_Reference_To (Etype (N), Loc),
+             Expression   => New_Reference_To (Entity (N), Loc)));
+         Analyze_And_Resolve (N, Typ);
+
       ----------
       -- Size --
       ----------
@@ -4475,7 +4486,10 @@ package body Exp_Attr is
       -- Storage_Size --
       ------------------
 
-      when Attribute_Storage_Size => Storage_Size : begin
+      when Attribute_Storage_Size => Storage_Size : declare
+         Alloc_Op  : Entity_Id := Empty;
+
+      begin
 
          --  Access type case, always go to the root type
 
@@ -4497,19 +4511,64 @@ package body Exp_Attr is
                          (Storage_Size_Variable (Root_Type (Ptyp)), Loc)))));
 
             elsif Present (Associated_Storage_Pool (Root_Type (Ptyp))) then
-               Rewrite (N,
-                 OK_Convert_To (Typ,
-                   Make_Function_Call (Loc,
-                     Name =>
-                       New_Reference_To
-                         (Find_Prim_Op
-                           (Etype (Associated_Storage_Pool (Root_Type (Ptyp))),
-                            Attribute_Name (N)),
-                          Loc),
 
-                     Parameter_Associations => New_List (
-                       New_Reference_To
-                         (Associated_Storage_Pool (Root_Type (Ptyp)), Loc)))));
+               --  If the access type is associated with a simple storage pool
+               --  object, then attempt to locate the optional Storage_Size
+               --  function of the simple storage pool type. If not found,
+               --  then the result will default to zero.
+
+               if Present (Get_Rep_Pragma (Root_Type (Ptyp),
+                                           Name_Simple_Storage_Pool))
+               then
+                  declare
+                     Pool_Type : constant Entity_Id :=
+                                   Base_Type (Etype (Entity (N)));
+
+                  begin
+                     Alloc_Op := Get_Name_Entity_Id (Name_Storage_Size);
+                     while Present (Alloc_Op) loop
+                        if Scope (Alloc_Op) = Scope (Pool_Type)
+                          and then Present (First_Formal (Alloc_Op))
+                          and then Etype (First_Formal (Alloc_Op)) = Pool_Type
+                        then
+                           exit;
+                        end if;
+
+                        Alloc_Op := Homonym (Alloc_Op);
+                     end loop;
+                  end;
+
+               --  In the normal Storage_Pool case, retrieve the primitive
+               --  function associated with the pool type.
+
+               else
+                  Alloc_Op :=
+                    Find_Prim_Op
+                      (Etype (Associated_Storage_Pool (Root_Type (Ptyp))),
+                       Attribute_Name (N));
+               end if;
+
+               --  If Storage_Size wasn't found (can only occur in the simple
+               --  storage pool case), then simply use zero for the result.
+
+               if not Present (Alloc_Op) then
+                  Rewrite (N, Make_Integer_Literal (Loc, 0));
+
+               --  Otherwise, rewrite the allocator as a call to pool type's
+               --  Storage_Size function.
+
+               else
+                  Rewrite (N,
+                    OK_Convert_To (Typ,
+                      Make_Function_Call (Loc,
+                        Name =>
+                          New_Reference_To (Alloc_Op, Loc),
+
+                        Parameter_Associations => New_List (
+                          New_Reference_To
+                            (Associated_Storage_Pool
+                               (Root_Type (Ptyp)), Loc)))));
+               end if;
 
             else
                Rewrite (N, Make_Integer_Literal (Loc, 0));
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index b0a65cf92da..605de764254 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -3565,6 +3565,31 @@ package body Exp_Ch4 is
                   Set_Procedure_To_Call (N, RTE (RE_SS_Allocate));
                end if;
 
+            --  In the case of an allocator for a simple storage pool, locate
+            --  and save a reference to the pool type's Allocate routine.
+
+            elsif Present (Get_Rep_Pragma
+                             (Etype (Pool), Name_Simple_Storage_Pool))
+            then
+               declare
+                  Alloc_Op  : Entity_Id := Get_Name_Entity_Id (Name_Allocate);
+                  Pool_Type : constant Entity_Id := Base_Type (Etype (Pool));
+
+               begin
+                  while Present (Alloc_Op) loop
+                     if Scope (Alloc_Op) = Scope (Pool_Type)
+                       and then Present (First_Formal (Alloc_Op))
+                       and then Etype (First_Formal (Alloc_Op)) = Pool_Type
+                     then
+                        Set_Procedure_To_Call (N, Alloc_Op);
+
+                        exit;
+                     end if;
+
+                     Alloc_Op := Homonym (Alloc_Op);
+                  end loop;
+               end;
+
             elsif Is_Class_Wide_Type (Etype (Pool)) then
                Set_Procedure_To_Call (N, RTE (RE_Allocate_Any));
 
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index b116a8a28f0..2707d7a2a06 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -1084,6 +1084,34 @@ package body Exp_Intr is
          if Is_RTE (Pool, RE_SS_Pool) then
             null;
 
+         --  If the pool object is of a simple storage pool type, then attempt
+         --  to locate the type's Deallocate procedure, if any, and set the
+         --  free operation's procedure to call. If the type doesn't have a
+         --  Deallocate (which is allowed), then the actual will simply be set
+         --  to null.
+
+         elsif Present (Get_Rep_Pragma
+                          (Etype (Pool), Name_Simple_Storage_Pool))
+         then
+            declare
+               Dealloc_Op  : Entity_Id := Get_Name_Entity_Id (Name_Deallocate);
+               Pool_Type : constant Entity_Id := Base_Type (Etype (Pool));
+
+            begin
+               while Present (Dealloc_Op) loop
+                  if Scope (Dealloc_Op) = Scope (Pool_Type)
+                    and then Present (First_Formal (Dealloc_Op))
+                    and then Etype (First_Formal (Dealloc_Op)) = Pool_Type
+                  then
+                     Set_Procedure_To_Call (Free_Node, Dealloc_Op);
+
+                     exit;
+                  end if;
+
+                  Dealloc_Op := Homonym (Dealloc_Op);
+               end loop;
+            end;
+
          --  Case of a class-wide pool type: make a dispatching call to
          --  Deallocate through the class-wide Deallocate_Any.
 
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 9138c3ea879..9d3dd171bb9 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -42,6 +42,7 @@ with Nmake;    use Nmake;
 with Opt;      use Opt;
 with Restrict; use Restrict;
 with Rident;   use Rident;
+with Rtsfind; use Rtsfind;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Cat;  use Sem_Cat;
@@ -4103,6 +4104,281 @@ package body Freeze is
                   end loop;
                end;
             end if;
+
+            --  If the type is a simple storage pool type, then this is where
+            --  we attempt to locate and validate its Allocate, Deallocate, and
+            --  Storage_Size operations (the first is required, and the latter
+            --  two are optional). We also verify that the full type for a
+            --  private type is allowed to be a simple storage pool type.
+
+            if Present (Get_Rep_Pragma (E, Name_Simple_Storage_Pool))
+              and then (Is_Base_Type (E) or else Has_Private_Declaration (E))
+            then
+
+               --  If the type is marked Has_Private_Declaration, then this is
+               --  a full type for a private type that was specified with the
+               --  pragma Simple_Storage_Pool, and here we ensure that the
+               --  pragma is allowed for the full type (for example, it can't
+               --  be an array type, or a nonlimited record type).
+
+               if Has_Private_Declaration (E) then
+                  if (not Is_Record_Type (E)
+                       or else not Is_Immutably_Limited_Type (E))
+                    and then not Is_Private_Type (E)
+                  then
+                     Error_Msg_Name_1 := Name_Simple_Storage_Pool;
+
+                     Error_Msg_N
+                       ("pragma% can only apply to full type that is an " &
+                        "explicitly limited type", E);
+                  end if;
+               end if;
+
+               Validate_Simple_Pool_Ops : declare
+                  Pool_Type    : Entity_Id renames E;
+                  Address_Type : constant Entity_Id := RTE (RE_Address);
+                  Stg_Cnt_Type : constant Entity_Id := RTE (RE_Storage_Count);
+
+                  procedure Validate_Simple_Pool_Op_Formal
+                    (Pool_Op        : Entity_Id;
+                     Pool_Op_Formal : in out Entity_Id;
+                     Expected_Mode  : Formal_Kind;
+                     Expected_Type  : Entity_Id;
+                     Formal_Name    : String;
+                     OK_Formal      : in out Boolean);
+                  --  Validate one formal Pool_Op_Formal of the candidate pool
+                  --  operation Pool_Op. The formal must be of Expected_Type
+                  --  and have mode Expected_Mode. OK_Formal will be set to
+                  --  False if the formal doesn't match. If OK_Formal is False
+                  --  on entry, then the formal will effectively be ignored
+                  --  (because validation of the pool op has already failed).
+                  --  Upon return, Pool_Op_Formal will be updated to the next
+                  --  formal, if any.
+
+                  procedure Validate_Simple_Pool_Operation (Op_Name : Name_Id);
+                  --  Search for and validate a simple pool operation with the
+                  --  name Op_Name. If the name is Allocate, then there must be
+                  --  exactly one such primitive operation for the simple pool
+                  --  type. If the name is Deallocate or Storage_Size, then
+                  --  there can be at most one such primitive operation. The
+                  --  profile of the located primitive must conform to what
+                  --  is expected for each operation.
+
+                  ------------------------------------
+                  -- Validate_Simple_Pool_Op_Formal --
+                  ------------------------------------
+
+                  procedure Validate_Simple_Pool_Op_Formal
+                    (Pool_Op        : Entity_Id;
+                     Pool_Op_Formal : in out Entity_Id;
+                     Expected_Mode  : Formal_Kind;
+                     Expected_Type  : Entity_Id;
+                     Formal_Name    : String;
+                     OK_Formal      : in out Boolean)
+                  is
+                  begin
+                     --  If OK_Formal is False on entry, then simply ignore
+                     --  the formal, because an earlier formal has already
+                     --  been flagged.
+
+                     if not OK_Formal then
+                        return;
+
+                     --  If no formal is passed in, then issue an error for a
+                     --  missing formal.
+
+                     elsif not Present (Pool_Op_Formal) then
+                        Error_Msg_NE
+                          ("simple storage pool op missing formal " &
+                           Formal_Name & " of type&", Pool_Op, Expected_Type);
+                        OK_Formal := False;
+
+                        return;
+                     end if;
+
+                     if Etype (Pool_Op_Formal) /= Expected_Type then
+                        --  If the pool type was expected for this formal, then
+                        --  this will not be considered a candidate operation
+                        --  for the simple pool, so we unset OK_Formal so that
+                        --  the op and any later formals will be ignored.
+
+                        if Expected_Type = Pool_Type then
+                           OK_Formal := False;
+
+                           return;
+
+                        else
+                           Error_Msg_NE
+                             ("wrong type for formal " & Formal_Name &
+                              " of simple storage pool op; expected type&",
+                              Pool_Op_Formal, Expected_Type);
+                        end if;
+                     end if;
+
+                     --  Issue error if formal's mode is not the expected one
+
+                     if Ekind (Pool_Op_Formal) /= Expected_Mode then
+                        Error_Msg_N
+                          ("wrong mode for formal of simple storage pool op",
+                           Pool_Op_Formal);
+                     end if;
+
+                     --  Advance to the next formal
+
+                     Next_Formal (Pool_Op_Formal);
+                  end Validate_Simple_Pool_Op_Formal;
+
+                  ------------------------------------
+                  -- Validate_Simple_Pool_Operation --
+                  ------------------------------------
+
+                  procedure Validate_Simple_Pool_Operation
+                    (Op_Name : Name_Id)
+                  is
+                     Op       : Entity_Id;
+                     Found_Op : Entity_Id := Empty;
+                     Formal   : Entity_Id;
+                     Is_OK    : Boolean;
+
+                  begin
+                     pragma Assert
+                       (Op_Name = Name_Allocate
+                          or else Op_Name = Name_Deallocate
+                          or else Op_Name = Name_Storage_Size);
+
+                     Error_Msg_Name_1 := Op_Name;
+
+                     --  For each homonym declared immediately in the scope
+                     --  of the simple storage pool type, determine whether
+                     --  the homonym is an operation of the pool type, and,
+                     --  if so, check that its profile is as expected for
+                     --  a simple pool operation of that name.
+
+                     Op := Get_Name_Entity_Id (Op_Name);
+                     while Present (Op) loop
+                        if Ekind_In (Op, E_Function, E_Procedure)
+                          and then Scope (Op) = Current_Scope
+                        then
+                           Formal := First_Entity (Op);
+
+                           Is_OK := True;
+
+                           --  The first parameter must be of the pool type
+                           --  in order for the operation to qualify.
+
+                           if Op_Name = Name_Storage_Size then
+                              Validate_Simple_Pool_Op_Formal
+                                (Op, Formal, E_In_Parameter, Pool_Type,
+                                 "Pool", Is_OK);
+
+                           else
+                              Validate_Simple_Pool_Op_Formal
+                                (Op, Formal, E_In_Out_Parameter, Pool_Type,
+                                 "Pool", Is_OK);
+                           end if;
+
+                           --  If another operation with this name has already
+                           --  been located for the type, then flag an error,
+                           --  since we only allow the type to have a single
+                           --  such primitive.
+
+                           if Present (Found_Op) and then Is_OK then
+                              Error_Msg_NE
+                                ("only one % operation allowed for " &
+                                 "simple storage pool type&", Op, Pool_Type);
+                           end if;
+
+                           --  In the case of Allocate and Deallocate, a formal
+                           --  of type System.Address is required.
+
+                           if Op_Name = Name_Allocate then
+                              Validate_Simple_Pool_Op_Formal
+                                (Op, Formal, E_Out_Parameter,
+                                 Address_Type, "Storage_Address", Is_OK);
+
+                           elsif Op_Name = Name_Deallocate then
+                              Validate_Simple_Pool_Op_Formal
+                                (Op, Formal, E_In_Parameter,
+                                 Address_Type, "Storage_Address", Is_OK);
+                           end if;
+
+                           --  In the case of Allocate and Deallocate, formals
+                           --  of type Storage_Count are required as the third
+                           --  and fourth parameters.
+
+                           if Op_Name /= Name_Storage_Size then
+                              Validate_Simple_Pool_Op_Formal
+                                (Op, Formal, E_In_Parameter,
+                                 Stg_Cnt_Type, "Size_In_Storage_Units", Is_OK);
+
+                              Validate_Simple_Pool_Op_Formal
+                                (Op, Formal, E_In_Parameter,
+                                 Stg_Cnt_Type, "Alignment", Is_OK);
+                           end if;
+
+                           --  If no mismatched formals have been found (Is_OK)
+                           --  and no excess formals are present, then this
+                           --  operation has been validated, so record it.
+
+                           if not Present (Formal) and then Is_OK then
+                              Found_Op := Op;
+                           end if;
+                        end if;
+
+                        Op := Homonym (Op);
+                     end loop;
+
+                     --  There must be a valid Allocate operation for the type,
+                     --  so issue an error if none was found.
+
+                     if Op_Name = Name_Allocate
+                       and then not Present (Found_Op)
+                     then
+                        Error_Msg_N ("missing % operation for simple " &
+                                     "storage pool type", Pool_Type);
+
+                     elsif Present (Found_Op) then
+                        --  Simple pool operations can't be abstract
+
+                        if Is_Abstract_Subprogram (Found_Op) then
+                           Error_Msg_N
+                             ("simple storage pool operation must not be " &
+                              "abstract", Found_Op);
+                        end if;
+
+                        --  The Storage_Size operation must be a function with
+                        --  Storage_Count as its result type.
+
+                        if Op_Name = Name_Storage_Size then
+                           if Ekind (Found_Op) = E_Procedure then
+                              Error_Msg_N
+                                ("% operation must be a function", Found_Op);
+
+                           elsif Etype (Found_Op) /= Stg_Cnt_Type then
+                              Error_Msg_NE
+                                ("wrong result type for%, expected type&",
+                                 Found_Op, Stg_Cnt_Type);
+                           end if;
+
+                        --  Allocate and Deallocate must be procedures
+
+                        elsif Ekind (Found_Op) = E_Function then
+                           Error_Msg_N
+                             ("% operation must be a procedure", Found_Op);
+                        end if;
+                     end if;
+                  end Validate_Simple_Pool_Operation;
+
+               --  Start of processing for Validate_Simple_Pool_Ops
+
+               begin
+                  Validate_Simple_Pool_Operation (Name_Allocate);
+
+                  Validate_Simple_Pool_Operation (Name_Deallocate);
+
+                  Validate_Simple_Pool_Operation (Name_Storage_Size);
+               end Validate_Simple_Pool_Ops;
+            end if;
          end if;
 
          --  Now that all types from which E may depend are frozen, see if the
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 328ddb63f16..6402ff4e880 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1230,6 +1230,7 @@ begin
            Pragma_Shared_Passive                 |
            Pragma_Short_Circuit_And_Or           |
            Pragma_Short_Descriptors              |
+           Pragma_Simple_Storage_Pool            |
            Pragma_Storage_Size                   |
            Pragma_Storage_Unit                   |
            Pragma_Static_Elaboration_Desired     |
diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index 8f9faad645f..88a623d4c31 100644
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -1767,10 +1767,10 @@ language and takes a list of sources as parameter.
 @table @asis
 @item @b{Library_Interface}:
 @cindex @code{Library_Interface}
-  This attribute defines an explicit subset of the units of the project.
-  Projects importing this library project may only "with" units whose sources
-  are listed in the @code{Library_Interface}. Other sources are considered
-  implementation units.
+  This attribute defines an explicit subset of the units of the project. Units
+  from projects importing this library project may only "with" units whose
+  sources are listed in the @code{Library_Interface}. Other sources are
+  considered implementation units.
 
 @smallexample @c projectfile
 @group
@@ -1781,11 +1781,13 @@ language and takes a list of sources as parameter.
 @end smallexample
 
 @item @b{Interfaces}
-  This attribute defnes an explicit subset of the source files of a project.
-  It may be used as a replacement for attribute @code{Library_Interface}. For
-  multi-language library projects, it is the only way to make the project a
-  Stand-Alone Library project and at the same time to reduce the non Ada
-  interfacing sources.
+  This attribute defines an explicit subset of the source files of a project.
+  Sources from projects importing this project, can only depend on sources from
+  this subset. This attribute can be used on non library projects. It can also
+  be used as a replacement for attribute @code{Library_Interface}, in which
+  case, units have to be replaced by source files. For multi-language library
+  projects, it is the only way to make the project a Stand-Alone Library project
+  whose interface is not purely Ada.
 
 @item @b{Library_Standalone}:
 @cindex @code{Library_Standalone}
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index a832612009b..aa798b00973 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4528,7 +4528,8 @@ package body Sem_Attr is
       -- Storage_Pool --
       ------------------
 
-      when Attribute_Storage_Pool => Storage_Pool :
+      when Attribute_Storage_Pool        |
+           Attribute_Simple_Storage_Pool => Storage_Pool :
       begin
          Check_E0;
 
@@ -4546,7 +4547,38 @@ package body Sem_Attr is
                Set_Entity (N, RTE (RE_Global_Pool_Object));
             end if;
 
-            Set_Etype (N, Class_Wide_Type (RTE (RE_Root_Storage_Pool)));
+            if Attr_Id = Attribute_Storage_Pool then
+               if Present (Get_Rep_Pragma (Etype (Entity (N)),
+                                           Name_Simple_Storage_Pool))
+               then
+                  Error_Msg_Name_1 := Aname;
+                  Error_Msg_N ("cannot use % attribute for type with simple " &
+                               "storage pool?", N);
+                  Error_Msg_N
+                     ("\Program_Error will be raised at run time?", N);
+
+                  Rewrite
+                    (N, Make_Raise_Program_Error
+                          (Sloc (N), Reason => PE_Explicit_Raise));
+               end if;
+
+               Set_Etype (N, Class_Wide_Type (RTE (RE_Root_Storage_Pool)));
+
+            --  In the Simple_Storage_Pool case, verify that the pool entity is
+            --  actually of a simple storage pool type, and set the attribute's
+            --  type to the pool object's type.
+
+            else
+               if not Present (Get_Rep_Pragma (Etype (Entity (N)),
+                                               Name_Simple_Storage_Pool))
+               then
+                  Error_Attr_P
+                    ("cannot use % attribute for type without simple " &
+                     "storage pool");
+               end if;
+
+               Set_Etype (N, Etype (Entity (N)));
+            end if;
 
             --  Validate_Remote_Access_To_Class_Wide_Type for attribute
             --  Storage_Pool since this attribute is not defined for such
@@ -7931,6 +7963,7 @@ package body Sem_Attr is
            Attribute_Priority                   |
            Attribute_Read                       |
            Attribute_Result                     |
+           Attribute_Simple_Storage_Pool        |
            Attribute_Storage_Pool               |
            Attribute_Storage_Size               |
            Attribute_Storage_Unit               |
diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 91d731f14b2..cbb86c8efe0 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -486,11 +486,22 @@ package body Sem_Cat is
    ---------------------------
 
    function In_Preelaborated_Unit return Boolean is
-      Unit_Entity : constant Entity_Id := Current_Scope;
+      Unit_Entity : Entity_Id := Current_Scope;
       Unit_Kind   : constant Node_Kind :=
                       Nkind (Unit (Cunit (Current_Sem_Unit)));
 
    begin
+      --  If evaluating actuals for a child unit instantiation, then ignore
+      --  the preelaboration status of the parent; use the child instead.
+
+      if Is_Compilation_Unit (Unit_Entity)
+        and then Unit_Kind in N_Generic_Instantiation
+        and then not In_Same_Source_Unit (Unit_Entity,
+                                          Cunit (Current_Sem_Unit))
+      then
+         Unit_Entity := Cunit_Entity (Current_Sem_Unit);
+      end if;
+
       --  There are no constraints on the body of Remote_Call_Interface or
       --  Remote_Types packages.
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 502bc13c8ea..5fe669d51f2 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1064,23 +1064,24 @@ package body Sem_Ch13 is
 
                --  Aspects corresponding to attribute definition clauses
 
-               when Aspect_Address        |
-                    Aspect_Alignment      |
-                    Aspect_Bit_Order      |
-                    Aspect_Component_Size |
-                    Aspect_External_Tag   |
-                    Aspect_Input          |
-                    Aspect_Machine_Radix  |
-                    Aspect_Object_Size    |
-                    Aspect_Output         |
-                    Aspect_Read           |
-                    Aspect_Size           |
-                    Aspect_Small          |
-                    Aspect_Storage_Pool   |
-                    Aspect_Storage_Size   |
-                    Aspect_Stream_Size    |
-                    Aspect_Value_Size     |
-                    Aspect_Write          =>
+               when Aspect_Address             |
+                    Aspect_Alignment           |
+                    Aspect_Bit_Order           |
+                    Aspect_Component_Size      |
+                    Aspect_External_Tag        |
+                    Aspect_Input               |
+                    Aspect_Machine_Radix       |
+                    Aspect_Object_Size         |
+                    Aspect_Output              |
+                    Aspect_Read                |
+                    Aspect_Size                |
+                    Aspect_Small               |
+                    Aspect_Simple_Storage_Pool |
+                    Aspect_Storage_Pool        |
+                    Aspect_Storage_Size        |
+                    Aspect_Stream_Size         |
+                    Aspect_Value_Size          |
+                    Aspect_Write               =>
 
                   --  Construct the attribute definition clause
 
@@ -2210,13 +2211,14 @@ package body Sem_Ch13 is
             --  legality, e.g. failing to provide a stream attribute for a
             --  type may make a program illegal.
 
-            when Attribute_External_Tag |
-                 Attribute_Input        |
-                 Attribute_Output       |
-                 Attribute_Read         |
-                 Attribute_Storage_Pool |
-                 Attribute_Storage_Size |
-                 Attribute_Write        =>
+            when Attribute_External_Tag        |
+                 Attribute_Input               |
+                 Attribute_Output              |
+                 Attribute_Read                |
+                 Attribute_Simple_Storage_Pool |
+                 Attribute_Storage_Pool        |
+                 Attribute_Storage_Size        |
+                 Attribute_Write               =>
                null;
 
             --  Other cases are errors ("attribute& cannot be set with
@@ -3163,7 +3165,7 @@ package body Sem_Ch13 is
 
          --  Storage_Pool attribute definition clause
 
-         when Attribute_Storage_Pool => Storage_Pool : declare
+         when Attribute_Storage_Pool | Attribute_Simple_Storage_Pool => declare
             Pool : Entity_Id;
             T    : Entity_Id;
 
@@ -3194,8 +3196,24 @@ package body Sem_Ch13 is
                return;
             end if;
 
-            Analyze_And_Resolve
-              (Expr, Class_Wide_Type (RTE (RE_Root_Storage_Pool)));
+            if Id = Attribute_Storage_Pool then
+               Analyze_And_Resolve
+                 (Expr, Class_Wide_Type (RTE (RE_Root_Storage_Pool)));
+
+            --  In the Simple_Storage_Pool case, we allow a variable of any
+            --  Simple_Storage_Pool type, so we Resolve without imposing an
+            --  expected type.
+
+            else
+               Analyze_And_Resolve (Expr);
+
+               if not Present (Get_Rep_Pragma
+                                 (Etype (Expr), Name_Simple_Storage_Pool))
+               then
+                  Error_Msg_N
+                    ("expression must be of a simple storage pool type", Expr);
+               end if;
+            end if;
 
             if not Denotes_Variable (Expr) then
                Error_Msg_N ("storage pool must be a variable", Expr);
@@ -3280,7 +3298,7 @@ package body Sem_Ch13 is
                Error_Msg_N ("incorrect reference to a Storage Pool", Expr);
                return;
             end if;
-         end Storage_Pool;
+         end;
 
          ------------------
          -- Storage_Size --
@@ -6147,6 +6165,13 @@ package body Sem_Ch13 is
          when Aspect_Small =>
             T := Universal_Real;
 
+         --  For a simple storage pool, we have to retrieve the type of the
+         --  pool object associated with the aspect's corresponding attribute
+         --  definition clause.
+
+         when Aspect_Simple_Storage_Pool =>
+            T := Etype (Expression (Aspect_Rep_Item (ASN)));
+
          when Aspect_Storage_Pool =>
             T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));
 
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 94f369adc8e..dda30af7e1c 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -2664,11 +2664,14 @@ package body Sem_Ch8 is
 
          if not Is_Actual
            and then (Old_S = New_S
-                      or else (Nkind (Nam) /= N_Expanded_Name
-                        and then Chars (Old_S) = Chars (New_S))
-                      or else (Nkind (Nam) = N_Expanded_Name
-                        and then Entity (Prefix (Nam)) = Current_Scope
-                        and then Chars (Selector_Name (Nam)) = Chars (New_S)))
+                      or else
+                        (Nkind (Nam) /= N_Expanded_Name
+                          and then Chars (Old_S) = Chars (New_S))
+                      or else
+                        (Nkind (Nam) = N_Expanded_Name
+                          and then Entity (Prefix (Nam)) = Current_Scope
+                          and then
+                            Chars (Selector_Name (Nam)) = Chars (New_S)))
          then
             Error_Msg_N ("subprogram cannot rename itself", N);
          end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 3a16969ac34..3268c67b1f9 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -13150,6 +13150,65 @@ package body Sem_Prag is
             Check_Valid_Configuration_Pragma;
             Short_Descriptors := True;
 
+         -------------------------
+         -- Simple_Storage_Pool --
+         -------------------------
+
+         --  pragma Simple_Storage_Pool (type_LOCAL_NAME);
+
+         when Pragma_Simple_Storage_Pool => Simple_Storage_Pool : declare
+               Type_Id : Node_Id;
+               Typ     : Entity_Id;
+
+         begin
+            GNAT_Pragma;
+            Check_Arg_Count (1);
+            Check_Arg_Is_Library_Level_Local_Name (Arg1);
+
+            Type_Id := Get_Pragma_Arg (Arg1);
+            Find_Type (Type_Id);
+            Typ := Entity (Type_Id);
+
+            if Typ = Any_Type then
+               return;
+            end if;
+
+            --  We require the pragma to apply to a type declared in a package
+            --  declaration, but not (immediately) within a package body.
+
+            if Ekind (Current_Scope) /= E_Package
+              or else In_Package_Body (Current_Scope)
+            then
+               Error_Pragma
+                 ("pragma% can only apply to type declared immediately " &
+                  "within a package declaration");
+            end if;
+
+            --  A simple storage pool type must be an immutably limited record
+            --  or private type. If the pragma is given for a private type,
+            --  the full type is similarly restricted (which is checked later
+            --  in Freeze_Entity).
+
+            if Is_Record_Type (Typ)
+              and then not Is_Immutably_Limited_Type (Typ)
+            then
+               Error_Pragma
+                 ("pragma% can only apply to explicitly limited record type");
+
+            elsif Is_Private_Type (Typ) and then not Is_Limited_Type (Typ) then
+               Error_Pragma
+                 ("pragma% can only apply to a private type that is limited");
+
+            elsif not Is_Record_Type (Typ)
+              and then not Is_Private_Type (Typ)
+            then
+               Error_Pragma
+                 ("pragma% can only apply to limited record or private type");
+            end if;
+
+            Record_Rep_Item (Typ, N);
+         end Simple_Storage_Pool;
+
          ----------------------
          -- Source_File_Name --
          ----------------------
@@ -15117,6 +15176,7 @@ package body Sem_Prag is
       Pragma_Shared                         => -1,
       Pragma_Shared_Passive                 => -1,
       Pragma_Short_Descriptors              =>  0,
+      Pragma_Simple_Storage_Pool            =>  0,
       Pragma_Source_File_Name               => -1,
       Pragma_Source_File_Name_Project       => -1,
       Pragma_Source_Reference               => -1,
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 0fecd5b53d7..7c8de23f943 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4228,6 +4228,31 @@ package body Sem_Res is
             Wrong_Type (Expression (E), Etype (E));
          end if;
 
+         --  Calls to build-in-place functions are not currently supported in
+         --  allocators for access types associated with a simple storage pool.
+         --  Supporting such allocators may require passing additional implicit
+         --  parameters to build-in-place functions (or a significant revision
+         --  of the current b-i-p implementation to unify the handling for
+         --  multiple kinds of storage pools). ???
+
+         if Is_Immutably_Limited_Type (Desig_T)
+           and then Nkind (Expression (E)) = N_Function_Call
+         then
+            declare
+               Pool : constant Entity_Id
+                        := Associated_Storage_Pool (Root_Type (Typ));
+            begin
+               if Present (Pool)
+                 and then Present (Get_Rep_Pragma
+                                     (Etype (Pool), Name_Simple_Storage_Pool))
+               then
+                  Error_Msg_N
+                    ("limited function calls not yet supported in simple " &
+                     "storage pool allocators", Expression (E));
+               end if;
+            end;
+         end if;
+
          --  A special accessibility check is needed for allocators that
          --  constrain access discriminants. The level of the type of the
          --  expression used to constrain an access discriminant cannot be
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3da93ea2931..14376bbfa08 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7138,18 +7138,14 @@ package body Sem_Util is
       --  is fully initialized.
 
       if Is_Scalar_Type (Typ) then
-         return
-           Ada_Version >= Ada_2012
-             and then Has_Default_Aspect (Typ);
+         return Ada_Version >= Ada_2012 and then Has_Default_Aspect (Typ);
 
       elsif Is_Access_Type (Typ) then
          return True;
 
       elsif Is_Array_Type (Typ) then
          if Is_Fully_Initialized_Type (Component_Type (Typ))
-           or else
-             (Ada_Version >= Ada_2012
-                and then Has_Default_Aspect (Typ))
+           or else (Ada_Version >= Ada_2012 and then Has_Default_Aspect (Typ))
          then
             return True;
          end if;
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index e6753b583de..f49e75b5dc6 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -217,6 +217,8 @@ package body Snames is
          return Pragma_Priority;
       elsif N = Name_Relative_Deadline then
          return Pragma_Relative_Deadline;
+      elsif N = Name_Simple_Storage_Pool then
+         return Pragma_Simple_Storage_Pool;
       elsif N = Name_Storage_Size then
          return Pragma_Storage_Size;
       elsif N = Name_Storage_Unit then
@@ -414,6 +416,7 @@ package body Snames is
         or else N = Name_Interface
         or else N = Name_Relative_Deadline
         or else N = Name_Priority
+        or else N = Name_Simple_Storage_Pool
         or else N = Name_Storage_Size
         or else N = Name_Storage_Unit;
    end Is_Pragma_Name;
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index f004adfd00c..3bf9f12668c 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -909,6 +909,7 @@ package Snames is
    Name_Elab_Body                      : constant Name_Id := N + $; -- GNAT
    Name_Elab_Spec                      : constant Name_Id := N + $; -- GNAT
    Name_Elab_Subp_Body                 : constant Name_Id := N + $; -- GNAT
+   Name_Simple_Storage_Pool            : constant Name_Id := N + $; -- GNAT
    Name_Storage_Pool                   : constant Name_Id := N + $;
 
    --  These attributes are the ones that return types
@@ -1459,6 +1460,7 @@ package Snames is
       Attribute_Elab_Body,
       Attribute_Elab_Spec,
       Attribute_Elab_Subp_Body,
+      Attribute_Simple_Storage_Pool,
       Attribute_Storage_Pool,
 
       --  Type attributes
@@ -1730,6 +1732,7 @@ package Snames is
       Pragma_Fast_Math,
       Pragma_Interface,
       Pragma_Priority,
+      Pragma_Simple_Storage_Pool,
       Pragma_Storage_Size,
       Pragma_Storage_Unit,