2010-10-11 Robert Dewar <dewar@adacore.com>

	* sem_prag.adb, sem_aggr.adb, sprint.adb: Minor reformatting.

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* exp_ch5.ads, exp_ch6.ads (Expand_N_Extended_Return_Statement): Moved
	to exp_ch6.
	(Expand_N_Simple_Return_Statement): Moved to exp_ch6.
	* exp_ch5.adb, exp_ch6.adb (Expand_Non_Function_Return): Moved to
	exp_ch6.
	(Expand_Simple_Function_Return): Move to exp_ch6.
	(Expand_N_Extended_Return_Statement): Moved to exp_ch6.
	(Expand_N_Simple_Return_Statement): Moved to exp_ch6.

2010-10-11  Robert Dewar  <dewar@adacore.com>

	* snames.ads-tmpl: Add names for aspects.
	* aspects.ads, aspects.adb: New.
	* gcc-interface/Make-lang.in: Update dependencies.


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

12 files changed, 1891 insertions, 1586 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 30110fb3946..1c548973c67 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2010-10-11  Robert Dewar  <dewar@adacore.com>
+
+	* sem_prag.adb, sem_aggr.adb, sprint.adb: Minor reformatting.
+
+2010-10-11  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch5.ads, exp_ch6.ads (Expand_N_Extended_Return_Statement): Moved
+	to exp_ch6.
+	(Expand_N_Simple_Return_Statement): Moved to exp_ch6.
+	* exp_ch5.adb, exp_ch6.adb (Expand_Non_Function_Return): Moved to
+	exp_ch6.
+	(Expand_Simple_Function_Return): Move to exp_ch6.
+	(Expand_N_Extended_Return_Statement): Moved to exp_ch6.
+	(Expand_N_Simple_Return_Statement): Moved to exp_ch6.
+
+2010-10-11  Robert Dewar  <dewar@adacore.com>
+
+	* snames.ads-tmpl: Add names for aspects.
+	* aspects.ads, aspects.adb: New.
+	* gcc-interface/Make-lang.in: Update dependencies.
 2010-10-11  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch6.adb (Expand_Actuals): If an actual is the current instance of
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
new file mode 100755
index 00000000000..a0382e788f4
--- /dev/null
+++ b/gcc/ada/aspects.adb
@@ -0,0 +1,104 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              A S P E C T S                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--            Copyright (C) 2010, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Snames; use Snames;
+
+package body Aspects is
+
+   type Aspect_Entry is record
+      Nam : Name_Id;
+      Asp : Aspect_Id;
+   end record;
+
+   Aspect_Names : constant array (Integer range <>) of Aspect_Entry := (
+     (Name_Ada_2005,                     Aspect_Ada_2005),
+     (Name_Ada_2012,                     Aspect_Ada_2012),
+     (Name_Address,                      Aspect_Address),
+     (Name_Aliased,                      Aspect_Aliased),
+     (Name_Alignment,                    Aspect_Alignment),
+     (Name_Atomic,                       Aspect_Atomic),
+     (Name_Atomic_Components,            Aspect_Atomic_Components),
+     (Name_Bit_Order,                    Aspect_Bit_Order),
+     (Name_C_Pass_By_Copy,               Aspect_C_Pass_By_Copy),
+     (Name_Component_Size,               Aspect_Component_Size),
+     (Name_Discard_Names,                Aspect_Discard_Names),
+     (Name_External_Tag,                 Aspect_External_Tag),
+     (Name_Favor_Top_Level,              Aspect_Favor_Top_Level),
+     (Name_Inline,                       Aspect_Inline),
+     (Name_Inline_Always,                Aspect_Inline_Always),
+     (Name_Invariant,                    Aspect_Invariant),
+     (Name_Machine_Radix,                Aspect_Machine_Radix),
+     (Name_Object_Size,                  Aspect_Object_Size),
+     (Name_Pack,                         Aspect_Pack),
+     (Name_Persistent_BSS,               Aspect_Persistent_BSS),
+     (Name_Post,                         Aspect_Post),
+     (Name_Postcondition,                Aspect_Postcondition),
+     (Name_Pre,                          Aspect_Pre),
+     (Name_Precondition,                 Aspect_Precondition),
+     (Name_Predicate,                    Aspect_Predicate),
+     (Name_Preelaborable_Initialization, Aspect_Preelaborable_Initialization),
+     (Name_Psect_Object,                 Aspect_Psect_Object),
+     (Name_Pure_Function,                Aspect_Pure_Function),
+     (Name_Shared,                       Aspect_Shared),
+     (Name_Size,                         Aspect_Size),
+     (Name_Storage_Pool,                 Aspect_Storage_Pool),
+     (Name_Storage_Size,                 Aspect_Storage_Size),
+     (Name_Stream_Size,                  Aspect_Stream_Size),
+     (Name_Suppress,                     Aspect_Suppress),
+     (Name_Suppress_Debug_Info,          Aspect_Suppress_Debug_Info),
+     (Name_Unchecked_Union,              Aspect_Unchecked_Union),
+     (Name_Universal_Aliasing,           Aspect_Universal_Aliasing),
+     (Name_Unmodified,                   Aspect_Unmodified),
+     (Name_Unreferenced,                 Aspect_Unreferenced),
+     (Name_Unreferenced_Objects,         Aspect_Unreferenced_Objects),
+     (Name_Unsuppress,                   Aspect_Unsuppress),
+     (Name_Value_Size,                   Aspect_Value_Size),
+     (Name_Volatile,                     Aspect_Volatile),
+     (Name_Volatile_Components,          Aspect_Volatile_Components),
+     (Name_Warnings,                     Aspect_Warnings),
+     (Name_Weak_External,                Aspect_Weak_External));
+
+   -------------------
+   -- Get_Aspect_Id --
+   -------------------
+
+   function Get_Aspect_Id (Name : Name_Id) return Aspect_Id is
+   begin
+      for J in Aspect_Names'Range loop
+         if Aspect_Names (J).Nam = Name then
+            return Aspect_Names (J).Asp;
+         end if;
+      end loop;
+
+      return No_Aspect;
+   end Get_Aspect_Id;
+
+end Aspects;
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
new file mode 100755
index 00000000000..ac9e231de57
--- /dev/null
+++ b/gcc/ada/aspects.ads
@@ -0,0 +1,161 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              A S P E C T S                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--            Copyright (C) 2010, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package defines the aspects that are recognized in aspect
+--  specifications. We separate this off in its own packages to that
+--  it can be accessed by the parser without dragging in Sem_Asp
+
+with Namet; use Namet;
+
+package Aspects is
+
+   type Aspect_Id is
+     (No_Aspect,                            -- Dummy entry for no aspect
+      Aspect_Ada_2005,                      -- GNAT
+      Aspect_Ada_2012,                      -- GNAT
+      Aspect_Address,
+      Aspect_Aliased,
+      Aspect_Alignment,
+      Aspect_Atomic,
+      Aspect_Atomic_Components,
+      Aspect_Bit_Order,
+      Aspect_C_Pass_By_Copy,
+      Aspect_Component_Size,
+      Aspect_Discard_Names,
+      Aspect_External_Tag,
+      Aspect_Favor_Top_Level,               -- GNAT
+      Aspect_Inline,
+      Aspect_Inline_Always,                 -- GNAT
+      Aspect_Invariant,
+      Aspect_Machine_Radix,
+      Aspect_Object_Size,                   -- GNAT
+      Aspect_Pack,
+      Aspect_Persistent_BSS,                -- GNAT
+      Aspect_Post,
+      Aspect_Postcondition,                 -- GNAT (equivalent to Post)
+      Aspect_Pre,
+      Aspect_Precondition,                  -- GNAT (equivalent to Pre)
+      Aspect_Predicate,                     -- GNAT???
+      Aspect_Preelaborable_Initialization,
+      Aspect_Psect_Object,                  -- GNAT
+      Aspect_Pure_Function,                 -- GNAT
+      Aspect_Shared,                        -- GNAT (equivalent to Atomic)
+      Aspect_Size,
+      Aspect_Storage_Pool,
+      Aspect_Storage_Size,
+      Aspect_Stream_Size,
+      Aspect_Suppress,
+      Aspect_Suppress_Debug_Info,           -- GNAT
+      Aspect_Unchecked_Union,
+      Aspect_Universal_Aliasing,            -- GNAT
+      Aspect_Unmodified,                    -- GNAT
+      Aspect_Unreferenced,                  -- GNAT
+      Aspect_Unreferenced_Objects,          -- GNAT
+      Aspect_Unsuppress,
+      Aspect_Value_Size,                    -- GNAT
+      Aspect_Volatile,
+      Aspect_Volatile_Components,
+      Aspect_Warnings,                      -- GNAT
+      Aspect_Weak_External);                -- GNAT
+
+   --  The following array indicates aspects that accept 'Class
+
+   Class_Aspect_OK : constant array (Aspect_Id) of Boolean :=
+                       (Aspect_Invariant     => True,
+                        Aspect_Pre           => True,
+                        Aspect_Precondition  => True,
+                        Aspect_Post          => True,
+                        Aspect_Postcondition => True,
+                        others               => False);
+
+   --  The following type is used for indicating allowed expression forms
+
+   type Aspect_Expression is
+     (Optional,               -- Optional boolean expression
+      Expression,             -- Required non-boolean expression
+      Name);                  -- Required name
+
+   --  The following array indicates what argument type is required
+
+   Aspect_Argument : constant array (Aspect_Id) of Aspect_Expression :=
+                       (No_Aspect                           => Optional,
+                        Aspect_Ada_2005                     => Optional,
+                        Aspect_Ada_2012                     => Optional,
+                        Aspect_Address                      => Expression,
+                        Aspect_Aliased                      => Optional,
+                        Aspect_Alignment                    => Expression,
+                        Aspect_Atomic                       => Optional,
+                        Aspect_Atomic_Components            => Optional,
+                        Aspect_Bit_Order                    => Expression,
+                        Aspect_C_Pass_By_Copy               => Optional,
+                        Aspect_Component_Size               => Expression,
+                        Aspect_Discard_Names                => Optional,
+                        Aspect_External_Tag                 => Expression,
+                        Aspect_Favor_Top_Level              => Optional,
+                        Aspect_Inline                       => Optional,
+                        Aspect_Inline_Always                => Optional,
+                        Aspect_Invariant                    => Expression,
+                        Aspect_Machine_Radix                => Expression,
+                        Aspect_Object_Size                  => Expression,
+                        Aspect_Pack                         => Optional,
+                        Aspect_Persistent_BSS               => Optional,
+                        Aspect_Post                         => Expression,
+                        Aspect_Postcondition                => Expression,
+                        Aspect_Pre                          => Expression,
+                        Aspect_Precondition                 => Expression,
+                        Aspect_Predicate                    => Expression,
+                        Aspect_Preelaborable_Initialization => Optional,
+                        Aspect_Psect_Object                 => Optional,
+                        Aspect_Pure_Function                => Optional,
+                        Aspect_Shared                       => Optional,
+                        Aspect_Size                         => Expression,
+                        Aspect_Storage_Pool                 => Expression,
+                        Aspect_Storage_Size                 => Expression,
+                        Aspect_Stream_Size                  => Expression,
+                        Aspect_Suppress                     => Name,
+                        Aspect_Suppress_Debug_Info          => Optional,
+                        Aspect_Unchecked_Union              => Optional,
+                        Aspect_Universal_Aliasing           => Optional,
+                        Aspect_Unmodified                   => Optional,
+                        Aspect_Unreferenced                 => Optional,
+                        Aspect_Unreferenced_Objects         => Optional,
+                        Aspect_Unsuppress                   => Name,
+                        Aspect_Value_Size                   => Expression,
+                        Aspect_Volatile                     => Optional,
+                        Aspect_Volatile_Components          => Optional,
+                        Aspect_Warnings                     => Name,
+                        Aspect_Weak_External                => Optional);
+
+   function Get_Aspect_Id (Name : Name_Id) return Aspect_Id;
+   --  Given a name Nam, returns the corresponding aspect id value. If the name
+   --  does not match any aspect, then No_Aspect is returned as the result.
+
+end Aspects;
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index a28c5ab1be0..6ca2c8c8f3f 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -27,7 +27,6 @@ with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
-with Exp_Atag; use Exp_Atag;
 with Exp_Aggr; use Exp_Aggr;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch7;  use Exp_Ch7;
@@ -104,16 +103,6 @@ package body Exp_Ch5 is
    --  clause (this last case is required because holes in the tagged type
    --  might be filled with components from child types).
 
-   procedure Expand_Non_Function_Return (N : Node_Id);
-   --  Called by Expand_N_Simple_Return_Statement in case we're returning from
-   --  a procedure body, entry body, accept statement, or extended return
-   --  statement.  Note that all non-function returns are simple return
-   --  statements.
-
-   procedure Expand_Simple_Function_Return (N : Node_Id);
-   --  Expand simple return from function. In the case where we are returning
-   --  from a function body this is called by Expand_N_Simple_Return_Statement.
-
    function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;
    --  Generate the necessary code for controlled and tagged assignment, that
    --  is to say, finalization of the target before, adjustment of the target
@@ -2450,728 +2439,6 @@ package body Exp_Ch5 is
       Adjust_Condition (Condition (N));
    end Expand_N_Exit_Statement;
 
-   ----------------------------------------
-   -- Expand_N_Extended_Return_Statement --
-   ----------------------------------------
-
-   --  If there is a Handled_Statement_Sequence, we rewrite this:
-
-   --     return Result : T := <expression> do
-   --        <handled_seq_of_stms>
-   --     end return;
-
-   --  to be:
-
-   --     declare
-   --        Result : T := <expression>;
-   --     begin
-   --        <handled_seq_of_stms>
-   --        return Result;
-   --     end;
-
-   --  Otherwise (no Handled_Statement_Sequence), we rewrite this:
-
-   --     return Result : T := <expression>;
-
-   --  to be:
-
-   --     return <expression>;
-
-   --  unless it's build-in-place or there's no <expression>, in which case
-   --  we generate:
-
-   --     declare
-   --        Result : T := <expression>;
-   --     begin
-   --        return Result;
-   --     end;
-
-   --  Note that this case could have been written by the user as an extended
-   --  return statement, or could have been transformed to this from a simple
-   --  return statement.
-
-   --  That is, we need to have a reified return object if there are statements
-   --  (which might refer to it) or if we're doing build-in-place (so we can
-   --  set its address to the final resting place or if there is no expression
-   --  (in which case default initial values might need to be set).
-
-   procedure Expand_N_Extended_Return_Statement (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
-
-      Return_Object_Entity : constant Entity_Id :=
-                               First_Entity (Return_Statement_Entity (N));
-      Return_Object_Decl   : constant Node_Id :=
-                               Parent (Return_Object_Entity);
-      Parent_Function      : constant Entity_Id :=
-                               Return_Applies_To (Return_Statement_Entity (N));
-      Parent_Function_Typ  : constant Entity_Id := Etype (Parent_Function);
-      Is_Build_In_Place    : constant Boolean :=
-                               Is_Build_In_Place_Function (Parent_Function);
-
-      Return_Stm      : Node_Id;
-      Statements      : List_Id;
-      Handled_Stm_Seq : Node_Id;
-      Result          : Node_Id;
-      Exp             : Node_Id;
-
-      function Has_Controlled_Parts (Typ : Entity_Id) return Boolean;
-      --  Determine whether type Typ is controlled or contains a controlled
-      --  subcomponent.
-
-      function Move_Activation_Chain return Node_Id;
-      --  Construct a call to System.Tasking.Stages.Move_Activation_Chain
-      --  with parameters:
-      --    From         current activation chain
-      --    To           activation chain passed in by the caller
-      --    New_Master   master passed in by the caller
-
-      function Move_Final_List return Node_Id;
-      --  Construct call to System.Finalization_Implementation.Move_Final_List
-      --  with parameters:
-      --
-      --    From         finalization list of the return statement
-      --    To           finalization list passed in by the caller
-
-      --------------------------
-      -- Has_Controlled_Parts --
-      --------------------------
-
-      function Has_Controlled_Parts (Typ : Entity_Id) return Boolean is
-      begin
-         return
-           Is_Controlled (Typ)
-             or else Has_Controlled_Component (Typ);
-      end Has_Controlled_Parts;
-
-      ---------------------------
-      -- Move_Activation_Chain --
-      ---------------------------
-
-      function Move_Activation_Chain return Node_Id is
-         Activation_Chain_Formal : constant Entity_Id :=
-                                     Build_In_Place_Formal
-                                       (Parent_Function, BIP_Activation_Chain);
-         To                      : constant Node_Id :=
-                                     New_Reference_To
-                                       (Activation_Chain_Formal, Loc);
-         Master_Formal           : constant Entity_Id :=
-                                     Build_In_Place_Formal
-                                       (Parent_Function, BIP_Master);
-         New_Master              : constant Node_Id :=
-                                     New_Reference_To (Master_Formal, Loc);
-
-         Chain_Entity : Entity_Id;
-         From         : Node_Id;
-
-      begin
-         Chain_Entity := First_Entity (Return_Statement_Entity (N));
-         while Chars (Chain_Entity) /= Name_uChain loop
-            Chain_Entity := Next_Entity (Chain_Entity);
-         end loop;
-
-         From :=
-           Make_Attribute_Reference (Loc,
-             Prefix         => New_Reference_To (Chain_Entity, Loc),
-             Attribute_Name => Name_Unrestricted_Access);
-         --  ??? Not clear why "Make_Identifier (Loc, Name_uChain)" doesn't
-         --  work, instead of "New_Reference_To (Chain_Entity, Loc)" above.
-
-         return
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Move_Activation_Chain), Loc),
-             Parameter_Associations => New_List (From, To, New_Master));
-      end Move_Activation_Chain;
-
-      ---------------------
-      -- Move_Final_List --
-      ---------------------
-
-      function Move_Final_List return Node_Id is
-         Flist : constant Entity_Id  :=
-                   Finalization_Chain_Entity (Return_Statement_Entity (N));
-
-         From : constant Node_Id := New_Reference_To (Flist, Loc);
-
-         Caller_Final_List : constant Entity_Id :=
-                               Build_In_Place_Formal
-                                 (Parent_Function, BIP_Final_List);
-
-         To : constant Node_Id := New_Reference_To (Caller_Final_List, Loc);
-
-      begin
-         --  Catch cases where a finalization chain entity has not been
-         --  associated with the return statement entity.
-
-         pragma Assert (Present (Flist));
-
-         --  Build required call
-
-         return
-           Make_If_Statement (Loc,
-             Condition =>
-               Make_Op_Ne (Loc,
-                 Left_Opnd  => New_Copy (From),
-                 Right_Opnd => New_Node (N_Null, Loc)),
-             Then_Statements =>
-               New_List (
-                 Make_Procedure_Call_Statement (Loc,
-                   Name => New_Reference_To (RTE (RE_Move_Final_List), Loc),
-                   Parameter_Associations => New_List (From, To))));
-      end Move_Final_List;
-
-   --  Start of processing for Expand_N_Extended_Return_Statement
-
-   begin
-      if Nkind (Return_Object_Decl) = N_Object_Declaration then
-         Exp := Expression (Return_Object_Decl);
-      else
-         Exp := Empty;
-      end if;
-
-      Handled_Stm_Seq := Handled_Statement_Sequence (N);
-
-      --  Build a simple_return_statement that returns the return object when
-      --  there is a statement sequence, or no expression, or the result will
-      --  be built in place. Note however that we currently do this for all
-      --  composite cases, even though nonlimited composite results are not yet
-      --  built in place (though we plan to do so eventually).
-
-      if Present (Handled_Stm_Seq)
-        or else Is_Composite_Type (Etype (Parent_Function))
-        or else No (Exp)
-      then
-         if No (Handled_Stm_Seq) then
-            Statements := New_List;
-
-         --  If the extended return has a handled statement sequence, then wrap
-         --  it in a block and use the block as the first statement.
-
-         else
-            Statements :=
-              New_List (Make_Block_Statement (Loc,
-                          Declarations => New_List,
-                          Handled_Statement_Sequence => Handled_Stm_Seq));
-         end if;
-
-         --  If control gets past the above Statements, we have successfully
-         --  completed the return statement. If the result type has controlled
-         --  parts and the return is for a build-in-place function, then we
-         --  call Move_Final_List to transfer responsibility for finalization
-         --  of the return object to the caller. An alternative would be to
-         --  declare a Success flag in the function, initialize it to False,
-         --  and set it to True here. Then move the Move_Final_List call into
-         --  the cleanup code, and check Success. If Success then make a call
-         --  to Move_Final_List else do finalization. Then we can remove the
-         --  abort-deferral and the nulling-out of the From parameter from
-         --  Move_Final_List. Note that the current method is not quite correct
-         --  in the rather obscure case of a select-then-abort statement whose
-         --  abortable part contains the return statement.
-
-         --  Check the type of the function to determine whether to move the
-         --  finalization list. A special case arises when processing a simple
-         --  return statement which has been rewritten as an extended return.
-         --  In that case check the type of the returned object or the original
-         --  expression.
-
-         if Is_Build_In_Place
-           and then
-               (Has_Controlled_Parts (Parent_Function_Typ)
-                 or else (Is_Class_Wide_Type (Parent_Function_Typ)
-                           and then
-                        Has_Controlled_Parts (Root_Type (Parent_Function_Typ)))
-                 or else Has_Controlled_Parts (Etype (Return_Object_Entity))
-                 or else (Present (Exp)
-                           and then Has_Controlled_Parts (Etype (Exp))))
-         then
-            Append_To (Statements, Move_Final_List);
-         end if;
-
-         --  Similarly to the above Move_Final_List, if the result type
-         --  contains tasks, we call Move_Activation_Chain. Later, the cleanup
-         --  code will call Complete_Master, which will terminate any
-         --  unactivated tasks belonging to the return statement master. But
-         --  Move_Activation_Chain updates their master to be that of the
-         --  caller, so they will not be terminated unless the return statement
-         --  completes unsuccessfully due to exception, abort, goto, or exit.
-         --  As a formality, we test whether the function requires the result
-         --  to be built in place, though that's necessarily true for the case
-         --  of result types with task parts.
-
-         if Is_Build_In_Place and Has_Task (Etype (Parent_Function)) then
-            Append_To (Statements, Move_Activation_Chain);
-         end if;
-
-         --  Build a simple_return_statement that returns the return object
-
-         Return_Stm :=
-           Make_Simple_Return_Statement (Loc,
-             Expression => New_Occurrence_Of (Return_Object_Entity, Loc));
-         Append_To (Statements, Return_Stm);
-
-         Handled_Stm_Seq :=
-           Make_Handled_Sequence_Of_Statements (Loc, Statements);
-      end if;
-
-      --  Case where we build a block
-
-      if Present (Handled_Stm_Seq) then
-         Result :=
-           Make_Block_Statement (Loc,
-             Declarations => Return_Object_Declarations (N),
-             Handled_Statement_Sequence => Handled_Stm_Seq);
-
-         --  We set the entity of the new block statement to be that of the
-         --  return statement. This is necessary so that various fields, such
-         --  as Finalization_Chain_Entity carry over from the return statement
-         --  to the block. Note that this block is unusual, in that its entity
-         --  is an E_Return_Statement rather than an E_Block.
-
-         Set_Identifier
-           (Result, New_Occurrence_Of (Return_Statement_Entity (N), Loc));
-
-         --  If the object decl was already rewritten as a renaming, then
-         --  we don't want to do the object allocation and transformation of
-         --  of the return object declaration to a renaming. This case occurs
-         --  when the return object is initialized by a call to another
-         --  build-in-place function, and that function is responsible for the
-         --  allocation of the return object.
-
-         if Is_Build_In_Place
-           and then
-             Nkind (Return_Object_Decl) = N_Object_Renaming_Declaration
-         then
-            pragma Assert (Nkind (Original_Node (Return_Object_Decl)) =
-                            N_Object_Declaration
-              and then Is_Build_In_Place_Function_Call
-                         (Expression (Original_Node (Return_Object_Decl))));
-
-            Set_By_Ref (Return_Stm);  -- Return build-in-place results by ref
-
-         elsif Is_Build_In_Place then
-
-            --  Locate the implicit access parameter associated with the
-            --  caller-supplied return object and convert the return
-            --  statement's return object declaration to a renaming of a
-            --  dereference of the access parameter. If the return object's
-            --  declaration includes an expression that has not already been
-            --  expanded as separate assignments, then add an assignment
-            --  statement to ensure the return object gets initialized.
-
-            --  declare
-            --     Result : T [:= <expression>];
-            --  begin
-            --     ...
-
-            --  is converted to
-
-            --  declare
-            --     Result : T renames FuncRA.all;
-            --     [Result := <expression;]
-            --  begin
-            --     ...
-
-            declare
-               Return_Obj_Id    : constant Entity_Id :=
-                                    Defining_Identifier (Return_Object_Decl);
-               Return_Obj_Typ   : constant Entity_Id := Etype (Return_Obj_Id);
-               Return_Obj_Expr  : constant Node_Id :=
-                                    Expression (Return_Object_Decl);
-               Result_Subt      : constant Entity_Id :=
-                                    Etype (Parent_Function);
-               Constr_Result    : constant Boolean :=
-                                    Is_Constrained (Result_Subt);
-               Obj_Alloc_Formal : Entity_Id;
-               Object_Access    : Entity_Id;
-               Obj_Acc_Deref    : Node_Id;
-               Init_Assignment  : Node_Id := Empty;
-
-            begin
-               --  Build-in-place results must be returned by reference
-
-               Set_By_Ref (Return_Stm);
-
-               --  Retrieve the implicit access parameter passed by the caller
-
-               Object_Access :=
-                 Build_In_Place_Formal (Parent_Function, BIP_Object_Access);
-
-               --  If the return object's declaration includes an expression
-               --  and the declaration isn't marked as No_Initialization, then
-               --  we need to generate an assignment to the object and insert
-               --  it after the declaration before rewriting it as a renaming
-               --  (otherwise we'll lose the initialization). The case where
-               --  the result type is an interface (or class-wide interface)
-               --  is also excluded because the context of the function call
-               --  must be unconstrained, so the initialization will always
-               --  be done as part of an allocator evaluation (storage pool
-               --  or secondary stack), never to a constrained target object
-               --  passed in by the caller. Besides the assignment being
-               --  unneeded in this case, it avoids problems with trying to
-               --  generate a dispatching assignment when the return expression
-               --  is a nonlimited descendant of a limited interface (the
-               --  interface has no assignment operation).
-
-               if Present (Return_Obj_Expr)
-                 and then not No_Initialization (Return_Object_Decl)
-                 and then not Is_Interface (Return_Obj_Typ)
-               then
-                  Init_Assignment :=
-                    Make_Assignment_Statement (Loc,
-                      Name       => New_Reference_To (Return_Obj_Id, Loc),
-                      Expression => Relocate_Node (Return_Obj_Expr));
-                  Set_Etype (Name (Init_Assignment), Etype (Return_Obj_Id));
-                  Set_Assignment_OK (Name (Init_Assignment));
-                  Set_No_Ctrl_Actions (Init_Assignment);
-
-                  Set_Parent (Name (Init_Assignment), Init_Assignment);
-                  Set_Parent (Expression (Init_Assignment), Init_Assignment);
-
-                  Set_Expression (Return_Object_Decl, Empty);
-
-                  if Is_Class_Wide_Type (Etype (Return_Obj_Id))
-                    and then not Is_Class_Wide_Type
-                                   (Etype (Expression (Init_Assignment)))
-                  then
-                     Rewrite (Expression (Init_Assignment),
-                       Make_Type_Conversion (Loc,
-                         Subtype_Mark =>
-                           New_Occurrence_Of
-                             (Etype (Return_Obj_Id), Loc),
-                         Expression =>
-                           Relocate_Node (Expression (Init_Assignment))));
-                  end if;
-
-                  --  In the case of functions where the calling context can
-                  --  determine the form of allocation needed, initialization
-                  --  is done with each part of the if statement that handles
-                  --  the different forms of allocation (this is true for
-                  --  unconstrained and tagged result subtypes).
-
-                  if Constr_Result
-                    and then not Is_Tagged_Type (Underlying_Type (Result_Subt))
-                  then
-                     Insert_After (Return_Object_Decl, Init_Assignment);
-                  end if;
-               end if;
-
-               --  When the function's subtype is unconstrained, a run-time
-               --  test is needed to determine the form of allocation to use
-               --  for the return object. The function has an implicit formal
-               --  parameter indicating this. If the BIP_Alloc_Form formal has
-               --  the value one, then the caller has passed access to an
-               --  existing object for use as the return object. If the value
-               --  is two, then the return object must be allocated on the
-               --  secondary stack. Otherwise, the object must be allocated in
-               --  a storage pool (currently only supported for the global
-               --  heap, user-defined storage pools TBD ???). We generate an
-               --  if statement to test the implicit allocation formal and
-               --  initialize a local access value appropriately, creating
-               --  allocators in the secondary stack and global heap cases.
-               --  The special formal also exists and must be tested when the
-               --  function has a tagged result, even when the result subtype
-               --  is constrained, because in general such functions can be
-               --  called in dispatching contexts and must be handled similarly
-               --  to functions with a class-wide result.
-
-               if not Constr_Result
-                 or else Is_Tagged_Type (Underlying_Type (Result_Subt))
-               then
-                  Obj_Alloc_Formal :=
-                    Build_In_Place_Formal (Parent_Function, BIP_Alloc_Form);
-
-                  declare
-                     Ref_Type       : Entity_Id;
-                     Ptr_Type_Decl  : Node_Id;
-                     Alloc_Obj_Id   : Entity_Id;
-                     Alloc_Obj_Decl : Node_Id;
-                     Alloc_If_Stmt  : Node_Id;
-                     SS_Allocator   : Node_Id;
-                     Heap_Allocator : Node_Id;
-
-                  begin
-                     --  Reuse the itype created for the function's implicit
-                     --  access formal. This avoids the need to create a new
-                     --  access type here, plus it allows assigning the access
-                     --  formal directly without applying a conversion.
-
-                     --  Ref_Type := Etype (Object_Access);
-
-                     --  Create an access type designating the function's
-                     --  result subtype.
-
-                     Ref_Type := Make_Temporary (Loc, 'A');
-
-                     Ptr_Type_Decl :=
-                       Make_Full_Type_Declaration (Loc,
-                         Defining_Identifier => Ref_Type,
-                         Type_Definition =>
-                           Make_Access_To_Object_Definition (Loc,
-                             All_Present => True,
-                             Subtype_Indication =>
-                               New_Reference_To (Return_Obj_Typ, Loc)));
-
-                     Insert_Before (Return_Object_Decl, Ptr_Type_Decl);
-
-                     --  Create an access object that will be initialized to an
-                     --  access value denoting the return object, either coming
-                     --  from an implicit access value passed in by the caller
-                     --  or from the result of an allocator.
-
-                     Alloc_Obj_Id := Make_Temporary (Loc, 'R');
-                     Set_Etype (Alloc_Obj_Id, Ref_Type);
-
-                     Alloc_Obj_Decl :=
-                       Make_Object_Declaration (Loc,
-                         Defining_Identifier => Alloc_Obj_Id,
-                         Object_Definition   => New_Reference_To
-                                                  (Ref_Type, Loc));
-
-                     Insert_Before (Return_Object_Decl, Alloc_Obj_Decl);
-
-                     --  Create allocators for both the secondary stack and
-                     --  global heap. If there's an initialization expression,
-                     --  then create these as initialized allocators.
-
-                     if Present (Return_Obj_Expr)
-                       and then not No_Initialization (Return_Object_Decl)
-                     then
-                        --  Always use the type of the expression for the
-                        --  qualified expression, rather than the result type.
-                        --  In general we cannot always use the result type
-                        --  for the allocator, because the expression might be
-                        --  of a specific type, such as in the case of an
-                        --  aggregate or even a nonlimited object when the
-                        --  result type is a limited class-wide interface type.
-
-                        Heap_Allocator :=
-                          Make_Allocator (Loc,
-                            Expression =>
-                              Make_Qualified_Expression (Loc,
-                                Subtype_Mark =>
-                                  New_Reference_To
-                                    (Etype (Return_Obj_Expr), Loc),
-                                Expression =>
-                                  New_Copy_Tree (Return_Obj_Expr)));
-
-                     else
-                        --  If the function returns a class-wide type we cannot
-                        --  use the return type for the allocator. Instead we
-                        --  use the type of the expression, which must be an
-                        --  aggregate of a definite type.
-
-                        if Is_Class_Wide_Type (Return_Obj_Typ) then
-                           Heap_Allocator :=
-                             Make_Allocator (Loc,
-                               Expression =>
-                                 New_Reference_To
-                                   (Etype (Return_Obj_Expr), Loc));
-                        else
-                           Heap_Allocator :=
-                             Make_Allocator (Loc,
-                               Expression =>
-                                 New_Reference_To (Return_Obj_Typ, Loc));
-                        end if;
-
-                        --  If the object requires default initialization then
-                        --  that will happen later following the elaboration of
-                        --  the object renaming. If we don't turn it off here
-                        --  then the object will be default initialized twice.
-
-                        Set_No_Initialization (Heap_Allocator);
-                     end if;
-
-                     --  If the No_Allocators restriction is active, then only
-                     --  an allocator for secondary stack allocation is needed.
-                     --  It's OK for such allocators to have Comes_From_Source
-                     --  set to False, because gigi knows not to flag them as
-                     --  being a violation of No_Implicit_Heap_Allocations.
-
-                     if Restriction_Active (No_Allocators) then
-                        SS_Allocator   := Heap_Allocator;
-                        Heap_Allocator := Make_Null (Loc);
-
-                     --  Otherwise the heap allocator may be needed, so we make
-                     --  another allocator for secondary stack allocation.
-
-                     else
-                        SS_Allocator := New_Copy_Tree (Heap_Allocator);
-
-                        --  The heap allocator is marked Comes_From_Source
-                        --  since it corresponds to an explicit user-written
-                        --  allocator (that is, it will only be executed on
-                        --  behalf of callers that call the function as
-                        --  initialization for such an allocator). This
-                        --  prevents errors when No_Implicit_Heap_Allocations
-                        --  is in force.
-
-                        Set_Comes_From_Source (Heap_Allocator, True);
-                     end if;
-
-                     --  The allocator is returned on the secondary stack. We
-                     --  don't do this on VM targets, since the SS is not used.
-
-                     if VM_Target = No_VM then
-                        Set_Storage_Pool (SS_Allocator, RTE (RE_SS_Pool));
-                        Set_Procedure_To_Call
-                          (SS_Allocator, RTE (RE_SS_Allocate));
-
-                        --  The allocator is returned on the secondary stack,
-                        --  so indicate that the function return, as well as
-                        --  the block that encloses the allocator, must not
-                        --  release it. The flags must be set now because the
-                        --  decision to use the secondary stack is done very
-                        --  late in the course of expanding the return
-                        --  statement, past the point where these flags are
-                        --  normally set.
-
-                        Set_Sec_Stack_Needed_For_Return (Parent_Function);
-                        Set_Sec_Stack_Needed_For_Return
-                          (Return_Statement_Entity (N));
-                        Set_Uses_Sec_Stack (Parent_Function);
-                        Set_Uses_Sec_Stack (Return_Statement_Entity (N));
-                     end if;
-
-                     --  Create an if statement to test the BIP_Alloc_Form
-                     --  formal and initialize the access object to either the
-                     --  BIP_Object_Access formal (BIP_Alloc_Form = 0), the
-                     --  result of allocating the object in the secondary stack
-                     --  (BIP_Alloc_Form = 1), or else an allocator to create
-                     --  the return object in the heap (BIP_Alloc_Form = 2).
-
-                     --  ??? An unchecked type conversion must be made in the
-                     --  case of assigning the access object formal to the
-                     --  local access object, because a normal conversion would
-                     --  be illegal in some cases (such as converting access-
-                     --  to-unconstrained to access-to-constrained), but the
-                     --  the unchecked conversion will presumably fail to work
-                     --  right in just such cases. It's not clear at all how to
-                     --  handle this. ???
-
-                     Alloc_If_Stmt :=
-                       Make_If_Statement (Loc,
-                         Condition       =>
-                           Make_Op_Eq (Loc,
-                             Left_Opnd =>
-                               New_Reference_To (Obj_Alloc_Formal, Loc),
-                             Right_Opnd =>
-                               Make_Integer_Literal (Loc,
-                                 UI_From_Int (BIP_Allocation_Form'Pos
-                                                (Caller_Allocation)))),
-                         Then_Statements =>
-                           New_List (Make_Assignment_Statement (Loc,
-                                       Name       =>
-                                         New_Reference_To
-                                           (Alloc_Obj_Id, Loc),
-                                       Expression =>
-                                         Make_Unchecked_Type_Conversion (Loc,
-                                           Subtype_Mark =>
-                                             New_Reference_To (Ref_Type, Loc),
-                                           Expression =>
-                                             New_Reference_To
-                                               (Object_Access, Loc)))),
-                         Elsif_Parts     =>
-                           New_List (Make_Elsif_Part (Loc,
-                                       Condition       =>
-                                         Make_Op_Eq (Loc,
-                                           Left_Opnd =>
-                                             New_Reference_To
-                                               (Obj_Alloc_Formal, Loc),
-                                           Right_Opnd =>
-                                             Make_Integer_Literal (Loc,
-                                               UI_From_Int (
-                                                 BIP_Allocation_Form'Pos
-                                                    (Secondary_Stack)))),
-                                       Then_Statements =>
-                                          New_List
-                                            (Make_Assignment_Statement (Loc,
-                                               Name       =>
-                                                 New_Reference_To
-                                                   (Alloc_Obj_Id, Loc),
-                                               Expression =>
-                                                 SS_Allocator)))),
-                         Else_Statements =>
-                           New_List (Make_Assignment_Statement (Loc,
-                                        Name       =>
-                                          New_Reference_To
-                                            (Alloc_Obj_Id, Loc),
-                                        Expression =>
-                                          Heap_Allocator)));
-
-                     --  If a separate initialization assignment was created
-                     --  earlier, append that following the assignment of the
-                     --  implicit access formal to the access object, to ensure
-                     --  that the return object is initialized in that case.
-                     --  In this situation, the target of the assignment must
-                     --  be rewritten to denote a dereference of the access to
-                     --  the return object passed in by the caller.
-
-                     if Present (Init_Assignment) then
-                        Rewrite (Name (Init_Assignment),
-                          Make_Explicit_Dereference (Loc,
-                            Prefix => New_Reference_To (Alloc_Obj_Id, Loc)));
-                        Set_Etype
-                          (Name (Init_Assignment), Etype (Return_Obj_Id));
-
-                        Append_To
-                          (Then_Statements (Alloc_If_Stmt),
-                           Init_Assignment);
-                     end if;
-
-                     Insert_Before (Return_Object_Decl, Alloc_If_Stmt);
-
-                     --  Remember the local access object for use in the
-                     --  dereference of the renaming created below.
-
-                     Object_Access := Alloc_Obj_Id;
-                  end;
-               end if;
-
-               --  Replace the return object declaration with a renaming of a
-               --  dereference of the access value designating the return
-               --  object.
-
-               Obj_Acc_Deref :=
-                 Make_Explicit_Dereference (Loc,
-                   Prefix => New_Reference_To (Object_Access, Loc));
-
-               Rewrite (Return_Object_Decl,
-                 Make_Object_Renaming_Declaration (Loc,
-                   Defining_Identifier => Return_Obj_Id,
-                   Access_Definition   => Empty,
-                   Subtype_Mark        => New_Occurrence_Of
-                                            (Return_Obj_Typ, Loc),
-                   Name                => Obj_Acc_Deref));
-
-               Set_Renamed_Object (Return_Obj_Id, Obj_Acc_Deref);
-            end;
-         end if;
-
-      --  Case where we do not build a block
-
-      else
-         --  We're about to drop Return_Object_Declarations on the floor, so
-         --  we need to insert it, in case it got expanded into useful code.
-         --  Remove side effects from expression, which may be duplicated in
-         --  subsequent checks (see Expand_Simple_Function_Return).
-
-         Insert_List_Before (N, Return_Object_Declarations (N));
-         Remove_Side_Effects (Exp);
-
-         --  Build simple_return_statement that returns the expression directly
-
-         Return_Stm := Make_Simple_Return_Statement (Loc, Expression => Exp);
-
-         Result := Return_Stm;
-      end if;
-
-      --  Set the flag to prevent infinite recursion
-
-      Set_Comes_From_Extended_Return_Statement (Return_Stm);
-
-      Rewrite (N, Result);
-      Analyze (N);
-   end Expand_N_Extended_Return_Statement;
-
    -----------------------------
    -- Expand_N_Goto_Statement --
    -----------------------------
@@ -3671,761 +2938,6 @@ package body Exp_Ch5 is
       end if;
    end Expand_N_Loop_Statement;
 
-   --------------------------------------
-   -- Expand_N_Simple_Return_Statement --
-   --------------------------------------
-
-   procedure Expand_N_Simple_Return_Statement (N : Node_Id) is
-   begin
-      --  Defend against previous errors (i.e. the return statement calls a
-      --  function that is not available in configurable runtime).
-
-      if Present (Expression (N))
-        and then Nkind (Expression (N)) = N_Empty
-      then
-         return;
-      end if;
-
-      --  Distinguish the function and non-function cases:
-
-      case Ekind (Return_Applies_To (Return_Statement_Entity (N))) is
-
-         when E_Function          |
-              E_Generic_Function  =>
-            Expand_Simple_Function_Return (N);
-
-         when E_Procedure         |
-              E_Generic_Procedure |
-              E_Entry             |
-              E_Entry_Family      |
-              E_Return_Statement =>
-            Expand_Non_Function_Return (N);
-
-         when others =>
-            raise Program_Error;
-      end case;
-
-   exception
-      when RE_Not_Available =>
-         return;
-   end Expand_N_Simple_Return_Statement;
-
-   --------------------------------
-   -- Expand_Non_Function_Return --
-   --------------------------------
-
-   procedure Expand_Non_Function_Return (N : Node_Id) is
-      pragma Assert (No (Expression (N)));
-
-      Loc         : constant Source_Ptr := Sloc (N);
-      Scope_Id    : Entity_Id :=
-                      Return_Applies_To (Return_Statement_Entity (N));
-      Kind        : constant Entity_Kind := Ekind (Scope_Id);
-      Call        : Node_Id;
-      Acc_Stat    : Node_Id;
-      Goto_Stat   : Node_Id;
-      Lab_Node    : Node_Id;
-
-   begin
-      --  Call _Postconditions procedure if procedure with active
-      --  postconditions. Here, we use the Postcondition_Proc attribute, which
-      --  is needed for implicitly-generated returns. Functions never
-      --  have implicitly-generated returns, and there's no room for
-      --  Postcondition_Proc in E_Function, so we look up the identifier
-      --  Name_uPostconditions for function returns (see
-      --  Expand_Simple_Function_Return).
-
-      if Ekind (Scope_Id) = E_Procedure
-        and then Has_Postconditions (Scope_Id)
-      then
-         pragma Assert (Present (Postcondition_Proc (Scope_Id)));
-         Insert_Action (N,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (Postcondition_Proc (Scope_Id), Loc)));
-      end if;
-
-      --  If it is a return from a procedure do no extra steps
-
-      if Kind = E_Procedure or else Kind = E_Generic_Procedure then
-         return;
-
-      --  If it is a nested return within an extended one, replace it with a
-      --  return of the previously declared return object.
-
-      elsif Kind = E_Return_Statement then
-         Rewrite (N,
-           Make_Simple_Return_Statement (Loc,
-             Expression =>
-               New_Occurrence_Of (First_Entity (Scope_Id), Loc)));
-         Set_Comes_From_Extended_Return_Statement (N);
-         Set_Return_Statement_Entity (N, Scope_Id);
-         Expand_Simple_Function_Return (N);
-         return;
-      end if;
-
-      pragma Assert (Is_Entry (Scope_Id));
-
-      --  Look at the enclosing block to see whether the return is from an
-      --  accept statement or an entry body.
-
-      for J in reverse 0 .. Scope_Stack.Last loop
-         Scope_Id := Scope_Stack.Table (J).Entity;
-         exit when Is_Concurrent_Type (Scope_Id);
-      end loop;
-
-      --  If it is a return from accept statement it is expanded as call to
-      --  RTS Complete_Rendezvous and a goto to the end of the accept body.
-
-      --  (cf : Expand_N_Accept_Statement, Expand_N_Selective_Accept,
-      --  Expand_N_Accept_Alternative in exp_ch9.adb)
-
-      if Is_Task_Type (Scope_Id) then
-
-         Call :=
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Complete_Rendezvous), Loc));
-         Insert_Before (N, Call);
-         --  why not insert actions here???
-         Analyze (Call);
-
-         Acc_Stat := Parent (N);
-         while Nkind (Acc_Stat) /= N_Accept_Statement loop
-            Acc_Stat := Parent (Acc_Stat);
-         end loop;
-
-         Lab_Node := Last (Statements
-           (Handled_Statement_Sequence (Acc_Stat)));
-
-         Goto_Stat := Make_Goto_Statement (Loc,
-           Name => New_Occurrence_Of
-             (Entity (Identifier (Lab_Node)), Loc));
-
-         Set_Analyzed (Goto_Stat);
-
-         Rewrite (N, Goto_Stat);
-         Analyze (N);
-
-      --  If it is a return from an entry body, put a Complete_Entry_Body call
-      --  in front of the return.
-
-      elsif Is_Protected_Type (Scope_Id) then
-         Call :=
-           Make_Procedure_Call_Statement (Loc,
-             Name =>
-               New_Reference_To (RTE (RE_Complete_Entry_Body), Loc),
-             Parameter_Associations => New_List (
-               Make_Attribute_Reference (Loc,
-                 Prefix =>
-                   New_Reference_To
-                     (Find_Protection_Object (Current_Scope), Loc),
-                 Attribute_Name =>
-                   Name_Unchecked_Access)));
-
-         Insert_Before (N, Call);
-         Analyze (Call);
-      end if;
-   end Expand_Non_Function_Return;
-
-   -----------------------------------
-   -- Expand_Simple_Function_Return --
-   -----------------------------------
-
-   --  The "simple" comes from the syntax rule simple_return_statement.
-   --  The semantics are not at all simple!
-
-   procedure Expand_Simple_Function_Return (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
-
-      Scope_Id : constant Entity_Id :=
-                   Return_Applies_To (Return_Statement_Entity (N));
-      --  The function we are returning from
-
-      R_Type : constant Entity_Id := Etype (Scope_Id);
-      --  The result type of the function
-
-      Utyp : constant Entity_Id := Underlying_Type (R_Type);
-
-      Exp : constant Node_Id := Expression (N);
-      pragma Assert (Present (Exp));
-
-      Exptyp : constant Entity_Id := Etype (Exp);
-      --  The type of the expression (not necessarily the same as R_Type)
-
-      Subtype_Ind : Node_Id;
-      --  If the result type of the function is class-wide and the
-      --  expression has a specific type, then we use the expression's
-      --  type as the type of the return object. In cases where the
-      --  expression is an aggregate that is built in place, this avoids
-      --  the need for an expensive conversion of the return object to
-      --  the specific type on assignments to the individual components.
-
-   begin
-      if Is_Class_Wide_Type (R_Type)
-        and then not Is_Class_Wide_Type (Etype (Exp))
-      then
-         Subtype_Ind := New_Occurrence_Of (Etype (Exp), Loc);
-      else
-         Subtype_Ind := New_Occurrence_Of (R_Type, Loc);
-      end if;
-
-      --  For the case of a simple return that does not come from an extended
-      --  return, in the case of Ada 2005 where we are returning a limited
-      --  type, we rewrite "return <expression>;" to be:
-
-      --    return _anon_ : <return_subtype> := <expression>
-
-      --  The expansion produced by Expand_N_Extended_Return_Statement will
-      --  contain simple return statements (for example, a block containing
-      --  simple return of the return object), which brings us back here with
-      --  Comes_From_Extended_Return_Statement set. The reason for the barrier
-      --  checking for a simple return that does not come from an extended
-      --  return is to avoid this infinite recursion.
-
-      --  The reason for this design is that for Ada 2005 limited returns, we
-      --  need to reify the return object, so we can build it "in place", and
-      --  we need a block statement to hang finalization and tasking stuff.
-
-      --  ??? In order to avoid disruption, we avoid translating to extended
-      --  return except in the cases where we really need to (Ada 2005 for
-      --  inherently limited). We might prefer to do this translation in all
-      --  cases (except perhaps for the case of Ada 95 inherently limited),
-      --  in order to fully exercise the Expand_N_Extended_Return_Statement
-      --  code. This would also allow us to do the build-in-place optimization
-      --  for efficiency even in cases where it is semantically not required.
-
-      --  As before, we check the type of the return expression rather than the
-      --  return type of the function, because the latter may be a limited
-      --  class-wide interface type, which is not a limited type, even though
-      --  the type of the expression may be.
-
-      if not Comes_From_Extended_Return_Statement (N)
-        and then Is_Immutably_Limited_Type (Etype (Expression (N)))
-        and then Ada_Version >= Ada_05
-        and then not Debug_Flag_Dot_L
-      then
-         declare
-            Return_Object_Entity : constant Entity_Id :=
-                                     Make_Temporary (Loc, 'R', Exp);
-            Obj_Decl : constant Node_Id :=
-                         Make_Object_Declaration (Loc,
-                           Defining_Identifier => Return_Object_Entity,
-                           Object_Definition   => Subtype_Ind,
-                           Expression          => Exp);
-
-            Ext : constant Node_Id := Make_Extended_Return_Statement (Loc,
-                    Return_Object_Declarations => New_List (Obj_Decl));
-            --  Do not perform this high-level optimization if the result type
-            --  is an interface because the "this" pointer must be displaced.
-
-         begin
-            Rewrite (N, Ext);
-            Analyze (N);
-            return;
-         end;
-      end if;
-
-      --  Here we have a simple return statement that is part of the expansion
-      --  of an extended return statement (either written by the user, or
-      --  generated by the above code).
-
-      --  Always normalize C/Fortran boolean result. This is not always needed,
-      --  but it seems a good idea to minimize the passing around of non-
-      --  normalized values, and in any case this handles the processing of
-      --  barrier functions for protected types, which turn the condition into
-      --  a return statement.
-
-      if Is_Boolean_Type (Exptyp)
-        and then Nonzero_Is_True (Exptyp)
-      then
-         Adjust_Condition (Exp);
-         Adjust_Result_Type (Exp, Exptyp);
-      end if;
-
-      --  Do validity check if enabled for returns
-
-      if Validity_Checks_On
-        and then Validity_Check_Returns
-      then
-         Ensure_Valid (Exp);
-      end if;
-
-      --  Check the result expression of a scalar function against the subtype
-      --  of the function by inserting a conversion. This conversion must
-      --  eventually be performed for other classes of types, but for now it's
-      --  only done for scalars.
-      --  ???
-
-      if Is_Scalar_Type (Exptyp) then
-         Rewrite (Exp, Convert_To (R_Type, Exp));
-
-         --  The expression is resolved to ensure that the conversion gets
-         --  expanded to generate a possible constraint check.
-
-         Analyze_And_Resolve (Exp, R_Type);
-      end if;
-
-      --  Deal with returning variable length objects and controlled types
-
-      --  Nothing to do if we are returning by reference, or this is not a
-      --  type that requires special processing (indicated by the fact that
-      --  it requires a cleanup scope for the secondary stack case).
-
-      if Is_Immutably_Limited_Type (Exptyp)
-        or else Is_Limited_Interface (Exptyp)
-      then
-         null;
-
-      elsif not Requires_Transient_Scope (R_Type) then
-
-         --  Mutable records with no variable length components are not
-         --  returned on the sec-stack, so we need to make sure that the
-         --  backend will only copy back the size of the actual value, and not
-         --  the maximum size. We create an actual subtype for this purpose.
-
-         declare
-            Ubt  : constant Entity_Id := Underlying_Type (Base_Type (Exptyp));
-            Decl : Node_Id;
-            Ent  : Entity_Id;
-         begin
-            if Has_Discriminants (Ubt)
-              and then not Is_Constrained (Ubt)
-              and then not Has_Unchecked_Union (Ubt)
-            then
-               Decl := Build_Actual_Subtype (Ubt, Exp);
-               Ent := Defining_Identifier (Decl);
-               Insert_Action (Exp, Decl);
-               Rewrite (Exp, Unchecked_Convert_To (Ent, Exp));
-               Analyze_And_Resolve (Exp);
-            end if;
-         end;
-
-      --  Here if secondary stack is used
-
-      else
-         --  Make sure that no surrounding block will reclaim the secondary
-         --  stack on which we are going to put the result. Not only may this
-         --  introduce secondary stack leaks but worse, if the reclamation is
-         --  done too early, then the result we are returning may get
-         --  clobbered.
-
-         declare
-            S : Entity_Id;
-         begin
-            S := Current_Scope;
-            while Ekind (S) = E_Block or else Ekind (S) = E_Loop loop
-               Set_Sec_Stack_Needed_For_Return (S, True);
-               S := Enclosing_Dynamic_Scope (S);
-            end loop;
-         end;
-
-         --  Optimize the case where the result is a function call. In this
-         --  case either the result is already on the secondary stack, or is
-         --  already being returned with the stack pointer depressed and no
-         --  further processing is required except to set the By_Ref flag to
-         --  ensure that gigi does not attempt an extra unnecessary copy.
-         --  (actually not just unnecessary but harmfully wrong in the case
-         --  of a controlled type, where gigi does not know how to do a copy).
-         --  To make up for a gcc 2.8.1 deficiency (???), we perform
-         --  the copy for array types if the constrained status of the
-         --  target type is different from that of the expression.
-
-         if Requires_Transient_Scope (Exptyp)
-           and then
-              (not Is_Array_Type (Exptyp)
-                or else Is_Constrained (Exptyp) = Is_Constrained (R_Type)
-                or else CW_Or_Has_Controlled_Part (Utyp))
-           and then Nkind (Exp) = N_Function_Call
-         then
-            Set_By_Ref (N);
-
-            --  Remove side effects from the expression now so that other parts
-            --  of the expander do not have to reanalyze this node without this
-            --  optimization
-
-            Rewrite (Exp, Duplicate_Subexpr_No_Checks (Exp));
-
-         --  For controlled types, do the allocation on the secondary stack
-         --  manually in order to call adjust at the right time:
-
-         --    type Anon1 is access R_Type;
-         --    for Anon1'Storage_pool use ss_pool;
-         --    Anon2 : anon1 := new R_Type'(expr);
-         --    return Anon2.all;
-
-         --  We do the same for classwide types that are not potentially
-         --  controlled (by the virtue of restriction No_Finalization) because
-         --  gigi is not able to properly allocate class-wide types.
-
-         elsif CW_Or_Has_Controlled_Part (Utyp) then
-            declare
-               Loc        : constant Source_Ptr := Sloc (N);
-               Acc_Typ    : constant Entity_Id := Make_Temporary (Loc, 'A');
-               Alloc_Node : Node_Id;
-               Temp       : Entity_Id;
-
-            begin
-               Set_Ekind (Acc_Typ, E_Access_Type);
-
-               Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_SS_Pool));
-
-               --  This is an allocator for the secondary stack, and it's fine
-               --  to have Comes_From_Source set False on it, as gigi knows not
-               --  to flag it as a violation of No_Implicit_Heap_Allocations.
-
-               Alloc_Node :=
-                 Make_Allocator (Loc,
-                   Expression =>
-                     Make_Qualified_Expression (Loc,
-                       Subtype_Mark => New_Reference_To (Etype (Exp), Loc),
-                       Expression   => Relocate_Node (Exp)));
-
-               --  We do not want discriminant checks on the declaration,
-               --  given that it gets its value from the allocator.
-
-               Set_No_Initialization (Alloc_Node);
-
-               Temp := Make_Temporary (Loc, 'R', Alloc_Node);
-
-               Insert_List_Before_And_Analyze (N, New_List (
-                 Make_Full_Type_Declaration (Loc,
-                   Defining_Identifier => Acc_Typ,
-                   Type_Definition     =>
-                     Make_Access_To_Object_Definition (Loc,
-                       Subtype_Indication => Subtype_Ind)),
-
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Temp,
-                   Object_Definition   => New_Reference_To (Acc_Typ, Loc),
-                   Expression          => Alloc_Node)));
-
-               Rewrite (Exp,
-                 Make_Explicit_Dereference (Loc,
-                 Prefix => New_Reference_To (Temp, Loc)));
-
-               Analyze_And_Resolve (Exp, R_Type);
-            end;
-
-         --  Otherwise use the gigi mechanism to allocate result on the
-         --  secondary stack.
-
-         else
-            Check_Restriction (No_Secondary_Stack, N);
-            Set_Storage_Pool (N, RTE (RE_SS_Pool));
-
-            --  If we are generating code for the VM do not use
-            --  SS_Allocate since everything is heap-allocated anyway.
-
-            if VM_Target = No_VM then
-               Set_Procedure_To_Call (N, RTE (RE_SS_Allocate));
-            end if;
-         end if;
-      end if;
-
-      --  Implement the rules of 6.5(8-10), which require a tag check in the
-      --  case of a limited tagged return type, and tag reassignment for
-      --  nonlimited tagged results. These actions are needed when the return
-      --  type is a specific tagged type and the result expression is a
-      --  conversion or a formal parameter, because in that case the tag of the
-      --  expression might differ from the tag of the specific result type.
-
-      if Is_Tagged_Type (Utyp)
-        and then not Is_Class_Wide_Type (Utyp)
-        and then (Nkind_In (Exp, N_Type_Conversion,
-                                 N_Unchecked_Type_Conversion)
-                    or else (Is_Entity_Name (Exp)
-                               and then Ekind (Entity (Exp)) in Formal_Kind))
-      then
-         --  When the return type is limited, perform a check that the
-         --  tag of the result is the same as the tag of the return type.
-
-         if Is_Limited_Type (R_Type) then
-            Insert_Action (Exp,
-              Make_Raise_Constraint_Error (Loc,
-                Condition =>
-                  Make_Op_Ne (Loc,
-                    Left_Opnd =>
-                      Make_Selected_Component (Loc,
-                        Prefix => Duplicate_Subexpr (Exp),
-                        Selector_Name =>
-                          Make_Identifier (Loc, Chars => Name_uTag)),
-                    Right_Opnd =>
-                      Make_Attribute_Reference (Loc,
-                        Prefix => New_Occurrence_Of (Base_Type (Utyp), Loc),
-                        Attribute_Name => Name_Tag)),
-                Reason => CE_Tag_Check_Failed));
-
-         --  If the result type is a specific nonlimited tagged type, then we
-         --  have to ensure that the tag of the result is that of the result
-         --  type. This is handled by making a copy of the expression in the
-         --  case where it might have a different tag, namely when the
-         --  expression is a conversion or a formal parameter. We create a new
-         --  object of the result type and initialize it from the expression,
-         --  which will implicitly force the tag to be set appropriately.
-
-         else
-            declare
-               ExpR       : constant Node_Id   := Relocate_Node (Exp);
-               Result_Id  : constant Entity_Id :=
-                              Make_Temporary (Loc, 'R', ExpR);
-               Result_Exp : constant Node_Id   :=
-                              New_Reference_To (Result_Id, Loc);
-               Result_Obj : constant Node_Id   :=
-                              Make_Object_Declaration (Loc,
-                                Defining_Identifier => Result_Id,
-                                Object_Definition   =>
-                                  New_Reference_To (R_Type, Loc),
-                                Constant_Present    => True,
-                                Expression          => ExpR);
-
-            begin
-               Set_Assignment_OK (Result_Obj);
-               Insert_Action (Exp, Result_Obj);
-
-               Rewrite (Exp, Result_Exp);
-               Analyze_And_Resolve (Exp, R_Type);
-            end;
-         end if;
-
-      --  Ada 2005 (AI-344): If the result type is class-wide, then insert
-      --  a check that the level of the return expression's underlying type
-      --  is not deeper than the level of the master enclosing the function.
-      --  Always generate the check when the type of the return expression
-      --  is class-wide, when it's a type conversion, or when it's a formal
-      --  parameter. Otherwise, suppress the check in the case where the
-      --  return expression has a specific type whose level is known not to
-      --  be statically deeper than the function's result type.
-
-      --  Note: accessibility check is skipped in the VM case, since there
-      --  does not seem to be any practical way to implement this check.
-
-      elsif Ada_Version >= Ada_05
-        and then Tagged_Type_Expansion
-        and then Is_Class_Wide_Type (R_Type)
-        and then not Scope_Suppress (Accessibility_Check)
-        and then
-          (Is_Class_Wide_Type (Etype (Exp))
-            or else Nkind_In (Exp, N_Type_Conversion,
-                                   N_Unchecked_Type_Conversion)
-            or else (Is_Entity_Name (Exp)
-                       and then Ekind (Entity (Exp)) in Formal_Kind)
-            or else Scope_Depth (Enclosing_Dynamic_Scope (Etype (Exp))) >
-                      Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))
-      then
-         declare
-            Tag_Node : Node_Id;
-
-         begin
-            --  Ada 2005 (AI-251): In class-wide interface objects we displace
-            --  "this" to reference the base of the object --- required to get
-            --  access to the TSD of the object.
-
-            if Is_Class_Wide_Type (Etype (Exp))
-              and then Is_Interface (Etype (Exp))
-              and then Nkind (Exp) = N_Explicit_Dereference
-            then
-               Tag_Node :=
-                 Make_Explicit_Dereference (Loc,
-                   Unchecked_Convert_To (RTE (RE_Tag_Ptr),
-                     Make_Function_Call (Loc,
-                       Name => New_Reference_To (RTE (RE_Base_Address), Loc),
-                       Parameter_Associations => New_List (
-                         Unchecked_Convert_To (RTE (RE_Address),
-                           Duplicate_Subexpr (Prefix (Exp)))))));
-            else
-               Tag_Node :=
-                 Make_Attribute_Reference (Loc,
-                   Prefix => Duplicate_Subexpr (Exp),
-                   Attribute_Name => Name_Tag);
-            end if;
-
-            Insert_Action (Exp,
-              Make_Raise_Program_Error (Loc,
-                Condition =>
-                  Make_Op_Gt (Loc,
-                    Left_Opnd =>
-                      Build_Get_Access_Level (Loc, Tag_Node),
-                    Right_Opnd =>
-                      Make_Integer_Literal (Loc,
-                        Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))),
-                Reason => PE_Accessibility_Check_Failed));
-         end;
-
-      --  AI05-0073: If function has a controlling access result, check that
-      --  the tag of the return value, if it is not null, matches designated
-      --  type of return type.
-
-      --  The "or else True" needs commenting here ???
-
-      elsif Ekind (R_Type) = E_Anonymous_Access_Type
-        and then Has_Controlling_Result (Scope_Id)
-      then
-         Insert_Action (N,
-           Make_Raise_Constraint_Error (Loc,
-             Condition =>
-               Make_And_Then (Loc,
-                 Left_Opnd  =>
-                   Make_Op_Ne (Loc,
-                     Left_Opnd  => Exp,
-                     Right_Opnd => Make_Null (Loc)),
-                 Right_Opnd => Make_Op_Ne (Loc,
-                   Left_Opnd  =>
-                     Make_Selected_Component (Loc,
-                       Prefix        => Duplicate_Subexpr (Exp),
-                       Selector_Name =>
-                         Make_Identifier (Loc, Chars => Name_uTag)),
-                   Right_Opnd =>
-                     Make_Attribute_Reference (Loc,
-                       Prefix         =>
-                         New_Occurrence_Of (Designated_Type (R_Type), Loc),
-                       Attribute_Name => Name_Tag))),
-             Reason    => CE_Tag_Check_Failed),
-             Suppress  => All_Checks);
-      end if;
-
-      --  If we are returning an object that may not be bit-aligned, then copy
-      --  the value into a temporary first. This copy may need to expand to a
-      --  loop of component operations.
-
-      if Is_Possibly_Unaligned_Slice (Exp)
-        or else Is_Possibly_Unaligned_Object (Exp)
-      then
-         declare
-            ExpR : constant Node_Id   := Relocate_Node (Exp);
-            Tnn  : constant Entity_Id := Make_Temporary (Loc, 'T', ExpR);
-         begin
-            Insert_Action (Exp,
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Tnn,
-                Constant_Present    => True,
-                Object_Definition   => New_Occurrence_Of (R_Type, Loc),
-                Expression          => ExpR),
-              Suppress            => All_Checks);
-            Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
-         end;
-      end if;
-
-      --  Generate call to postcondition checks if they are present
-
-      if Ekind (Scope_Id) = E_Function
-        and then Has_Postconditions (Scope_Id)
-      then
-         --  We are going to reference the returned value twice in this case,
-         --  once in the call to _Postconditions, and once in the actual return
-         --  statement, but we can't have side effects happening twice, and in
-         --  any case for efficiency we don't want to do the computation twice.
-
-         --  If the returned expression is an entity name, we don't need to
-         --  worry since it is efficient and safe to reference it twice, that's
-         --  also true for literals other than string literals, and for the
-         --  case of X.all where X is an entity name.
-
-         if Is_Entity_Name (Exp)
-           or else Nkind_In (Exp, N_Character_Literal,
-                                  N_Integer_Literal,
-                                  N_Real_Literal)
-           or else (Nkind (Exp) = N_Explicit_Dereference
-                      and then Is_Entity_Name (Prefix (Exp)))
-         then
-            null;
-
-         --  Otherwise we are going to need a temporary to capture the value
-
-         else
-            declare
-               ExpR : constant Node_Id   := Relocate_Node (Exp);
-               Tnn  : constant Entity_Id := Make_Temporary (Loc, 'T', ExpR);
-
-            begin
-               --  For a complex expression of an elementary type, capture
-               --  value in the temporary and use it as the reference.
-
-               if Is_Elementary_Type (R_Type) then
-                  Insert_Action (Exp,
-                    Make_Object_Declaration (Loc,
-                      Defining_Identifier => Tnn,
-                      Constant_Present    => True,
-                      Object_Definition   => New_Occurrence_Of (R_Type, Loc),
-                      Expression          => ExpR),
-                    Suppress => All_Checks);
-
-                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
-
-               --  If we have something we can rename, generate a renaming of
-               --  the object and replace the expression with a reference
-
-               elsif Is_Object_Reference (Exp) then
-                  Insert_Action (Exp,
-                    Make_Object_Renaming_Declaration (Loc,
-                      Defining_Identifier => Tnn,
-                      Subtype_Mark        => New_Occurrence_Of (R_Type, Loc),
-                      Name                => ExpR),
-                    Suppress => All_Checks);
-
-                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
-
-               --  Otherwise we have something like a string literal or an
-               --  aggregate. We could copy the value, but that would be
-               --  inefficient. Instead we make a reference to the value and
-               --  capture this reference with a renaming, the expression is
-               --  then replaced by a dereference of this renaming.
-
-               else
-                  --  For now, copy the value, since the code below does not
-                  --  seem to work correctly ???
-
-                  Insert_Action (Exp,
-                    Make_Object_Declaration (Loc,
-                      Defining_Identifier => Tnn,
-                      Constant_Present    => True,
-                      Object_Definition   => New_Occurrence_Of (R_Type, Loc),
-                      Expression          => Relocate_Node (Exp)),
-                    Suppress => All_Checks);
-
-                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
-
-                  --  Insert_Action (Exp,
-                  --    Make_Object_Renaming_Declaration (Loc,
-                  --      Defining_Identifier => Tnn,
-                  --      Access_Definition =>
-                  --        Make_Access_Definition (Loc,
-                  --          All_Present  => True,
-                  --          Subtype_Mark => New_Occurrence_Of (R_Type, Loc)),
-                  --      Name =>
-                  --        Make_Reference (Loc,
-                  --          Prefix => Relocate_Node (Exp))),
-                  --    Suppress => All_Checks);
-
-                  --  Rewrite (Exp,
-                  --    Make_Explicit_Dereference (Loc,
-                  --      Prefix => New_Occurrence_Of (Tnn, Loc)));
-               end if;
-            end;
-         end if;
-
-         --  Generate call to _postconditions
-
-         Insert_Action (Exp,
-           Make_Procedure_Call_Statement (Loc,
-             Name => Make_Identifier (Loc, Name_uPostconditions),
-             Parameter_Associations => New_List (Duplicate_Subexpr (Exp))));
-      end if;
-
-      --  Ada 2005 (AI-251): If this return statement corresponds with an
-      --  simple return statement associated with an extended return statement
-      --  and the type of the returned object is an interface then generate an
-      --  implicit conversion to force displacement of the "this" pointer.
-
-      if Ada_Version >= Ada_05
-        and then Comes_From_Extended_Return_Statement (N)
-        and then Nkind (Expression (N)) = N_Identifier
-        and then Is_Interface (Utyp)
-        and then Utyp /= Underlying_Type (Exptyp)
-      then
-         Rewrite (Exp, Convert_To (Utyp, Relocate_Node (Exp)));
-         Analyze_And_Resolve (Exp);
-      end if;
-   end Expand_Simple_Function_Return;
-
    ------------------------------
    -- Make_Tag_Ctrl_Assignment --
    ------------------------------
diff --git a/gcc/ada/exp_ch5.ads b/gcc/ada/exp_ch5.ads
index 0c9948dcd54..7967164729d 100644
--- a/gcc/ada/exp_ch5.ads
+++ b/gcc/ada/exp_ch5.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -32,9 +32,7 @@ package Exp_Ch5 is
    procedure Expand_N_Block_Statement           (N : Node_Id);
    procedure Expand_N_Case_Statement            (N : Node_Id);
    procedure Expand_N_Exit_Statement            (N : Node_Id);
-   procedure Expand_N_Extended_Return_Statement (N : Node_Id);
    procedure Expand_N_Goto_Statement            (N : Node_Id);
    procedure Expand_N_If_Statement              (N : Node_Id);
    procedure Expand_N_Loop_Statement            (N : Node_Id);
-   procedure Expand_N_Simple_Return_Statement   (N : Node_Id);
 end Exp_Ch5;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index d94117f41fd..c439a91e01d 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -69,6 +69,7 @@ with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
+with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 with Validsw;  use Validsw;
@@ -202,6 +203,12 @@ package body Exp_Ch6 is
    --  expressions in the body must be converted to the desired type (which
    --  is simply not noted in the tree without inline expansion).
 
+   procedure Expand_Non_Function_Return (N : Node_Id);
+   --  Called by Expand_N_Simple_Return_Statement in case we're returning from
+   --  a procedure body, entry body, accept statement, or extended return
+   --  statement.  Note that all non-function returns are simple return
+   --  statements.
+
    function Expand_Protected_Object_Reference
      (N    : Node_Id;
       Scop : Entity_Id) return Node_Id;
@@ -219,6 +226,10 @@ package body Exp_Ch6 is
    --  Predicate to recognize stubbed procedures and null procedures, which
    --  can be inlined unconditionally in all cases.
 
+   procedure Expand_Simple_Function_Return (N : Node_Id);
+   --  Expand simple return from function. In the case where we are returning
+   --  from a function body this is called by Expand_N_Simple_Return_Statement.
+
    ----------------------------------------------
    -- Add_Access_Actual_To_Build_In_Place_Call --
    ----------------------------------------------
@@ -4076,6 +4087,728 @@ package body Exp_Ch6 is
       end loop;
    end Expand_Inlined_Call;
 
+   ----------------------------------------
+   -- Expand_N_Extended_Return_Statement --
+   ----------------------------------------
+
+   --  If there is a Handled_Statement_Sequence, we rewrite this:
+
+   --     return Result : T := <expression> do
+   --        <handled_seq_of_stms>
+   --     end return;
+
+   --  to be:
+
+   --     declare
+   --        Result : T := <expression>;
+   --     begin
+   --        <handled_seq_of_stms>
+   --        return Result;
+   --     end;
+
+   --  Otherwise (no Handled_Statement_Sequence), we rewrite this:
+
+   --     return Result : T := <expression>;
+
+   --  to be:
+
+   --     return <expression>;
+
+   --  unless it's build-in-place or there's no <expression>, in which case
+   --  we generate:
+
+   --     declare
+   --        Result : T := <expression>;
+   --     begin
+   --        return Result;
+   --     end;
+
+   --  Note that this case could have been written by the user as an extended
+   --  return statement, or could have been transformed to this from a simple
+   --  return statement.
+
+   --  That is, we need to have a reified return object if there are statements
+   --  (which might refer to it) or if we're doing build-in-place (so we can
+   --  set its address to the final resting place or if there is no expression
+   --  (in which case default initial values might need to be set).
+
+   procedure Expand_N_Extended_Return_Statement (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+
+      Return_Object_Entity : constant Entity_Id :=
+                               First_Entity (Return_Statement_Entity (N));
+      Return_Object_Decl   : constant Node_Id :=
+                               Parent (Return_Object_Entity);
+      Parent_Function      : constant Entity_Id :=
+                               Return_Applies_To (Return_Statement_Entity (N));
+      Parent_Function_Typ  : constant Entity_Id := Etype (Parent_Function);
+      Is_Build_In_Place    : constant Boolean :=
+                               Is_Build_In_Place_Function (Parent_Function);
+
+      Return_Stm      : Node_Id;
+      Statements      : List_Id;
+      Handled_Stm_Seq : Node_Id;
+      Result          : Node_Id;
+      Exp             : Node_Id;
+
+      function Has_Controlled_Parts (Typ : Entity_Id) return Boolean;
+      --  Determine whether type Typ is controlled or contains a controlled
+      --  subcomponent.
+
+      function Move_Activation_Chain return Node_Id;
+      --  Construct a call to System.Tasking.Stages.Move_Activation_Chain
+      --  with parameters:
+      --    From         current activation chain
+      --    To           activation chain passed in by the caller
+      --    New_Master   master passed in by the caller
+
+      function Move_Final_List return Node_Id;
+      --  Construct call to System.Finalization_Implementation.Move_Final_List
+      --  with parameters:
+      --
+      --    From         finalization list of the return statement
+      --    To           finalization list passed in by the caller
+
+      --------------------------
+      -- Has_Controlled_Parts --
+      --------------------------
+
+      function Has_Controlled_Parts (Typ : Entity_Id) return Boolean is
+      begin
+         return
+           Is_Controlled (Typ)
+             or else Has_Controlled_Component (Typ);
+      end Has_Controlled_Parts;
+
+      ---------------------------
+      -- Move_Activation_Chain --
+      ---------------------------
+
+      function Move_Activation_Chain return Node_Id is
+         Activation_Chain_Formal : constant Entity_Id :=
+                                     Build_In_Place_Formal
+                                       (Parent_Function, BIP_Activation_Chain);
+         To                      : constant Node_Id :=
+                                     New_Reference_To
+                                       (Activation_Chain_Formal, Loc);
+         Master_Formal           : constant Entity_Id :=
+                                     Build_In_Place_Formal
+                                       (Parent_Function, BIP_Master);
+         New_Master              : constant Node_Id :=
+                                     New_Reference_To (Master_Formal, Loc);
+
+         Chain_Entity : Entity_Id;
+         From         : Node_Id;
+
+      begin
+         Chain_Entity := First_Entity (Return_Statement_Entity (N));
+         while Chars (Chain_Entity) /= Name_uChain loop
+            Chain_Entity := Next_Entity (Chain_Entity);
+         end loop;
+
+         From :=
+           Make_Attribute_Reference (Loc,
+             Prefix         => New_Reference_To (Chain_Entity, Loc),
+             Attribute_Name => Name_Unrestricted_Access);
+         --  ??? Not clear why "Make_Identifier (Loc, Name_uChain)" doesn't
+         --  work, instead of "New_Reference_To (Chain_Entity, Loc)" above.
+
+         return
+           Make_Procedure_Call_Statement (Loc,
+             Name => New_Reference_To (RTE (RE_Move_Activation_Chain), Loc),
+             Parameter_Associations => New_List (From, To, New_Master));
+      end Move_Activation_Chain;
+
+      ---------------------
+      -- Move_Final_List --
+      ---------------------
+
+      function Move_Final_List return Node_Id is
+         Flist : constant Entity_Id  :=
+                   Finalization_Chain_Entity (Return_Statement_Entity (N));
+
+         From : constant Node_Id := New_Reference_To (Flist, Loc);
+
+         Caller_Final_List : constant Entity_Id :=
+                               Build_In_Place_Formal
+                                 (Parent_Function, BIP_Final_List);
+
+         To : constant Node_Id := New_Reference_To (Caller_Final_List, Loc);
+
+      begin
+         --  Catch cases where a finalization chain entity has not been
+         --  associated with the return statement entity.
+
+         pragma Assert (Present (Flist));
+
+         --  Build required call
+
+         return
+           Make_If_Statement (Loc,
+             Condition =>
+               Make_Op_Ne (Loc,
+                 Left_Opnd  => New_Copy (From),
+                 Right_Opnd => New_Node (N_Null, Loc)),
+             Then_Statements =>
+               New_List (
+                 Make_Procedure_Call_Statement (Loc,
+                   Name => New_Reference_To (RTE (RE_Move_Final_List), Loc),
+                   Parameter_Associations => New_List (From, To))));
+      end Move_Final_List;
+
+   --  Start of processing for Expand_N_Extended_Return_Statement
+
+   begin
+      if Nkind (Return_Object_Decl) = N_Object_Declaration then
+         Exp := Expression (Return_Object_Decl);
+      else
+         Exp := Empty;
+      end if;
+
+      Handled_Stm_Seq := Handled_Statement_Sequence (N);
+
+      --  Build a simple_return_statement that returns the return object when
+      --  there is a statement sequence, or no expression, or the result will
+      --  be built in place. Note however that we currently do this for all
+      --  composite cases, even though nonlimited composite results are not yet
+      --  built in place (though we plan to do so eventually).
+
+      if Present (Handled_Stm_Seq)
+        or else Is_Composite_Type (Etype (Parent_Function))
+        or else No (Exp)
+      then
+         if No (Handled_Stm_Seq) then
+            Statements := New_List;
+
+         --  If the extended return has a handled statement sequence, then wrap
+         --  it in a block and use the block as the first statement.
+
+         else
+            Statements :=
+              New_List (Make_Block_Statement (Loc,
+                          Declarations => New_List,
+                          Handled_Statement_Sequence => Handled_Stm_Seq));
+         end if;
+
+         --  If control gets past the above Statements, we have successfully
+         --  completed the return statement. If the result type has controlled
+         --  parts and the return is for a build-in-place function, then we
+         --  call Move_Final_List to transfer responsibility for finalization
+         --  of the return object to the caller. An alternative would be to
+         --  declare a Success flag in the function, initialize it to False,
+         --  and set it to True here. Then move the Move_Final_List call into
+         --  the cleanup code, and check Success. If Success then make a call
+         --  to Move_Final_List else do finalization. Then we can remove the
+         --  abort-deferral and the nulling-out of the From parameter from
+         --  Move_Final_List. Note that the current method is not quite correct
+         --  in the rather obscure case of a select-then-abort statement whose
+         --  abortable part contains the return statement.
+
+         --  Check the type of the function to determine whether to move the
+         --  finalization list. A special case arises when processing a simple
+         --  return statement which has been rewritten as an extended return.
+         --  In that case check the type of the returned object or the original
+         --  expression.
+
+         if Is_Build_In_Place
+           and then
+               (Has_Controlled_Parts (Parent_Function_Typ)
+                 or else (Is_Class_Wide_Type (Parent_Function_Typ)
+                           and then
+                        Has_Controlled_Parts (Root_Type (Parent_Function_Typ)))
+                 or else Has_Controlled_Parts (Etype (Return_Object_Entity))
+                 or else (Present (Exp)
+                           and then Has_Controlled_Parts (Etype (Exp))))
+         then
+            Append_To (Statements, Move_Final_List);
+         end if;
+
+         --  Similarly to the above Move_Final_List, if the result type
+         --  contains tasks, we call Move_Activation_Chain. Later, the cleanup
+         --  code will call Complete_Master, which will terminate any
+         --  unactivated tasks belonging to the return statement master. But
+         --  Move_Activation_Chain updates their master to be that of the
+         --  caller, so they will not be terminated unless the return statement
+         --  completes unsuccessfully due to exception, abort, goto, or exit.
+         --  As a formality, we test whether the function requires the result
+         --  to be built in place, though that's necessarily true for the case
+         --  of result types with task parts.
+
+         if Is_Build_In_Place and Has_Task (Etype (Parent_Function)) then
+            Append_To (Statements, Move_Activation_Chain);
+         end if;
+
+         --  Build a simple_return_statement that returns the return object
+
+         Return_Stm :=
+           Make_Simple_Return_Statement (Loc,
+             Expression => New_Occurrence_Of (Return_Object_Entity, Loc));
+         Append_To (Statements, Return_Stm);
+
+         Handled_Stm_Seq :=
+           Make_Handled_Sequence_Of_Statements (Loc, Statements);
+      end if;
+
+      --  Case where we build a block
+
+      if Present (Handled_Stm_Seq) then
+         Result :=
+           Make_Block_Statement (Loc,
+             Declarations => Return_Object_Declarations (N),
+             Handled_Statement_Sequence => Handled_Stm_Seq);
+
+         --  We set the entity of the new block statement to be that of the
+         --  return statement. This is necessary so that various fields, such
+         --  as Finalization_Chain_Entity carry over from the return statement
+         --  to the block. Note that this block is unusual, in that its entity
+         --  is an E_Return_Statement rather than an E_Block.
+
+         Set_Identifier
+           (Result, New_Occurrence_Of (Return_Statement_Entity (N), Loc));
+
+         --  If the object decl was already rewritten as a renaming, then
+         --  we don't want to do the object allocation and transformation of
+         --  of the return object declaration to a renaming. This case occurs
+         --  when the return object is initialized by a call to another
+         --  build-in-place function, and that function is responsible for the
+         --  allocation of the return object.
+
+         if Is_Build_In_Place
+           and then
+             Nkind (Return_Object_Decl) = N_Object_Renaming_Declaration
+         then
+            pragma Assert (Nkind (Original_Node (Return_Object_Decl)) =
+                            N_Object_Declaration
+              and then Is_Build_In_Place_Function_Call
+                         (Expression (Original_Node (Return_Object_Decl))));
+
+            Set_By_Ref (Return_Stm);  -- Return build-in-place results by ref
+
+         elsif Is_Build_In_Place then
+
+            --  Locate the implicit access parameter associated with the
+            --  caller-supplied return object and convert the return
+            --  statement's return object declaration to a renaming of a
+            --  dereference of the access parameter. If the return object's
+            --  declaration includes an expression that has not already been
+            --  expanded as separate assignments, then add an assignment
+            --  statement to ensure the return object gets initialized.
+
+            --  declare
+            --     Result : T [:= <expression>];
+            --  begin
+            --     ...
+
+            --  is converted to
+
+            --  declare
+            --     Result : T renames FuncRA.all;
+            --     [Result := <expression;]
+            --  begin
+            --     ...
+
+            declare
+               Return_Obj_Id    : constant Entity_Id :=
+                                    Defining_Identifier (Return_Object_Decl);
+               Return_Obj_Typ   : constant Entity_Id := Etype (Return_Obj_Id);
+               Return_Obj_Expr  : constant Node_Id :=
+                                    Expression (Return_Object_Decl);
+               Result_Subt      : constant Entity_Id :=
+                                    Etype (Parent_Function);
+               Constr_Result    : constant Boolean :=
+                                    Is_Constrained (Result_Subt);
+               Obj_Alloc_Formal : Entity_Id;
+               Object_Access    : Entity_Id;
+               Obj_Acc_Deref    : Node_Id;
+               Init_Assignment  : Node_Id := Empty;
+
+            begin
+               --  Build-in-place results must be returned by reference
+
+               Set_By_Ref (Return_Stm);
+
+               --  Retrieve the implicit access parameter passed by the caller
+
+               Object_Access :=
+                 Build_In_Place_Formal (Parent_Function, BIP_Object_Access);
+
+               --  If the return object's declaration includes an expression
+               --  and the declaration isn't marked as No_Initialization, then
+               --  we need to generate an assignment to the object and insert
+               --  it after the declaration before rewriting it as a renaming
+               --  (otherwise we'll lose the initialization). The case where
+               --  the result type is an interface (or class-wide interface)
+               --  is also excluded because the context of the function call
+               --  must be unconstrained, so the initialization will always
+               --  be done as part of an allocator evaluation (storage pool
+               --  or secondary stack), never to a constrained target object
+               --  passed in by the caller. Besides the assignment being
+               --  unneeded in this case, it avoids problems with trying to
+               --  generate a dispatching assignment when the return expression
+               --  is a nonlimited descendant of a limited interface (the
+               --  interface has no assignment operation).
+
+               if Present (Return_Obj_Expr)
+                 and then not No_Initialization (Return_Object_Decl)
+                 and then not Is_Interface (Return_Obj_Typ)
+               then
+                  Init_Assignment :=
+                    Make_Assignment_Statement (Loc,
+                      Name       => New_Reference_To (Return_Obj_Id, Loc),
+                      Expression => Relocate_Node (Return_Obj_Expr));
+                  Set_Etype (Name (Init_Assignment), Etype (Return_Obj_Id));
+                  Set_Assignment_OK (Name (Init_Assignment));
+                  Set_No_Ctrl_Actions (Init_Assignment);
+
+                  Set_Parent (Name (Init_Assignment), Init_Assignment);
+                  Set_Parent (Expression (Init_Assignment), Init_Assignment);
+
+                  Set_Expression (Return_Object_Decl, Empty);
+
+                  if Is_Class_Wide_Type (Etype (Return_Obj_Id))
+                    and then not Is_Class_Wide_Type
+                                   (Etype (Expression (Init_Assignment)))
+                  then
+                     Rewrite (Expression (Init_Assignment),
+                       Make_Type_Conversion (Loc,
+                         Subtype_Mark =>
+                           New_Occurrence_Of
+                             (Etype (Return_Obj_Id), Loc),
+                         Expression =>
+                           Relocate_Node (Expression (Init_Assignment))));
+                  end if;
+
+                  --  In the case of functions where the calling context can
+                  --  determine the form of allocation needed, initialization
+                  --  is done with each part of the if statement that handles
+                  --  the different forms of allocation (this is true for
+                  --  unconstrained and tagged result subtypes).
+
+                  if Constr_Result
+                    and then not Is_Tagged_Type (Underlying_Type (Result_Subt))
+                  then
+                     Insert_After (Return_Object_Decl, Init_Assignment);
+                  end if;
+               end if;
+
+               --  When the function's subtype is unconstrained, a run-time
+               --  test is needed to determine the form of allocation to use
+               --  for the return object. The function has an implicit formal
+               --  parameter indicating this. If the BIP_Alloc_Form formal has
+               --  the value one, then the caller has passed access to an
+               --  existing object for use as the return object. If the value
+               --  is two, then the return object must be allocated on the
+               --  secondary stack. Otherwise, the object must be allocated in
+               --  a storage pool (currently only supported for the global
+               --  heap, user-defined storage pools TBD ???). We generate an
+               --  if statement to test the implicit allocation formal and
+               --  initialize a local access value appropriately, creating
+               --  allocators in the secondary stack and global heap cases.
+               --  The special formal also exists and must be tested when the
+               --  function has a tagged result, even when the result subtype
+               --  is constrained, because in general such functions can be
+               --  called in dispatching contexts and must be handled similarly
+               --  to functions with a class-wide result.
+
+               if not Constr_Result
+                 or else Is_Tagged_Type (Underlying_Type (Result_Subt))
+               then
+                  Obj_Alloc_Formal :=
+                    Build_In_Place_Formal (Parent_Function, BIP_Alloc_Form);
+
+                  declare
+                     Ref_Type       : Entity_Id;
+                     Ptr_Type_Decl  : Node_Id;
+                     Alloc_Obj_Id   : Entity_Id;
+                     Alloc_Obj_Decl : Node_Id;
+                     Alloc_If_Stmt  : Node_Id;
+                     SS_Allocator   : Node_Id;
+                     Heap_Allocator : Node_Id;
+
+                  begin
+                     --  Reuse the itype created for the function's implicit
+                     --  access formal. This avoids the need to create a new
+                     --  access type here, plus it allows assigning the access
+                     --  formal directly without applying a conversion.
+
+                     --  Ref_Type := Etype (Object_Access);
+
+                     --  Create an access type designating the function's
+                     --  result subtype.
+
+                     Ref_Type := Make_Temporary (Loc, 'A');
+
+                     Ptr_Type_Decl :=
+                       Make_Full_Type_Declaration (Loc,
+                         Defining_Identifier => Ref_Type,
+                         Type_Definition =>
+                           Make_Access_To_Object_Definition (Loc,
+                             All_Present => True,
+                             Subtype_Indication =>
+                               New_Reference_To (Return_Obj_Typ, Loc)));
+
+                     Insert_Before (Return_Object_Decl, Ptr_Type_Decl);
+
+                     --  Create an access object that will be initialized to an
+                     --  access value denoting the return object, either coming
+                     --  from an implicit access value passed in by the caller
+                     --  or from the result of an allocator.
+
+                     Alloc_Obj_Id := Make_Temporary (Loc, 'R');
+                     Set_Etype (Alloc_Obj_Id, Ref_Type);
+
+                     Alloc_Obj_Decl :=
+                       Make_Object_Declaration (Loc,
+                         Defining_Identifier => Alloc_Obj_Id,
+                         Object_Definition   => New_Reference_To
+                                                  (Ref_Type, Loc));
+
+                     Insert_Before (Return_Object_Decl, Alloc_Obj_Decl);
+
+                     --  Create allocators for both the secondary stack and
+                     --  global heap. If there's an initialization expression,
+                     --  then create these as initialized allocators.
+
+                     if Present (Return_Obj_Expr)
+                       and then not No_Initialization (Return_Object_Decl)
+                     then
+                        --  Always use the type of the expression for the
+                        --  qualified expression, rather than the result type.
+                        --  In general we cannot always use the result type
+                        --  for the allocator, because the expression might be
+                        --  of a specific type, such as in the case of an
+                        --  aggregate or even a nonlimited object when the
+                        --  result type is a limited class-wide interface type.
+
+                        Heap_Allocator :=
+                          Make_Allocator (Loc,
+                            Expression =>
+                              Make_Qualified_Expression (Loc,
+                                Subtype_Mark =>
+                                  New_Reference_To
+                                    (Etype (Return_Obj_Expr), Loc),
+                                Expression =>
+                                  New_Copy_Tree (Return_Obj_Expr)));
+
+                     else
+                        --  If the function returns a class-wide type we cannot
+                        --  use the return type for the allocator. Instead we
+                        --  use the type of the expression, which must be an
+                        --  aggregate of a definite type.
+
+                        if Is_Class_Wide_Type (Return_Obj_Typ) then
+                           Heap_Allocator :=
+                             Make_Allocator (Loc,
+                               Expression =>
+                                 New_Reference_To
+                                   (Etype (Return_Obj_Expr), Loc));
+                        else
+                           Heap_Allocator :=
+                             Make_Allocator (Loc,
+                               Expression =>
+                                 New_Reference_To (Return_Obj_Typ, Loc));
+                        end if;
+
+                        --  If the object requires default initialization then
+                        --  that will happen later following the elaboration of
+                        --  the object renaming. If we don't turn it off here
+                        --  then the object will be default initialized twice.
+
+                        Set_No_Initialization (Heap_Allocator);
+                     end if;
+
+                     --  If the No_Allocators restriction is active, then only
+                     --  an allocator for secondary stack allocation is needed.
+                     --  It's OK for such allocators to have Comes_From_Source
+                     --  set to False, because gigi knows not to flag them as
+                     --  being a violation of No_Implicit_Heap_Allocations.
+
+                     if Restriction_Active (No_Allocators) then
+                        SS_Allocator   := Heap_Allocator;
+                        Heap_Allocator := Make_Null (Loc);
+
+                     --  Otherwise the heap allocator may be needed, so we make
+                     --  another allocator for secondary stack allocation.
+
+                     else
+                        SS_Allocator := New_Copy_Tree (Heap_Allocator);
+
+                        --  The heap allocator is marked Comes_From_Source
+                        --  since it corresponds to an explicit user-written
+                        --  allocator (that is, it will only be executed on
+                        --  behalf of callers that call the function as
+                        --  initialization for such an allocator). This
+                        --  prevents errors when No_Implicit_Heap_Allocations
+                        --  is in force.
+
+                        Set_Comes_From_Source (Heap_Allocator, True);
+                     end if;
+
+                     --  The allocator is returned on the secondary stack. We
+                     --  don't do this on VM targets, since the SS is not used.
+
+                     if VM_Target = No_VM then
+                        Set_Storage_Pool (SS_Allocator, RTE (RE_SS_Pool));
+                        Set_Procedure_To_Call
+                          (SS_Allocator, RTE (RE_SS_Allocate));
+
+                        --  The allocator is returned on the secondary stack,
+                        --  so indicate that the function return, as well as
+                        --  the block that encloses the allocator, must not
+                        --  release it. The flags must be set now because the
+                        --  decision to use the secondary stack is done very
+                        --  late in the course of expanding the return
+                        --  statement, past the point where these flags are
+                        --  normally set.
+
+                        Set_Sec_Stack_Needed_For_Return (Parent_Function);
+                        Set_Sec_Stack_Needed_For_Return
+                          (Return_Statement_Entity (N));
+                        Set_Uses_Sec_Stack (Parent_Function);
+                        Set_Uses_Sec_Stack (Return_Statement_Entity (N));
+                     end if;
+
+                     --  Create an if statement to test the BIP_Alloc_Form
+                     --  formal and initialize the access object to either the
+                     --  BIP_Object_Access formal (BIP_Alloc_Form = 0), the
+                     --  result of allocating the object in the secondary stack
+                     --  (BIP_Alloc_Form = 1), or else an allocator to create
+                     --  the return object in the heap (BIP_Alloc_Form = 2).
+
+                     --  ??? An unchecked type conversion must be made in the
+                     --  case of assigning the access object formal to the
+                     --  local access object, because a normal conversion would
+                     --  be illegal in some cases (such as converting access-
+                     --  to-unconstrained to access-to-constrained), but the
+                     --  the unchecked conversion will presumably fail to work
+                     --  right in just such cases. It's not clear at all how to
+                     --  handle this. ???
+
+                     Alloc_If_Stmt :=
+                       Make_If_Statement (Loc,
+                         Condition       =>
+                           Make_Op_Eq (Loc,
+                             Left_Opnd =>
+                               New_Reference_To (Obj_Alloc_Formal, Loc),
+                             Right_Opnd =>
+                               Make_Integer_Literal (Loc,
+                                 UI_From_Int (BIP_Allocation_Form'Pos
+                                                (Caller_Allocation)))),
+                         Then_Statements =>
+                           New_List (Make_Assignment_Statement (Loc,
+                                       Name       =>
+                                         New_Reference_To
+                                           (Alloc_Obj_Id, Loc),
+                                       Expression =>
+                                         Make_Unchecked_Type_Conversion (Loc,
+                                           Subtype_Mark =>
+                                             New_Reference_To (Ref_Type, Loc),
+                                           Expression =>
+                                             New_Reference_To
+                                               (Object_Access, Loc)))),
+                         Elsif_Parts     =>
+                           New_List (Make_Elsif_Part (Loc,
+                                       Condition       =>
+                                         Make_Op_Eq (Loc,
+                                           Left_Opnd =>
+                                             New_Reference_To
+                                               (Obj_Alloc_Formal, Loc),
+                                           Right_Opnd =>
+                                             Make_Integer_Literal (Loc,
+                                               UI_From_Int (
+                                                 BIP_Allocation_Form'Pos
+                                                    (Secondary_Stack)))),
+                                       Then_Statements =>
+                                          New_List
+                                            (Make_Assignment_Statement (Loc,
+                                               Name       =>
+                                                 New_Reference_To
+                                                   (Alloc_Obj_Id, Loc),
+                                               Expression =>
+                                                 SS_Allocator)))),
+                         Else_Statements =>
+                           New_List (Make_Assignment_Statement (Loc,
+                                        Name       =>
+                                          New_Reference_To
+                                            (Alloc_Obj_Id, Loc),
+                                        Expression =>
+                                          Heap_Allocator)));
+
+                     --  If a separate initialization assignment was created
+                     --  earlier, append that following the assignment of the
+                     --  implicit access formal to the access object, to ensure
+                     --  that the return object is initialized in that case.
+                     --  In this situation, the target of the assignment must
+                     --  be rewritten to denote a dereference of the access to
+                     --  the return object passed in by the caller.
+
+                     if Present (Init_Assignment) then
+                        Rewrite (Name (Init_Assignment),
+                          Make_Explicit_Dereference (Loc,
+                            Prefix => New_Reference_To (Alloc_Obj_Id, Loc)));
+                        Set_Etype
+                          (Name (Init_Assignment), Etype (Return_Obj_Id));
+
+                        Append_To
+                          (Then_Statements (Alloc_If_Stmt),
+                           Init_Assignment);
+                     end if;
+
+                     Insert_Before (Return_Object_Decl, Alloc_If_Stmt);
+
+                     --  Remember the local access object for use in the
+                     --  dereference of the renaming created below.
+
+                     Object_Access := Alloc_Obj_Id;
+                  end;
+               end if;
+
+               --  Replace the return object declaration with a renaming of a
+               --  dereference of the access value designating the return
+               --  object.
+
+               Obj_Acc_Deref :=
+                 Make_Explicit_Dereference (Loc,
+                   Prefix => New_Reference_To (Object_Access, Loc));
+
+               Rewrite (Return_Object_Decl,
+                 Make_Object_Renaming_Declaration (Loc,
+                   Defining_Identifier => Return_Obj_Id,
+                   Access_Definition   => Empty,
+                   Subtype_Mark        => New_Occurrence_Of
+                                            (Return_Obj_Typ, Loc),
+                   Name                => Obj_Acc_Deref));
+
+               Set_Renamed_Object (Return_Obj_Id, Obj_Acc_Deref);
+            end;
+         end if;
+
+      --  Case where we do not build a block
+
+      else
+         --  We're about to drop Return_Object_Declarations on the floor, so
+         --  we need to insert it, in case it got expanded into useful code.
+         --  Remove side effects from expression, which may be duplicated in
+         --  subsequent checks (see Expand_Simple_Function_Return).
+
+         Insert_List_Before (N, Return_Object_Declarations (N));
+         Remove_Side_Effects (Exp);
+
+         --  Build simple_return_statement that returns the expression directly
+
+         Return_Stm := Make_Simple_Return_Statement (Loc, Expression => Exp);
+
+         Result := Return_Stm;
+      end if;
+
+      --  Set the flag to prevent infinite recursion
+
+      Set_Comes_From_Extended_Return_Statement (Return_Stm);
+
+      Rewrite (N, Result);
+      Analyze (N);
+   end Expand_N_Extended_Return_Statement;
+
    ----------------------------
    -- Expand_N_Function_Call --
    ----------------------------
@@ -4109,6 +4842,45 @@ package body Exp_Ch6 is
       Expand_Call (N);
    end Expand_N_Procedure_Call_Statement;
 
+   --------------------------------------
+   -- Expand_N_Simple_Return_Statement --
+   --------------------------------------
+
+   procedure Expand_N_Simple_Return_Statement (N : Node_Id) is
+   begin
+      --  Defend against previous errors (i.e. the return statement calls a
+      --  function that is not available in configurable runtime).
+
+      if Present (Expression (N))
+        and then Nkind (Expression (N)) = N_Empty
+      then
+         return;
+      end if;
+
+      --  Distinguish the function and non-function cases:
+
+      case Ekind (Return_Applies_To (Return_Statement_Entity (N))) is
+
+         when E_Function          |
+              E_Generic_Function  =>
+            Expand_Simple_Function_Return (N);
+
+         when E_Procedure         |
+              E_Generic_Procedure |
+              E_Entry             |
+              E_Entry_Family      |
+              E_Return_Statement =>
+            Expand_Non_Function_Return (N);
+
+         when others =>
+            raise Program_Error;
+      end case;
+
+   exception
+      when RE_Not_Available =>
+         return;
+   end Expand_N_Simple_Return_Statement;
+
    ------------------------------
    -- Expand_N_Subprogram_Body --
    ------------------------------
@@ -4619,6 +5391,122 @@ package body Exp_Ch6 is
       end if;
    end Expand_N_Subprogram_Declaration;
 
+   --------------------------------
+   -- Expand_Non_Function_Return --
+   --------------------------------
+
+   procedure Expand_Non_Function_Return (N : Node_Id) is
+      pragma Assert (No (Expression (N)));
+
+      Loc         : constant Source_Ptr := Sloc (N);
+      Scope_Id    : Entity_Id :=
+                      Return_Applies_To (Return_Statement_Entity (N));
+      Kind        : constant Entity_Kind := Ekind (Scope_Id);
+      Call        : Node_Id;
+      Acc_Stat    : Node_Id;
+      Goto_Stat   : Node_Id;
+      Lab_Node    : Node_Id;
+
+   begin
+      --  Call _Postconditions procedure if procedure with active
+      --  postconditions. Here, we use the Postcondition_Proc attribute, which
+      --  is needed for implicitly-generated returns. Functions never
+      --  have implicitly-generated returns, and there's no room for
+      --  Postcondition_Proc in E_Function, so we look up the identifier
+      --  Name_uPostconditions for function returns (see
+      --  Expand_Simple_Function_Return).
+
+      if Ekind (Scope_Id) = E_Procedure
+        and then Has_Postconditions (Scope_Id)
+      then
+         pragma Assert (Present (Postcondition_Proc (Scope_Id)));
+         Insert_Action (N,
+           Make_Procedure_Call_Statement (Loc,
+             Name => New_Reference_To (Postcondition_Proc (Scope_Id), Loc)));
+      end if;
+
+      --  If it is a return from a procedure do no extra steps
+
+      if Kind = E_Procedure or else Kind = E_Generic_Procedure then
+         return;
+
+      --  If it is a nested return within an extended one, replace it with a
+      --  return of the previously declared return object.
+
+      elsif Kind = E_Return_Statement then
+         Rewrite (N,
+           Make_Simple_Return_Statement (Loc,
+             Expression =>
+               New_Occurrence_Of (First_Entity (Scope_Id), Loc)));
+         Set_Comes_From_Extended_Return_Statement (N);
+         Set_Return_Statement_Entity (N, Scope_Id);
+         Expand_Simple_Function_Return (N);
+         return;
+      end if;
+
+      pragma Assert (Is_Entry (Scope_Id));
+
+      --  Look at the enclosing block to see whether the return is from an
+      --  accept statement or an entry body.
+
+      for J in reverse 0 .. Scope_Stack.Last loop
+         Scope_Id := Scope_Stack.Table (J).Entity;
+         exit when Is_Concurrent_Type (Scope_Id);
+      end loop;
+
+      --  If it is a return from accept statement it is expanded as call to
+      --  RTS Complete_Rendezvous and a goto to the end of the accept body.
+
+      --  (cf : Expand_N_Accept_Statement, Expand_N_Selective_Accept,
+      --  Expand_N_Accept_Alternative in exp_ch9.adb)
+
+      if Is_Task_Type (Scope_Id) then
+
+         Call :=
+           Make_Procedure_Call_Statement (Loc,
+             Name => New_Reference_To (RTE (RE_Complete_Rendezvous), Loc));
+         Insert_Before (N, Call);
+         --  why not insert actions here???
+         Analyze (Call);
+
+         Acc_Stat := Parent (N);
+         while Nkind (Acc_Stat) /= N_Accept_Statement loop
+            Acc_Stat := Parent (Acc_Stat);
+         end loop;
+
+         Lab_Node := Last (Statements
+           (Handled_Statement_Sequence (Acc_Stat)));
+
+         Goto_Stat := Make_Goto_Statement (Loc,
+           Name => New_Occurrence_Of
+             (Entity (Identifier (Lab_Node)), Loc));
+
+         Set_Analyzed (Goto_Stat);
+
+         Rewrite (N, Goto_Stat);
+         Analyze (N);
+
+      --  If it is a return from an entry body, put a Complete_Entry_Body call
+      --  in front of the return.
+
+      elsif Is_Protected_Type (Scope_Id) then
+         Call :=
+           Make_Procedure_Call_Statement (Loc,
+             Name =>
+               New_Reference_To (RTE (RE_Complete_Entry_Body), Loc),
+             Parameter_Associations => New_List (
+               Make_Attribute_Reference (Loc,
+                 Prefix =>
+                   New_Reference_To
+                     (Find_Protection_Object (Current_Scope), Loc),
+                 Attribute_Name =>
+                   Name_Unchecked_Access)));
+
+         Insert_Before (N, Call);
+         Analyze (Call);
+      end if;
+   end Expand_Non_Function_Return;
+
    ---------------------------------------
    -- Expand_Protected_Object_Reference --
    ---------------------------------------
@@ -4789,6 +5677,608 @@ package body Exp_Ch6 is
       end if;
    end Expand_Protected_Subprogram_Call;
 
+   -----------------------------------
+   -- Expand_Simple_Function_Return --
+   -----------------------------------
+
+   --  The "simple" comes from the syntax rule simple_return_statement.
+   --  The semantics are not at all simple!
+
+   procedure Expand_Simple_Function_Return (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+
+      Scope_Id : constant Entity_Id :=
+                   Return_Applies_To (Return_Statement_Entity (N));
+      --  The function we are returning from
+
+      R_Type : constant Entity_Id := Etype (Scope_Id);
+      --  The result type of the function
+
+      Utyp : constant Entity_Id := Underlying_Type (R_Type);
+
+      Exp : constant Node_Id := Expression (N);
+      pragma Assert (Present (Exp));
+
+      Exptyp : constant Entity_Id := Etype (Exp);
+      --  The type of the expression (not necessarily the same as R_Type)
+
+      Subtype_Ind : Node_Id;
+      --  If the result type of the function is class-wide and the
+      --  expression has a specific type, then we use the expression's
+      --  type as the type of the return object. In cases where the
+      --  expression is an aggregate that is built in place, this avoids
+      --  the need for an expensive conversion of the return object to
+      --  the specific type on assignments to the individual components.
+
+   begin
+      if Is_Class_Wide_Type (R_Type)
+        and then not Is_Class_Wide_Type (Etype (Exp))
+      then
+         Subtype_Ind := New_Occurrence_Of (Etype (Exp), Loc);
+      else
+         Subtype_Ind := New_Occurrence_Of (R_Type, Loc);
+      end if;
+
+      --  For the case of a simple return that does not come from an extended
+      --  return, in the case of Ada 2005 where we are returning a limited
+      --  type, we rewrite "return <expression>;" to be:
+
+      --    return _anon_ : <return_subtype> := <expression>
+
+      --  The expansion produced by Expand_N_Extended_Return_Statement will
+      --  contain simple return statements (for example, a block containing
+      --  simple return of the return object), which brings us back here with
+      --  Comes_From_Extended_Return_Statement set. The reason for the barrier
+      --  checking for a simple return that does not come from an extended
+      --  return is to avoid this infinite recursion.
+
+      --  The reason for this design is that for Ada 2005 limited returns, we
+      --  need to reify the return object, so we can build it "in place", and
+      --  we need a block statement to hang finalization and tasking stuff.
+
+      --  ??? In order to avoid disruption, we avoid translating to extended
+      --  return except in the cases where we really need to (Ada 2005 for
+      --  inherently limited). We might prefer to do this translation in all
+      --  cases (except perhaps for the case of Ada 95 inherently limited),
+      --  in order to fully exercise the Expand_N_Extended_Return_Statement
+      --  code. This would also allow us to do the build-in-place optimization
+      --  for efficiency even in cases where it is semantically not required.
+
+      --  As before, we check the type of the return expression rather than the
+      --  return type of the function, because the latter may be a limited
+      --  class-wide interface type, which is not a limited type, even though
+      --  the type of the expression may be.
+
+      if not Comes_From_Extended_Return_Statement (N)
+        and then Is_Immutably_Limited_Type (Etype (Expression (N)))
+        and then Ada_Version >= Ada_05
+        and then not Debug_Flag_Dot_L
+      then
+         declare
+            Return_Object_Entity : constant Entity_Id :=
+                                     Make_Temporary (Loc, 'R', Exp);
+            Obj_Decl : constant Node_Id :=
+                         Make_Object_Declaration (Loc,
+                           Defining_Identifier => Return_Object_Entity,
+                           Object_Definition   => Subtype_Ind,
+                           Expression          => Exp);
+
+            Ext : constant Node_Id := Make_Extended_Return_Statement (Loc,
+                    Return_Object_Declarations => New_List (Obj_Decl));
+            --  Do not perform this high-level optimization if the result type
+            --  is an interface because the "this" pointer must be displaced.
+
+         begin
+            Rewrite (N, Ext);
+            Analyze (N);
+            return;
+         end;
+      end if;
+
+      --  Here we have a simple return statement that is part of the expansion
+      --  of an extended return statement (either written by the user, or
+      --  generated by the above code).
+
+      --  Always normalize C/Fortran boolean result. This is not always needed,
+      --  but it seems a good idea to minimize the passing around of non-
+      --  normalized values, and in any case this handles the processing of
+      --  barrier functions for protected types, which turn the condition into
+      --  a return statement.
+
+      if Is_Boolean_Type (Exptyp)
+        and then Nonzero_Is_True (Exptyp)
+      then
+         Adjust_Condition (Exp);
+         Adjust_Result_Type (Exp, Exptyp);
+      end if;
+
+      --  Do validity check if enabled for returns
+
+      if Validity_Checks_On
+        and then Validity_Check_Returns
+      then
+         Ensure_Valid (Exp);
+      end if;
+
+      --  Check the result expression of a scalar function against the subtype
+      --  of the function by inserting a conversion. This conversion must
+      --  eventually be performed for other classes of types, but for now it's
+      --  only done for scalars.
+      --  ???
+
+      if Is_Scalar_Type (Exptyp) then
+         Rewrite (Exp, Convert_To (R_Type, Exp));
+
+         --  The expression is resolved to ensure that the conversion gets
+         --  expanded to generate a possible constraint check.
+
+         Analyze_And_Resolve (Exp, R_Type);
+      end if;
+
+      --  Deal with returning variable length objects and controlled types
+
+      --  Nothing to do if we are returning by reference, or this is not a
+      --  type that requires special processing (indicated by the fact that
+      --  it requires a cleanup scope for the secondary stack case).
+
+      if Is_Immutably_Limited_Type (Exptyp)
+        or else Is_Limited_Interface (Exptyp)
+      then
+         null;
+
+      elsif not Requires_Transient_Scope (R_Type) then
+
+         --  Mutable records with no variable length components are not
+         --  returned on the sec-stack, so we need to make sure that the
+         --  backend will only copy back the size of the actual value, and not
+         --  the maximum size. We create an actual subtype for this purpose.
+
+         declare
+            Ubt  : constant Entity_Id := Underlying_Type (Base_Type (Exptyp));
+            Decl : Node_Id;
+            Ent  : Entity_Id;
+         begin
+            if Has_Discriminants (Ubt)
+              and then not Is_Constrained (Ubt)
+              and then not Has_Unchecked_Union (Ubt)
+            then
+               Decl := Build_Actual_Subtype (Ubt, Exp);
+               Ent := Defining_Identifier (Decl);
+               Insert_Action (Exp, Decl);
+               Rewrite (Exp, Unchecked_Convert_To (Ent, Exp));
+               Analyze_And_Resolve (Exp);
+            end if;
+         end;
+
+      --  Here if secondary stack is used
+
+      else
+         --  Make sure that no surrounding block will reclaim the secondary
+         --  stack on which we are going to put the result. Not only may this
+         --  introduce secondary stack leaks but worse, if the reclamation is
+         --  done too early, then the result we are returning may get
+         --  clobbered.
+
+         declare
+            S : Entity_Id;
+         begin
+            S := Current_Scope;
+            while Ekind (S) = E_Block or else Ekind (S) = E_Loop loop
+               Set_Sec_Stack_Needed_For_Return (S, True);
+               S := Enclosing_Dynamic_Scope (S);
+            end loop;
+         end;
+
+         --  Optimize the case where the result is a function call. In this
+         --  case either the result is already on the secondary stack, or is
+         --  already being returned with the stack pointer depressed and no
+         --  further processing is required except to set the By_Ref flag to
+         --  ensure that gigi does not attempt an extra unnecessary copy.
+         --  (actually not just unnecessary but harmfully wrong in the case
+         --  of a controlled type, where gigi does not know how to do a copy).
+         --  To make up for a gcc 2.8.1 deficiency (???), we perform
+         --  the copy for array types if the constrained status of the
+         --  target type is different from that of the expression.
+
+         if Requires_Transient_Scope (Exptyp)
+           and then
+              (not Is_Array_Type (Exptyp)
+                or else Is_Constrained (Exptyp) = Is_Constrained (R_Type)
+                or else CW_Or_Has_Controlled_Part (Utyp))
+           and then Nkind (Exp) = N_Function_Call
+         then
+            Set_By_Ref (N);
+
+            --  Remove side effects from the expression now so that other parts
+            --  of the expander do not have to reanalyze this node without this
+            --  optimization
+
+            Rewrite (Exp, Duplicate_Subexpr_No_Checks (Exp));
+
+         --  For controlled types, do the allocation on the secondary stack
+         --  manually in order to call adjust at the right time:
+
+         --    type Anon1 is access R_Type;
+         --    for Anon1'Storage_pool use ss_pool;
+         --    Anon2 : anon1 := new R_Type'(expr);
+         --    return Anon2.all;
+
+         --  We do the same for classwide types that are not potentially
+         --  controlled (by the virtue of restriction No_Finalization) because
+         --  gigi is not able to properly allocate class-wide types.
+
+         elsif CW_Or_Has_Controlled_Part (Utyp) then
+            declare
+               Loc        : constant Source_Ptr := Sloc (N);
+               Acc_Typ    : constant Entity_Id := Make_Temporary (Loc, 'A');
+               Alloc_Node : Node_Id;
+               Temp       : Entity_Id;
+
+            begin
+               Set_Ekind (Acc_Typ, E_Access_Type);
+
+               Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_SS_Pool));
+
+               --  This is an allocator for the secondary stack, and it's fine
+               --  to have Comes_From_Source set False on it, as gigi knows not
+               --  to flag it as a violation of No_Implicit_Heap_Allocations.
+
+               Alloc_Node :=
+                 Make_Allocator (Loc,
+                   Expression =>
+                     Make_Qualified_Expression (Loc,
+                       Subtype_Mark => New_Reference_To (Etype (Exp), Loc),
+                       Expression   => Relocate_Node (Exp)));
+
+               --  We do not want discriminant checks on the declaration,
+               --  given that it gets its value from the allocator.
+
+               Set_No_Initialization (Alloc_Node);
+
+               Temp := Make_Temporary (Loc, 'R', Alloc_Node);
+
+               Insert_List_Before_And_Analyze (N, New_List (
+                 Make_Full_Type_Declaration (Loc,
+                   Defining_Identifier => Acc_Typ,
+                   Type_Definition     =>
+                     Make_Access_To_Object_Definition (Loc,
+                       Subtype_Indication => Subtype_Ind)),
+
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => Temp,
+                   Object_Definition   => New_Reference_To (Acc_Typ, Loc),
+                   Expression          => Alloc_Node)));
+
+               Rewrite (Exp,
+                 Make_Explicit_Dereference (Loc,
+                 Prefix => New_Reference_To (Temp, Loc)));
+
+               Analyze_And_Resolve (Exp, R_Type);
+            end;
+
+         --  Otherwise use the gigi mechanism to allocate result on the
+         --  secondary stack.
+
+         else
+            Check_Restriction (No_Secondary_Stack, N);
+            Set_Storage_Pool (N, RTE (RE_SS_Pool));
+
+            --  If we are generating code for the VM do not use
+            --  SS_Allocate since everything is heap-allocated anyway.
+
+            if VM_Target = No_VM then
+               Set_Procedure_To_Call (N, RTE (RE_SS_Allocate));
+            end if;
+         end if;
+      end if;
+
+      --  Implement the rules of 6.5(8-10), which require a tag check in the
+      --  case of a limited tagged return type, and tag reassignment for
+      --  nonlimited tagged results. These actions are needed when the return
+      --  type is a specific tagged type and the result expression is a
+      --  conversion or a formal parameter, because in that case the tag of the
+      --  expression might differ from the tag of the specific result type.
+
+      if Is_Tagged_Type (Utyp)
+        and then not Is_Class_Wide_Type (Utyp)
+        and then (Nkind_In (Exp, N_Type_Conversion,
+                                 N_Unchecked_Type_Conversion)
+                    or else (Is_Entity_Name (Exp)
+                               and then Ekind (Entity (Exp)) in Formal_Kind))
+      then
+         --  When the return type is limited, perform a check that the
+         --  tag of the result is the same as the tag of the return type.
+
+         if Is_Limited_Type (R_Type) then
+            Insert_Action (Exp,
+              Make_Raise_Constraint_Error (Loc,
+                Condition =>
+                  Make_Op_Ne (Loc,
+                    Left_Opnd =>
+                      Make_Selected_Component (Loc,
+                        Prefix => Duplicate_Subexpr (Exp),
+                        Selector_Name =>
+                          Make_Identifier (Loc, Chars => Name_uTag)),
+                    Right_Opnd =>
+                      Make_Attribute_Reference (Loc,
+                        Prefix => New_Occurrence_Of (Base_Type (Utyp), Loc),
+                        Attribute_Name => Name_Tag)),
+                Reason => CE_Tag_Check_Failed));
+
+         --  If the result type is a specific nonlimited tagged type, then we
+         --  have to ensure that the tag of the result is that of the result
+         --  type. This is handled by making a copy of the expression in the
+         --  case where it might have a different tag, namely when the
+         --  expression is a conversion or a formal parameter. We create a new
+         --  object of the result type and initialize it from the expression,
+         --  which will implicitly force the tag to be set appropriately.
+
+         else
+            declare
+               ExpR       : constant Node_Id   := Relocate_Node (Exp);
+               Result_Id  : constant Entity_Id :=
+                              Make_Temporary (Loc, 'R', ExpR);
+               Result_Exp : constant Node_Id   :=
+                              New_Reference_To (Result_Id, Loc);
+               Result_Obj : constant Node_Id   :=
+                              Make_Object_Declaration (Loc,
+                                Defining_Identifier => Result_Id,
+                                Object_Definition   =>
+                                  New_Reference_To (R_Type, Loc),
+                                Constant_Present    => True,
+                                Expression          => ExpR);
+
+            begin
+               Set_Assignment_OK (Result_Obj);
+               Insert_Action (Exp, Result_Obj);
+
+               Rewrite (Exp, Result_Exp);
+               Analyze_And_Resolve (Exp, R_Type);
+            end;
+         end if;
+
+      --  Ada 2005 (AI-344): If the result type is class-wide, then insert
+      --  a check that the level of the return expression's underlying type
+      --  is not deeper than the level of the master enclosing the function.
+      --  Always generate the check when the type of the return expression
+      --  is class-wide, when it's a type conversion, or when it's a formal
+      --  parameter. Otherwise, suppress the check in the case where the
+      --  return expression has a specific type whose level is known not to
+      --  be statically deeper than the function's result type.
+
+      --  Note: accessibility check is skipped in the VM case, since there
+      --  does not seem to be any practical way to implement this check.
+
+      elsif Ada_Version >= Ada_05
+        and then Tagged_Type_Expansion
+        and then Is_Class_Wide_Type (R_Type)
+        and then not Scope_Suppress (Accessibility_Check)
+        and then
+          (Is_Class_Wide_Type (Etype (Exp))
+            or else Nkind_In (Exp, N_Type_Conversion,
+                                   N_Unchecked_Type_Conversion)
+            or else (Is_Entity_Name (Exp)
+                       and then Ekind (Entity (Exp)) in Formal_Kind)
+            or else Scope_Depth (Enclosing_Dynamic_Scope (Etype (Exp))) >
+                      Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))
+      then
+         declare
+            Tag_Node : Node_Id;
+
+         begin
+            --  Ada 2005 (AI-251): In class-wide interface objects we displace
+            --  "this" to reference the base of the object --- required to get
+            --  access to the TSD of the object.
+
+            if Is_Class_Wide_Type (Etype (Exp))
+              and then Is_Interface (Etype (Exp))
+              and then Nkind (Exp) = N_Explicit_Dereference
+            then
+               Tag_Node :=
+                 Make_Explicit_Dereference (Loc,
+                   Unchecked_Convert_To (RTE (RE_Tag_Ptr),
+                     Make_Function_Call (Loc,
+                       Name => New_Reference_To (RTE (RE_Base_Address), Loc),
+                       Parameter_Associations => New_List (
+                         Unchecked_Convert_To (RTE (RE_Address),
+                           Duplicate_Subexpr (Prefix (Exp)))))));
+            else
+               Tag_Node :=
+                 Make_Attribute_Reference (Loc,
+                   Prefix => Duplicate_Subexpr (Exp),
+                   Attribute_Name => Name_Tag);
+            end if;
+
+            Insert_Action (Exp,
+              Make_Raise_Program_Error (Loc,
+                Condition =>
+                  Make_Op_Gt (Loc,
+                    Left_Opnd =>
+                      Build_Get_Access_Level (Loc, Tag_Node),
+                    Right_Opnd =>
+                      Make_Integer_Literal (Loc,
+                        Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))),
+                Reason => PE_Accessibility_Check_Failed));
+         end;
+
+      --  AI05-0073: If function has a controlling access result, check that
+      --  the tag of the return value, if it is not null, matches designated
+      --  type of return type.
+      --  The return expression is referenced twice in the code below, so
+      --  it must be made free of side effects. Given that different compilers
+      --  may evaluate these parameters in different order, both occurrences
+      --  perform a copy.
+
+      elsif Ekind (R_Type) = E_Anonymous_Access_Type
+        and then Has_Controlling_Result (Scope_Id)
+      then
+         Insert_Action (N,
+           Make_Raise_Constraint_Error (Loc,
+             Condition =>
+               Make_And_Then (Loc,
+                 Left_Opnd  =>
+                   Make_Op_Ne (Loc,
+                     Left_Opnd  => Duplicate_Subexpr (Exp),
+                     Right_Opnd => Make_Null (Loc)),
+                 Right_Opnd => Make_Op_Ne (Loc,
+                   Left_Opnd  =>
+                     Make_Selected_Component (Loc,
+                       Prefix        => Duplicate_Subexpr (Exp),
+                       Selector_Name =>
+                         Make_Identifier (Loc, Chars => Name_uTag)),
+                   Right_Opnd =>
+                     Make_Attribute_Reference (Loc,
+                       Prefix         =>
+                         New_Occurrence_Of (Designated_Type (R_Type), Loc),
+                       Attribute_Name => Name_Tag))),
+             Reason    => CE_Tag_Check_Failed),
+             Suppress  => All_Checks);
+      end if;
+
+      --  If we are returning an object that may not be bit-aligned, then copy
+      --  the value into a temporary first. This copy may need to expand to a
+      --  loop of component operations.
+
+      if Is_Possibly_Unaligned_Slice (Exp)
+        or else Is_Possibly_Unaligned_Object (Exp)
+      then
+         declare
+            ExpR : constant Node_Id   := Relocate_Node (Exp);
+            Tnn  : constant Entity_Id := Make_Temporary (Loc, 'T', ExpR);
+         begin
+            Insert_Action (Exp,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Tnn,
+                Constant_Present    => True,
+                Object_Definition   => New_Occurrence_Of (R_Type, Loc),
+                Expression          => ExpR),
+              Suppress            => All_Checks);
+            Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
+         end;
+      end if;
+
+      --  Generate call to postcondition checks if they are present
+
+      if Ekind (Scope_Id) = E_Function
+        and then Has_Postconditions (Scope_Id)
+      then
+         --  We are going to reference the returned value twice in this case,
+         --  once in the call to _Postconditions, and once in the actual return
+         --  statement, but we can't have side effects happening twice, and in
+         --  any case for efficiency we don't want to do the computation twice.
+
+         --  If the returned expression is an entity name, we don't need to
+         --  worry since it is efficient and safe to reference it twice, that's
+         --  also true for literals other than string literals, and for the
+         --  case of X.all where X is an entity name.
+
+         if Is_Entity_Name (Exp)
+           or else Nkind_In (Exp, N_Character_Literal,
+                                  N_Integer_Literal,
+                                  N_Real_Literal)
+           or else (Nkind (Exp) = N_Explicit_Dereference
+                      and then Is_Entity_Name (Prefix (Exp)))
+         then
+            null;
+
+         --  Otherwise we are going to need a temporary to capture the value
+
+         else
+            declare
+               ExpR : constant Node_Id   := Relocate_Node (Exp);
+               Tnn  : constant Entity_Id := Make_Temporary (Loc, 'T', ExpR);
+
+            begin
+               --  For a complex expression of an elementary type, capture
+               --  value in the temporary and use it as the reference.
+
+               if Is_Elementary_Type (R_Type) then
+                  Insert_Action (Exp,
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Tnn,
+                      Constant_Present    => True,
+                      Object_Definition   => New_Occurrence_Of (R_Type, Loc),
+                      Expression          => ExpR),
+                    Suppress => All_Checks);
+
+                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
+
+               --  If we have something we can rename, generate a renaming of
+               --  the object and replace the expression with a reference
+
+               elsif Is_Object_Reference (Exp) then
+                  Insert_Action (Exp,
+                    Make_Object_Renaming_Declaration (Loc,
+                      Defining_Identifier => Tnn,
+                      Subtype_Mark        => New_Occurrence_Of (R_Type, Loc),
+                      Name                => ExpR),
+                    Suppress => All_Checks);
+
+                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
+
+               --  Otherwise we have something like a string literal or an
+               --  aggregate. We could copy the value, but that would be
+               --  inefficient. Instead we make a reference to the value and
+               --  capture this reference with a renaming, the expression is
+               --  then replaced by a dereference of this renaming.
+
+               else
+                  --  For now, copy the value, since the code below does not
+                  --  seem to work correctly ???
+
+                  Insert_Action (Exp,
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Tnn,
+                      Constant_Present    => True,
+                      Object_Definition   => New_Occurrence_Of (R_Type, Loc),
+                      Expression          => Relocate_Node (Exp)),
+                    Suppress => All_Checks);
+
+                  Rewrite (Exp, New_Occurrence_Of (Tnn, Loc));
+
+                  --  Insert_Action (Exp,
+                  --    Make_Object_Renaming_Declaration (Loc,
+                  --      Defining_Identifier => Tnn,
+                  --      Access_Definition =>
+                  --        Make_Access_Definition (Loc,
+                  --          All_Present  => True,
+                  --          Subtype_Mark => New_Occurrence_Of (R_Type, Loc)),
+                  --      Name =>
+                  --        Make_Reference (Loc,
+                  --          Prefix => Relocate_Node (Exp))),
+                  --    Suppress => All_Checks);
+
+                  --  Rewrite (Exp,
+                  --    Make_Explicit_Dereference (Loc,
+                  --      Prefix => New_Occurrence_Of (Tnn, Loc)));
+               end if;
+            end;
+         end if;
+
+         --  Generate call to _postconditions
+
+         Insert_Action (Exp,
+           Make_Procedure_Call_Statement (Loc,
+             Name => Make_Identifier (Loc, Name_uPostconditions),
+             Parameter_Associations => New_List (Duplicate_Subexpr (Exp))));
+      end if;
+
+      --  Ada 2005 (AI-251): If this return statement corresponds with an
+      --  simple return statement associated with an extended return statement
+      --  and the type of the returned object is an interface then generate an
+      --  implicit conversion to force displacement of the "this" pointer.
+
+      if Ada_Version >= Ada_05
+        and then Comes_From_Extended_Return_Statement (N)
+        and then Nkind (Expression (N)) = N_Identifier
+        and then Is_Interface (Utyp)
+        and then Utyp /= Underlying_Type (Exptyp)
+      then
+         Rewrite (Exp, Convert_To (Utyp, Relocate_Node (Exp)));
+         Analyze_And_Resolve (Exp);
+      end if;
+   end Expand_Simple_Function_Return;
+
    --------------------------------
    -- Is_Build_In_Place_Function --
    --------------------------------
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index 242995f490d..e04e217e80e 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -29,11 +29,13 @@ with Types; use Types;
 
 package Exp_Ch6 is
 
-   procedure Expand_N_Function_Call            (N : Node_Id);
-   procedure Expand_N_Subprogram_Body          (N : Node_Id);
-   procedure Expand_N_Subprogram_Body_Stub     (N : Node_Id);
-   procedure Expand_N_Subprogram_Declaration   (N : Node_Id);
-   procedure Expand_N_Procedure_Call_Statement (N : Node_Id);
+   procedure Expand_N_Extended_Return_Statement (N : Node_Id);
+   procedure Expand_N_Function_Call             (N : Node_Id);
+   procedure Expand_N_Procedure_Call_Statement  (N : Node_Id);
+   procedure Expand_N_Simple_Return_Statement   (N : Node_Id);
+   procedure Expand_N_Subprogram_Body           (N : Node_Id);
+   procedure Expand_N_Subprogram_Body_Stub      (N : Node_Id);
+   procedure Expand_N_Subprogram_Declaration    (N : Node_Id);
 
    procedure Expand_Call (N : Node_Id);
    --  This procedure contains common processing for Expand_N_Function_Call,
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index 8e6f458907a..c76e1751408 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -126,6 +126,7 @@ GNAT_ADA_OBJS =	\
  ada/ada.o	\
  ada/ali.o	\
  ada/alloc.o	\
+ ada/aspects.o  \
  ada/atree.o	\
  ada/butil.o	\
  ada/casing.o	\
@@ -1346,15 +1347,24 @@ ada/ali.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
 
 ada/alloc.o : ada/alloc.ads ada/system.ads 
 
+ada/aspects.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
+   ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/aspects.adb \
+   ada/debug.ads ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \
+   ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads \
+   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
+   ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
+   ada/unchdeal.ads
+
 ada/atree.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
    ada/casing.ads ada/debug.ads ada/einfo.ads ada/hostparm.ads \
    ada/namet.ads ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
-   ada/system.ads ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads \
-   ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads \
-   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
-   ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
+   ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
+   ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads \
+   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+   ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
 
 ada/back_end.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
@@ -1498,13 +1508,13 @@ ada/comperr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/nlists.adb ada/opt.ads ada/osint.ads ada/output.ads ada/output.adb \
    ada/rident.ads ada/sdefault.ads ada/sinfo.ads ada/sinfo.adb \
    ada/sinput.ads ada/snames.ads ada/sprint.ads ada/system.ads \
-   ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
-   ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
-   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
-   ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \
-   ada/treepr.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
-   ada/unchdeal.ads ada/urealp.ads 
+   ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
+   ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+   ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+   ada/tree_io.ads ada/treepr.ads ada/types.ads ada/uintp.ads \
+   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
 
 ada/csets.o : ada/ada.ads ada/a-unccon.ads ada/a-uncdea.ads ada/csets.ads \
    ada/csets.adb ada/hostparm.ads ada/opt.ads ada/system.ads \
@@ -1546,11 +1556,11 @@ ada/debug_a.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/einfo.ads ada/hostparm.ads ada/namet.ads ada/nlists.ads \
    ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \
    ada/sinput.ads ada/snames.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
-   ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
-   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
-   ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads 
+   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+   ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
+   ada/unchdeal.ads ada/urealp.ads 
 
 ada/einfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
@@ -1881,32 +1891,32 @@ ada/exp_ch5.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/casing.ads ada/checks.ads ada/checks.adb ada/csets.ads \
    ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
-   ada/exp_aggr.ads ada/exp_atag.ads ada/exp_ch11.ads ada/exp_ch2.ads \
-   ada/exp_ch4.ads ada/exp_ch5.ads ada/exp_ch5.adb ada/exp_ch6.ads \
-   ada/exp_ch7.ads ada/exp_dbug.ads ada/exp_disp.ads ada/exp_pakd.ads \
-   ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
-   ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
-   ada/g-htable.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
-   ada/itypes.ads ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb \
-   ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
-   ada/output.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
-   ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
-   ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads \
-   ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch8.ads \
-   ada/sem_disp.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads \
-   ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
-   ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
-   ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
-   ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
-   ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
-   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
-   ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
-   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
-   ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
-   ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
-   ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
-   ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
-   ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads 
+   ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch4.ads \
+   ada/exp_ch5.ads ada/exp_ch5.adb ada/exp_ch6.ads ada/exp_ch7.ads \
+   ada/exp_dbug.ads ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads \
+   ada/exp_util.ads ada/exp_util.adb ada/fname.ads ada/fname-uf.ads \
+   ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
+   ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
+   ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
+   ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
+   ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
+   ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
+   ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads \
+   ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads \
+   ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \
+   ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
+   ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
+   ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
+   ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \
+   ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
+   ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
+   ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+   ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads \
+   ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
+   ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
+   ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
+   ada/urealp.ads ada/validsw.ads ada/widechar.ads 
 
 ada/exp_ch6.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
@@ -2376,12 +2386,12 @@ ada/expander.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads ada/rtsfind.ads \
    ada/sem.ads ada/sem_ch8.ads ada/sem_util.ads ada/sinfo.ads \
    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/system.ads \
-   ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
-   ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
-   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
-   ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
-   ada/unchdeal.ads ada/urealp.ads 
+   ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \
+   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
+   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
+   ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
+   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
 
 ada/fmap.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/fmap.ads ada/fmap.adb \
@@ -2811,10 +2821,10 @@ ada/nlists.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/casing.ads ada/debug.ads ada/einfo.ads ada/hostparm.ads \
    ada/namet.ads ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
-   ada/system.ads ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads \
-   ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads \
-   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
-   ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
+   ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
+   ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads \
+   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+   ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
 
 ada/nmake.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
@@ -2823,11 +2833,11 @@ ada/nmake.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
    ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
    ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
-   ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
-   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
-   ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads 
+   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+   ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
+   ada/unchdeal.ads ada/urealp.ads 
 
 ada/opt.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
    ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/opt.adb ada/system.ads \
@@ -3190,11 +3200,11 @@ ada/scil_ll.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/namet.ads ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
    ada/scil_ll.ads ada/scil_ll.adb ada/sinfo.ads ada/sinfo.adb \
    ada/sinput.ads ada/snames.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
-   ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
-   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
-   ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads 
+   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+   ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
+   ada/unchdeal.ads ada/urealp.ads 
 
 ada/scn.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
    ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/csets.ads \
@@ -3506,11 +3516,11 @@ ada/sem_ch2.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/restrict.ads ada/rident.ads ada/sem_ch2.ads ada/sem_ch2.adb \
    ada/sem_ch8.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
    ada/snames.ads ada/stand.ads ada/system.ads ada/s-carun8.ads \
-   ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-rident.ads ada/s-stalib.ads ada/s-string.ads \
-   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
-   ada/table.adb ada/tree_io.ads ada/types.ads ada/types.adb ada/uintp.ads \
-   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
+   ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-stalib.ads \
+   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+   ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/types.adb \
+   ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
 
 ada/sem_ch3.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
@@ -4126,11 +4136,11 @@ ada/sinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/g-htable.ads ada/hostparm.ads ada/namet.ads ada/nlists.ads \
    ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \
    ada/sinput.ads ada/snames.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
-   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
-   ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
-   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
+   ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-strhas.ads \
+   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+   ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
+   ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
 
 ada/sinput-c.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/casing.ads ada/debug.ads \
@@ -4163,12 +4173,12 @@ ada/sinput-l.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/sinput-l.ads ada/sinput-l.adb ada/snames.ads ada/stringt.ads \
    ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
    ada/system.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \
-   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
-   ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
-   ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
-   ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
-   ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
-   ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
+   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+   ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+   ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads \
+   ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
+   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
 
 ada/sinput.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
@@ -4176,12 +4186,12 @@ ada/sinput.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/interfac.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
    ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \
    ada/sinput.ads ada/sinput.adb ada/snames.ads ada/system.ads \
-   ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads \
-   ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
-   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
-   ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads ada/widechar.ads 
+   ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads ada/s-stalib.ads \
+   ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
+   ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
 
 ada/snames.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/hostparm.ads \
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index c634b7fb87d..a3eb1da7eea 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -529,8 +529,8 @@ package body Sem_Aggr is
       --  N is an array (sub-)aggregate. Dim is the dimension corresponding
       --  to (sub-)aggregate N. This procedure collects and removes the side
       --  effects of the constrained N_Range nodes corresponding to each index
-      --  dimension of our aggregate itype.
-      --  These N_Range nodes are collected in Aggr_Range above.
+      --  dimension of our aggregate itype. These N_Range nodes are collected
+      --  in Aggr_Range above.
       --
       --  Likewise collect in Aggr_Low & Aggr_High above the low and high
       --  bounds of each index dimension. If, when collecting, two bounds
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index efd8d8e73b0..2379a414054 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -10404,7 +10404,7 @@ package body Sem_Prag is
 
          --  pragma Passive [(PASSIVE_FORM)];
 
-         --   PASSIVE_FORM ::= Semaphore | No
+         --  PASSIVE_FORM ::= Semaphore | No
 
          when Pragma_Passive =>
             GNAT_Pragma;
@@ -10475,6 +10475,8 @@ package body Sem_Prag is
          -- Persistent_BSS --
          --------------------
 
+         --  pragma Persistent_BSS [(object_NAME)];
+
          when Pragma_Persistent_BSS => Persistent_BSS :  declare
             Decl : Node_Id;
             Ent  : Entity_Id;
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 0c94966961e..ad43f3a0e43 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -134,6 +134,14 @@ package Snames is
    Name_Space                          : constant Name_Id := N + $;
    Name_Time                           : constant Name_Id := N + $;
 
+   --  Names of aspects for which there are no matching pragmas or attributes
+   --  so that they need to be included for aspect specification use.
+
+   Name_Invariant                      : constant Name_Id := N + $;
+   Name_Post                           : constant Name_Id := N + $;
+   Name_Pre                            : constant Name_Id := N + $;
+   Name_Predicate                      : constant Name_Id := N + $;
+
    --  Some special names used by the expander. Note that the lower case u's
    --  at the start of these names get translated to extra underscores. These
    --  names are only referenced internally by expander generated code.
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 816750c6c19..c35ef0df039 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -801,7 +801,6 @@ package body Sprint is
       --  Select print circuit based on node kind
 
       case Nkind (Node) is
-
          when N_Abort_Statement =>
             Write_Indent_Str_Sloc ("abort ");
             Sprint_Comma_List (Names (Node));
@@ -3091,7 +3090,6 @@ package body Sprint is
                   Write_Char (';');
                end if;
             end if;
-
       end case;
 
       if Nkind (Node) in N_Subexpr