[Ada] Premature secondary stack reclamation
This patch modifies the creation of transient scopes to eliminate potential
premature secondary stack reclamations when there is no suitable transient
context and the scope was intended to manage the secondary stack. Instead,
the logic was changed to accommodate a special case where an assignment with
suppressed controlled actions that appears within a type initialization
procedure requires secondary stack reclamation.
The patch also corrects the handling of function calls which utilize the
secondary stack in loop parameter specifications. Previously the predicate
which determined whether the function will utilize the secondary stack was
not accurate enough, and in certain cases could lead to leaks.
------------
-- Source --
------------
-- iterators.ads
package Iterators is
type Iterator is limited interface;
type Iterator_Access is access all Iterator'Class;
function Next
(I : in out Iterator;
Element : out Character) return Boolean is abstract;
procedure Iterate
(I : in out Iterator'Class;
Proc : access procedure (Element : Character));
end Iterators;
-- iterators.adb
package body Iterators is
procedure Iterate
(I : in out Iterator'Class;
Proc : access procedure (Element : Character))
is
Element : Character;
begin
while I.Next (Element) loop
Proc (Element);
end loop;
end Iterate;
end Iterators;
-- base.ads
with Iterators; use Iterators;
package Base is
type String_Access is access all String;
type Node is tagged record
S : String_Access;
end record;
type Node_Access is access all Node'Class;
type Node_Array is array (Positive range <>) of Node_Access;
function As_Array (N : Node_Access) return Node_Array;
function Get_String (C : Character) return String;
type Node_Iterator is limited new Iterator with record
Node : Node_Access;
I : Positive;
end record;
overriding function Next
(It : in out Node_Iterator;
Element : out Character) return Boolean;
function Constructor_1 (N : Node_Access) return Node_Iterator;
function Constructor_2 (N : Node_Access) return Node_Iterator;
end Base;
-- base.adb
package body Base is
function As_Array (N : Node_Access) return Node_Array is
begin
return (1 => N);
end As_Array;
function Get_String (C : Character) return String is
begin
return (1 .. 40 => C);
end Get_String;
function Next
(It : in out Node_Iterator;
Element : out Character) return Boolean
is
begin
if It.I > It.Node.S'Last then
return False;
else
It.I := It.I + 1;
Element := It.Node.S (It.I - 1);
return True;
end if;
end Next;
function Constructor_1 (N : Node_Access) return Node_Iterator is
begin
return Node_Iterator'(N, 1);
end Constructor_1;
function Constructor_2 (N : Node_Access) return Node_Iterator is
begin
return Constructor_1 (As_Array (N) (1));
end Constructor_2;
end Base;
-- main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Base; use Base;
with Iterators; use Iterators;
procedure Main is
N : constant Node_Access := new Node'(S => new String'("hello world"));
procedure Process (C : Character) is
begin
Put_Line (Get_String (C));
end Process;
C : Iterator'Class := Constructor_2 (N);
begin
C.Iterate (Process'Access);
end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q main.adb
$ ./main
hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
llllllllllllllllllllllllllllllllllllllll
llllllllllllllllllllllllllllllllllllllll
oooooooooooooooooooooooooooooooooooooooo
wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
oooooooooooooooooooooooooooooooooooooooo
rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
llllllllllllllllllllllllllllllllllllllll
dddddddddddddddddddddddddddddddddddddddd
2018-05-21 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* exp_ch7.adb (Establish_Transient_Scope): Code cleanup. Do not
delegate the secondary stack management when there is no suitable
transient context, and the transient scope was intended to manage the
secondary stack because this causes premature reclamation. Change the
transient scope creation logic by special casing assignment statements
of controlled components for type initialization procedures.
(Find_Node_To_Be_Wrapped): Renamed to Find_Transient_Context. Update
the comment on usage.
(Find_Transient_Context): Change the initinte loop into a while loop.
Iterations schemes and iterator specifications are not valid transient
contexts because they rely on special processing. Assignment statements
are now treated as a normal transient context, special cases are
handled by the caller. Add special processing for pragma Check.
(Is_OK_Construct): Removed. Its functionality has been merged in
routine Find_Transient_Context.
* sem_ch5.adb (Check_Call): Reimplemented. Add code to properly
retrieve the subprogram being invoked. Use a more accurate predicate
(Requires_Transient_Scope) to determine that the function will emply
the secondary stack.
From-SVN: r260443
Showing
Please
register
or
sign in
to comment