[multiple changes]

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.

From-SVN: r165281

1 files changed, 0 insertions, 1488 deletions

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index a28c5ab..6ca2c8c 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 --
    ------------------------------