exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call SS_Release for a block statement enclosing the return statement in...
2015-10-23 Bob Duff <duff@adacore.com> * exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call SS_Release for a block statement enclosing the return statement in the case where a build-in-place function return is returning the result on the secondary stack. This is accomplished by setting the Sec_Stack_Needed_For_Return flag on such blocks. It was already being set for the function itself, and it was already set correctly for blocks in the non-build-in-place case (in Expand_Simple_Function_Return). (Set_Enclosing_Sec_Stack_Return): New procedure to perform the Set_Sec_Stack_Needed_For_Return calls. Called in the build-in-place and non-build-in-place cases. (Expand_Simple_Function_Return): Call Set_Enclosing_Sec_Stack_Return instead of performing the loop in line. 2015-10-23 Bob Duff <duff@adacore.com> * scng.adb (Char_Literal_Case): If an apostrophe follows a reserved word, treat it as a lone apostrophe, rather than the start of a character literal. This was already done for "all", but it needs to be done also for (e.g.) "Delta". From-SVN: r229226
This commit is contained in:
Bob Duff
Arnaud Charlet
parent
1015831766
commit
c79f6efda3
3 changed files with 95 additions and 53 deletions
|
|
@ -1,3 +1,27 @@
|
|||
2015-10-23 Bob Duff <duff@adacore.com>
|
||||
|
||||
* exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call
|
||||
SS_Release for a block statement enclosing the return statement in the
|
||||
case where a build-in-place function return is returning
|
||||
the result on the secondary stack. This is accomplished by
|
||||
setting the Sec_Stack_Needed_For_Return flag on such blocks.
|
||||
It was already being set for the function itself, and it was
|
||||
already set correctly for blocks in the non-build-in-place case
|
||||
(in Expand_Simple_Function_Return).
|
||||
(Set_Enclosing_Sec_Stack_Return): New procedure to perform
|
||||
the Set_Sec_Stack_Needed_For_Return calls. Called in the
|
||||
build-in-place and non-build-in-place cases.
|
||||
(Expand_Simple_Function_Return): Call
|
||||
Set_Enclosing_Sec_Stack_Return instead of performing the loop
|
||||
in line.
|
||||
|
||||
2015-10-23 Bob Duff <duff@adacore.com>
|
||||
|
||||
* scng.adb (Char_Literal_Case): If an apostrophe
|
||||
follows a reserved word, treat it as a lone apostrophe, rather
|
||||
than the start of a character literal. This was already done for
|
||||
"all", but it needs to be done also for (e.g.) "Delta".
|
||||
|
||||
2015-10-23 Bob Duff <duff@adacore.com>
|
||||
|
||||
* exp_strm.adb (Build_Record_Or_Elementary_Input_Function): Use
|
||||
|
|
|
|||
|
|
@ -258,6 +258,13 @@ package body Exp_Ch6 is
|
|||
-- 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.
|
||||
|
||||
procedure Set_Enclosing_Sec_Stack_Return (N : Node_Id);
|
||||
-- N is a return statement for a function that returns its result on the
|
||||
-- secondary stack. This sets the Sec_Stack_Needed_For_Return flag on the
|
||||
-- function and all blocks and loops that the return statement is jumping
|
||||
-- out of. This ensures that the secondary stack is not released; otherwise
|
||||
-- the function result would be reclaimed before returning to the caller.
|
||||
|
||||
----------------------------------------------
|
||||
-- Add_Access_Actual_To_Build_In_Place_Call --
|
||||
----------------------------------------------
|
||||
|
|
@ -4662,18 +4669,18 @@ package body Exp_Ch6 is
|
|||
|
||||
-- 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
|
||||
-- all blocks 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 (Func_Id);
|
||||
Set_Sec_Stack_Needed_For_Return
|
||||
(Return_Statement_Entity (N));
|
||||
Set_Uses_Sec_Stack (Func_Id);
|
||||
Set_Uses_Sec_Stack (Return_Statement_Entity (N));
|
||||
Set_Sec_Stack_Needed_For_Return
|
||||
(Return_Statement_Entity (N));
|
||||
Set_Enclosing_Sec_Stack_Return (N);
|
||||
|
||||
-- Create an if statement to test the BIP_Alloc_Form
|
||||
-- formal and initialize the access object to either the
|
||||
|
|
@ -5966,44 +5973,10 @@ package body Exp_Ch6 is
|
|||
|
||||
else
|
||||
-- Prevent the reclamation of the secondary stack by all enclosing
|
||||
-- blocks and loops as well as the related function, otherwise the
|
||||
-- result will be reclaimed too early or even clobbered. Due to a
|
||||
-- possible mix of internally generated blocks, source blocks and
|
||||
-- loops, the scope stack may not be contiguous as all labels are
|
||||
-- inserted at the top level within the related function. Instead,
|
||||
-- perform a parent-based traversal and mark all appropriate
|
||||
-- constructs.
|
||||
-- blocks and loops as well as the related function; otherwise the
|
||||
-- result would be reclaimed too early.
|
||||
|
||||
declare
|
||||
P : Node_Id;
|
||||
|
||||
begin
|
||||
P := N;
|
||||
while Present (P) loop
|
||||
|
||||
-- Mark the label of a source or internally generated block or
|
||||
-- loop.
|
||||
|
||||
if Nkind_In (P, N_Block_Statement, N_Loop_Statement) then
|
||||
Set_Sec_Stack_Needed_For_Return (Entity (Identifier (P)));
|
||||
|
||||
-- Mark the enclosing function
|
||||
|
||||
elsif Nkind (P) = N_Subprogram_Body then
|
||||
if Present (Corresponding_Spec (P)) then
|
||||
Set_Sec_Stack_Needed_For_Return (Corresponding_Spec (P));
|
||||
else
|
||||
Set_Sec_Stack_Needed_For_Return (Defining_Entity (P));
|
||||
end if;
|
||||
|
||||
-- Do not go beyond the enclosing function
|
||||
|
||||
exit;
|
||||
end if;
|
||||
|
||||
P := Parent (P);
|
||||
end loop;
|
||||
end;
|
||||
Set_Enclosing_Sec_Stack_Return (N);
|
||||
|
||||
-- Optimize the case where the result is a function call. In this
|
||||
-- case either the result is already on the secondary stack, or is
|
||||
|
|
@ -9418,6 +9391,45 @@ package body Exp_Ch6 is
|
|||
end if;
|
||||
end Needs_Result_Accessibility_Level;
|
||||
|
||||
------------------------------------
|
||||
-- Set_Enclosing_Sec_Stack_Return --
|
||||
------------------------------------
|
||||
|
||||
procedure Set_Enclosing_Sec_Stack_Return (N : Node_Id) is
|
||||
P : Node_Id := N;
|
||||
|
||||
begin
|
||||
-- Due to a possible mix of internally generated blocks, source blocks
|
||||
-- and loops, the scope stack may not be contiguous as all labels are
|
||||
-- inserted at the top level within the related function. Instead,
|
||||
-- perform a parent-based traversal and mark all appropriate constructs.
|
||||
|
||||
while Present (P) loop
|
||||
|
||||
-- Mark the label of a source or internally generated block or
|
||||
-- loop.
|
||||
|
||||
if Nkind_In (P, N_Block_Statement, N_Loop_Statement) then
|
||||
Set_Sec_Stack_Needed_For_Return (Entity (Identifier (P)));
|
||||
|
||||
-- Mark the enclosing function
|
||||
|
||||
elsif Nkind (P) = N_Subprogram_Body then
|
||||
if Present (Corresponding_Spec (P)) then
|
||||
Set_Sec_Stack_Needed_For_Return (Corresponding_Spec (P));
|
||||
else
|
||||
Set_Sec_Stack_Needed_For_Return (Defining_Entity (P));
|
||||
end if;
|
||||
|
||||
-- Do not go beyond the enclosing function
|
||||
|
||||
exit;
|
||||
end if;
|
||||
|
||||
P := Parent (P);
|
||||
end loop;
|
||||
end Set_Enclosing_Sec_Stack_Return;
|
||||
|
||||
------------------------
|
||||
-- Unnest_Subprograms --
|
||||
------------------------
|
||||
|
|
|
|||
|
|
@ -1834,14 +1834,19 @@ package body Scng is
|
|||
|
||||
-- Apostrophe. This can either be the start of a character literal,
|
||||
-- or an isolated apostrophe used in a qualified expression or an
|
||||
-- attribute. We treat it as a character literal if it does not
|
||||
-- follow a right parenthesis, identifier, the keyword ALL or
|
||||
-- a literal. This means that we correctly treat constructs like:
|
||||
-- attribute. In the following:
|
||||
|
||||
-- A := CHARACTER'('A');
|
||||
|
||||
-- Note that RM-2.2(7) does not require a separator between
|
||||
-- "CHARACTER" and "'" in the above.
|
||||
-- the first apostrophe is treated as an isolated apostrophe, and the
|
||||
-- second one is treated as the start of the character literal 'A'.
|
||||
-- Note that RM-2.2(7) does not require a separator between "'" and
|
||||
-- "(" in the above, so we cannot use lookahead to distinguish the
|
||||
-- cases; we use look-back instead. Analysis of the grammar shows
|
||||
-- that some tokens can be followed by an apostrophe, and some by a
|
||||
-- character literal, but none by both. Some cannot be followed by
|
||||
-- either, so it doesn't matter what we do in those cases, except to
|
||||
-- get good error behavior.
|
||||
|
||||
when ''' => Char_Literal_Case : declare
|
||||
Code : Char_Code;
|
||||
|
|
@ -1851,17 +1856,18 @@ package body Scng is
|
|||
Accumulate_Checksum (''');
|
||||
Scan_Ptr := Scan_Ptr + 1;
|
||||
|
||||
-- Here is where we make the test to distinguish the cases. Treat
|
||||
-- as apostrophe if previous token is an identifier, right paren
|
||||
-- or the reserved word "all" (latter case as in A.all'Address)
|
||||
-- (or the reserved word "project" in project files). Also treat
|
||||
-- it as apostrophe after a literal (this catches some legitimate
|
||||
-- cases, like A."abs"'Address, and also gives better error
|
||||
-- behavior for impossible cases like 123'xxx).
|
||||
-- Distinguish between apostrophe and character literal. It's an
|
||||
-- apostrophe if the previous token is one of the following.
|
||||
-- Reserved words are included for things like A.all'Address and
|
||||
-- T'Digits'Img. Strings literals are included for things like
|
||||
-- "abs"'Address. Other literals are included to give better error
|
||||
-- behavior for illegal cases like 123'Img.
|
||||
|
||||
if Prev_Token = Tok_Identifier
|
||||
or else Prev_Token = Tok_Right_Paren
|
||||
or else Prev_Token = Tok_All
|
||||
or else Prev_Token = Tok_Delta
|
||||
or else Prev_Token = Tok_Digits
|
||||
or else Prev_Token = Tok_Project
|
||||
or else Prev_Token in Token_Class_Literal
|
||||
then
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue