[Ada] Spurious secondary stack depletion

This patch reimplements the secondary stack allocation logic to eliminate an
issue which causes the memory index to overflow while the stack itself uses
very little memory, thus causing a spurious Storage_Error.

The issue in details:

The total amount of memory that the secondary stack can accomodate is dictated
by System.Parameters.Size_Type which is really an Integer, giving roughly 2 GB
of storage.

The secondary stack is comprised of multiple frames which logically form a
contiguous array of memory. Each frame maintans a range over which it operates,
where

   Low  bound = Previous frame's high bound + 1
   High bound = Previous frame's high bound + Frame size

The allocation logic starts by first checking whether the current top frame
(which may not be the "last" frame in the secondary stack) has enough memory to
fit an object. If it does, then that frame is used. If it does not, the logic
then examines the subsequent frames, while carrying out the following actions:

   * If the frame is too small to fit the object, it is deleted

   * If the frame is big enough to fit the object, it is used

If all the frames were too small (and thus deleted), a new frame is added which
is big enough to fit the object.

Due to an issue with the deletion logic, the last frame would never be deleted.
Since any new frame's range is based on the previous frame's range, the new
range would keep growing, even though the secondary stack may have very few
frames in use. Eventually this growth overflows the memory index type.

The overflow of the memory index type happens only when the secondary stack
is full, and thus signals a Storage_Error. Due to the spurious growth of the
ranges, the overflow happens much faster and results in a bogus stack depleton.

The issue manifests only when each new memory request to the secondary stack is
slightly bigger than the previous memory request, thus prompring the secondary
stack to delete all its frames, and create a new one.

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

gcc/ada/

	* libgnat/s-secsta.adb (SS_Allocate): Reimplemented.
	(SS_Allocate_Dynamic): New routine. The allocation logic is now split
	into three distring cases rather than in one loop which attempts to
	handle all three cases. This rewrite eliminates an issue where the last
	frame of the stack cannot be freed, thus causing the memory range of a
	new frame to approach the overflow point of the memory index type.
	Since the overflow is logically treated as a
	too-much-memory-on-the-stack scenario, it causes a bogus Storage_Error.
	(SS_Allocate_Static): New routine. The routine factorizes the static
	secondary stack-related code from the former SS_Allocate.

gcc/testsuite/

	* gnat.dg/sec_stack2.adb: New testcase.

From-SVN: r260736

gcc/ada/ChangeLog

+2018-05-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* libgnat/s-secsta.adb (SS_Allocate): Reimplemented.
+	(SS_Allocate_Dynamic): New routine. The allocation logic is now split
+	into three distring cases rather than in one loop which attempts to
+	handle all three cases. This rewrite eliminates an issue where the last
+	frame of the stack cannot be freed, thus causing the memory range of a
+	new frame to approach the overflow point of the memory index type.
+	Since the overflow is logically treated as a
+	too-much-memory-on-the-stack scenario, it causes a bogus Storage_Error.
+	(SS_Allocate_Static): New routine. The routine factorizes the static
+	secondary stack-related code from the former SS_Allocate.
+
 2018-05-25  Sergey Rybin  <rybin@adacore.com>
 
 	* doc/gnat_ugn/gnat_and_program_execution.rst: Add description of '-U'

gcc/testsuite/ChangeLog

+2018-05-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* gnat.dg/sec_stack2.adb: New testcase.
+
 2018-05-25  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/interface6.adb: New testcase.

gcc/testsuite/gnat.dg/sec_stack2.adb

+--  { dg-do run }
+--  { dg-options "-gnatws" }
+
+with Ada.Strings.Unbounded;  use Ada.Strings.Unbounded;
+with Ada.Text_IO;            use Ada.Text_IO;
+with System.Parameters;      use System.Parameters;
+with System.Secondary_Stack; use System.Secondary_Stack;
+
+procedure Sec_Stack2 is
+   procedure Overflow_SS_Index;
+   --  Create a scenario where the frame index of the secondary stack overflows
+   --  while the stack itself uses little memory.
+
+   -----------------------
+   -- Overflow_SS_Index --
+   -----------------------
+
+   procedure Overflow_SS_Index is
+      Max_Iterations : constant := 20_000;
+      --  The approximate number of iterations needed to overflow the frame
+      --  index type on a 64bit target.
+
+      Algn : constant Positive := Positive (Standard'Maximum_Alignment);
+      --  The maximum alignment of the target
+
+      Size : constant Positive := Positive (Runtime_Default_Sec_Stack_Size);
+      --  The default size of the secondary stack on the target
+
+      Base_Str : constant String (1 .. Size) := (others => 'a');
+      --  A string big enough to fill the static frame of the secondary stack
+
+      Small_Str : constant String (1 .. Algn) := (others => 'a');
+      --  A string small enough to cause a new round up to the nearest multiple
+      --  of the maximum alignment on the target at each new iteration of the
+      --  loop.
+
+      Base_US : Unbounded_String := To_Unbounded_String (Base_Str);
+      --  Unbounded version of the base string
+
+      procedure SS_Print is new SS_Info (Put_Line);
+
+   begin
+      for Iteration in 1 .. Max_Iterations loop
+
+          --  Grow the base string by a small amount at each iteration of the
+          --  loop.
+
+          Append (Base_US, Small_Str);
+
+          --  Convert the unbounded base into a new base. This causes routine
+          --  To_String to allocates the new base on the secondary stack. Since
+          --  the new base is slignly bigger than the previous base, the stack
+          --  would have to create a new frame.
+
+          --  Due to an issue with frame reclamation, the last frame (which is
+          --  also not big enough to fit the new base) is never reclaimed. This
+          --  causes the range of the new frame to shift toward the overflow
+          --  point of the frame index type.
+
+          begin
+             declare
+                New_Base_Str : constant String := To_String (Base_US);
+             begin null; end;
+
+          exception
+             when Storage_Error =>
+                Put_Line ("ERROR: SS depleted");
+                Put_Line ("Iteration:" & Iteration'Img);
+                Put_Line ("SS_Size  :" & Size'Img);
+                Put_Line ("SS_Algn  :" & Algn'Img);
+
+                SS_Print;
+                exit;
+
+             when others =>
+                Put_Line ("ERROR: unexpected exception");
+                exit;
+          end;
+      end loop;
+   end Overflow_SS_Index;
+
+--  Start of processing for SS_Depletion
+
+begin
+   --  This issue manifests only on targets with a dynamic secondary stack
+
+   if Sec_Stack_Dynamic then
+      Overflow_SS_Index;
+   end if;
+end Sec_Stack2;