diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a8f16d80584..02301d5847d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2015-10-23 Bob Duff + + * 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 + + * 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 * exp_strm.adb (Build_Record_Or_Elementary_Input_Function): Use diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 2688e2e516f..31267a50bae 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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. + -- 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 -- ------------------------ diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 0216ddf71a9..f0a9013a8b8 100644 --- a/gcc/ada/scng.adb +++ b/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