Skip to content

R
riscv-gcc-1
Commit c79f6efd by Bob Duff Committed by Arnaud Charlet
Options

exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call SS_Release for a… 

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
parent 10158317
Showing with 95 additions and 53 deletions
gcc/ada/ChangeLog
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
Underlying_Type for B_Typ, in case the Typ is a subtype of a type with
unknown discriminants.
......
gcc/ada/exp_ch6.adb
......@@ -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.
declare
P : Node_Id;
begin
P := N;
while Present (P) loop
-- Mark the label of a source or internally generated block or
-- loop.
-- blocks and loops as well as the related function; otherwise the
-- result would be reclaimed too early.
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 --
------------------------
......
gcc/ada/scng.adb
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment