Index: debug.adb
===================================================================
--- debug.adb	(revision 247293)
+++ debug.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -109,7 +109,7 @@
    --  d.p  Use original Ada 95 semantics for Bit_Order (disable AI95-0133)
    --  d.q  Suppress optimizations on imported 'in'
    --  d.r  Enable OK_To_Reorder_Components in non-variant records
-   --  d.s
+   --  d.s  Minimize secondary stack Mark and Release calls
    --  d.t  Disable static allocation of library level dispatch tables
    --  d.u  Enable Modify_Tree_For_C (update tree for c)
    --  d.v  Enable OK_To_Reorder_Components in variant records
@@ -572,6 +572,11 @@
    --  d.r  Forces the flag OK_To_Reorder_Components to be set in all record
    --       base types that have no discriminants.
 
+   --  d.s  The compiler does not generate calls to secondary stack management
+   --       routines SS_Mark and SS_Release for a transient block when there is
+   --       an enclosing scoping construct which already manages the secondary
+   --       stack.
+
    --  d.t  The compiler has been modified (a fairly extensive modification)
    --       to generate static dispatch tables for library level tagged types.
    --       This debug switch disables this modification and reverts to the
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 247293)
+++ einfo.ads	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -4163,10 +4163,10 @@
 --       needed, since returns an invalid value in this case.
 
 --    Sec_Stack_Needed_For_Return (Flag167)
---       Defined in scope entities (blocks, functions, procedures, tasks,
---       entries). Set to True when secondary stack is used to hold the
---       returned value of a function and thus should not be released on
---       scope exit.
+--       Defined in scope entities (blocks, entries, entry families, functions,
+--       and procedures). Set to True when secondary stack is used to hold the
+--       returned value of a function and thus should not be released on scope
+--       exit.
 
 --    Shadow_Entities (List14)
 --       Defined in package and generic package entities. Points to a list
@@ -4522,9 +4522,10 @@
 --       Protection object (see System.Tasking.Protected_Objects).
 
 --    Uses_Sec_Stack (Flag95)
---       Defined in scope entities (block, entry, function, loop, procedure,
---       task). Set to True when secondary stack is used in this scope and must
---       be released on exit unless Sec_Stack_Needed_For_Return is set.
+--       Defined in scope entities (blocks, entries, entry families, functions,
+--       loops, and procedures). Set to True when the secondary stack is used
+--       in this scope and must be released on exit unless flag
+--       Sec_Stack_Needed_For_Return is set.
 
 --    Validated_Object (Node36)
 --       Defined in variables. Contains the object whose value is captured by
@@ -6442,11 +6443,9 @@
    --    SPARK_Pragma                        (Node40)
    --    SPARK_Aux_Pragma                    (Node41)
    --    Ignore_SPARK_Mode_Pragmas           (Flag301)
-   --    Sec_Stack_Needed_For_Return         (Flag167)  ???
    --    SPARK_Aux_Pragma_Inherited          (Flag266)
    --    SPARK_Pragma_Inherited              (Flag265)
    --    Uses_Lock_Free                      (Flag188)
-   --    Uses_Sec_Stack                      (Flag95)   ???
    --    First_Component                     (synth)
    --    First_Component_Or_Discriminant     (synth)
    --    Has_Entries                         (synth)
@@ -6597,10 +6596,8 @@
    --    Has_Master_Entity                   (Flag21)
    --    Has_Storage_Size_Clause             (Flag23)   (base type only)
    --    Ignore_SPARK_Mode_Pragmas           (Flag301)
-   --    Sec_Stack_Needed_For_Return         (Flag167)  ???
    --    SPARK_Aux_Pragma_Inherited          (Flag266)
    --    SPARK_Pragma_Inherited              (Flag265)
-   --    Uses_Sec_Stack                      (Flag95)   ???
    --    First_Component                     (synth)
    --    First_Component_Or_Discriminant     (synth)
    --    Has_Entries                         (synth)
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 247293)
+++ exp_ch7.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -8266,83 +8266,115 @@
       Action : Node_Id;
       Par    : Node_Id) return Node_Id
    is
-      Decls  : constant List_Id := New_List;
-      Instrs : constant List_Id := New_List (Action);
+      function Manages_Sec_Stack (Id : Entity_Id) return Boolean;
+      --  Determine whether scoping entity Id manages the secondary stack
+
+      -----------------------
+      -- Manages_Sec_Stack --
+      -----------------------
+
+      function Manages_Sec_Stack (Id : Entity_Id) return Boolean is
+      begin
+         --  An exception handler with a choice parameter utilizes a dummy
+         --  block to provide a declarative region. Such a block should not be
+         --  considered because it never manifests in the tree and can never
+         --  release the secondary stack.
+
+         if Ekind (Id) = E_Block
+           and then Uses_Sec_Stack (Id)
+           and then not Is_Exception_Handler (Id)
+         then
+            return True;
+
+         --  Loops are intentionally excluded because they undergo special
+         --  treatment, see Establish_Transient_Scope.
+
+         elsif Ekind_In (Id, E_Entry,
+                             E_Entry_Family,
+                             E_Function,
+                             E_Procedure)
+           and then Uses_Sec_Stack (Id)
+         then
+            return True;
+
+         else
+            return False;
+         end if;
+      end Manages_Sec_Stack;
+
+      --  Local variables
+
+      Decls    : constant List_Id   := New_List;
+      Instrs   : constant List_Id   := New_List (Action);
+      Trans_Id : constant Entity_Id := Current_Scope;
+
       Block  : Node_Id;
       Insert : Node_Id;
+      Scop   : Entity_Id;
 
+   --  Start of processing for Make_Transient_Block
+
    begin
-      --  Case where only secondary stack use is involved
+      --  Even though the transient block is tasked with managing the secondary
+      --  stack, the block may forgo this functionality depending on how the
+      --  secondary stack is managed by enclosing scopes.
 
-      if Uses_Sec_Stack (Current_Scope)
-        and then Nkind (Action) /= N_Simple_Return_Statement
-        and then Nkind (Par) /= N_Exception_Handler
-      then
-         declare
-            S : Entity_Id;
+      if Manages_Sec_Stack (Trans_Id) then
 
-         begin
-            S := Scope (Current_Scope);
-            loop
-               --  At the outer level, no need to release the sec stack
+         --  Determine whether an enclosing scope already manages the secondary
+         --  stack.
 
-               if S = Standard_Standard then
-                  Set_Uses_Sec_Stack (Current_Scope, False);
-                  exit;
+         Scop := Scope (Trans_Id);
+         while Present (Scop) loop
+            if Scop = Standard_Standard then
+               exit;
 
-               --  In a function, only release the sec stack if the function
-               --  does not return on the sec stack otherwise the result may
-               --  be lost. The caller is responsible for releasing.
+            --  The transient block must manage the secondary stack when the
+            --  block appears within a loop in order to reclaim the memory at
+            --  each iteration.
 
-               elsif Ekind (S) = E_Function then
-                  Set_Uses_Sec_Stack (Current_Scope, False);
+            elsif Ekind (Scop) = E_Loop then
+               exit;
 
-                  if not Requires_Transient_Scope (Etype (S)) then
-                     Set_Uses_Sec_Stack (S, True);
-                     Check_Restriction (No_Secondary_Stack, Action);
-                  end if;
+            --  The transient block is within a function which returns on the
+            --  secondary stack. Take a conservative approach and assume that
+            --  the value on the secondary stack is part of the result. Note
+            --  that it is not possible to detect this dependency without flow
+            --  analysis which the compiler does not have. Letting the object
+            --  live longer than the transient block will not leak any memory
+            --  because the caller will reclaim the total storage used by the
+            --  function.
 
-                  exit;
+            elsif Ekind (Scop) = E_Function
+              and then Sec_Stack_Needed_For_Return (Scop)
+            then
+               Set_Uses_Sec_Stack (Trans_Id, False);
+               exit;
 
-               --  In a loop or entry we should install a block encompassing
-               --  all the construct. For now just release right away.
+            --  When requested, the transient block does not need to manage the
+            --  secondary stack when there exists an enclosing block, entry,
+            --  entry family, function, or a procedure which already does that.
+            --  This optimization saves on SS_Mark and SS_Release calls but may
+            --  allow objects to live a little longer than required.
 
-               elsif Ekind_In (S, E_Entry, E_Loop) then
-                  exit;
+            elsif Debug_Flag_Dot_S and then Manages_Sec_Stack (Scop) then
+               Set_Uses_Sec_Stack (Trans_Id, False);
+               exit;
+            end if;
 
-               --  In a procedure or a block, release the sec stack on exit
-               --  from the construct. Note that an exception handler with a
-               --  choice parameter requires a declarative region in the form
-               --  of a block. The block does not physically manifest in the
-               --  tree as it only serves as a scope. Do not consider such a
-               --  block because it will never release the sec stack.
-
-               --  ??? Memory leak can be created by recursive calls
-
-               elsif Ekind (S) = E_Procedure
-                 or else (Ekind (S) = E_Block
-                           and then not Is_Exception_Handler (S))
-               then
-                  Set_Uses_Sec_Stack (Current_Scope, False);
-                  Set_Uses_Sec_Stack (S, True);
-                  Check_Restriction (No_Secondary_Stack, Action);
-                  exit;
-
-               else
-                  S := Scope (S);
-               end if;
-            end loop;
-         end;
+            Scop := Scope (Scop);
+         end loop;
       end if;
 
       --  Create the transient block. Set the parent now since the block itself
-      --  is not part of the tree. The current scope is the E_Block entity
-      --  that has been pushed by Establish_Transient_Scope.
+      --  is not part of the tree. The current scope is the E_Block entity that
+      --  has been pushed by Establish_Transient_Scope.
 
-      pragma Assert (Ekind (Current_Scope) = E_Block);
+      pragma Assert (Ekind (Trans_Id) = E_Block);
+
       Block :=
         Make_Block_Statement (Loc,
-          Identifier                 => New_Occurrence_Of (Current_Scope, Loc),
+          Identifier                 => New_Occurrence_Of (Trans_Id, Loc),
           Declarations               => Decls,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, Statements => Instrs),
@@ -8357,8 +8389,9 @@
         (Action, Clean => False, Manage_SS => False);
 
       Insert := Prev (Action);
+
       if Present (Insert) then
-         Freeze_All (First_Entity (Current_Scope), Insert);
+         Freeze_All (First_Entity (Trans_Id), Insert);
       end if;
 
       --  Transfer cleanup actions to the newly created block
