+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
-- 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 --
----------------------------------------------
-- 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
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
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 --
------------------------
-- 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;
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
projects / gcc.git / commitdiff